はじめに

これは、Visual Basic Advent Calendar 2022の17日目の記事となります。
今回はマウス選択した領域を四角で囲み後、サイズや位置を変更する記事となります。

開発経緯

仕事でバーコードやQRコードを扱うのですが、ユーザーから問い合わせメールでバーコードやQRコードが含まれた画像が届きます。モニター上でバーコードリーダー機器で読もうとしても反射して読めないことがあります。その際は印刷してからバーコードリーダー機器で読むわけです。
以前、ZXing.Netを使ったバーコード読み込みの記事を書きました。この時はタブレット上のカメラを使ったものでした。

会社でC#を使って作成した際、画像を読み込んでマウス選択した領域のバーコードやQRコードを読むようにしました。また、画像処理ソフトによくあるように、領域指定後に四隅の□マークのような"つまみ"を操作してサイズを変更したり、ドラッグして領域の位置を変更できるようにしました。

今回の記事ではバーコード読み込みの実装まではやらないが、領域指定部分だけ実装します。
C#からVB.NETの変換ツールには、SharpDevelop 4.4を使用しました。

動画

参考記事

この2つの記事は、とても参考になりました。

開発環境

Windows 11 Home 22H2
Visual Studio Community 2022
WinForm for .NET Framework 4.8
SharpDevelop 4.4

ソースコード

今回の記事は2つに分けて書きます。
ここではフォームの部分だけ、次記事でクラスを書きます。

Imports System.Text

Public Class FrmMain
	Inherits Form

	' ドラッグ状態の列挙型
	Private Enum DragState
		None
		Start
		Move
		Resize
	End Enum

	' 領域格納リスト
	Private ReadOnly _rectList As New List(Of RectangleShape)()
	' ドラッグ状態
	Private _dragState As DragState = DragState.None
	' アクティブ領域
	Private _activeSharp As RectangleShape = Nothing

	' ドラッグ位置
	Private _dragStartLocation As Point
	Private _dragEndLocation As Point
	Private _dragOffset As Point
	' マウス移動位置保持
	Private _oldPoint As Point

	''' <summary>
	''' マウスダウンイベント処理
	''' </summary>
	''' <param name="sender">イベント発行元</param>
	''' <param name="e">イベント情報</param>
	Private Sub PicImage_MouseDown(sender As Object, e As MouseEventArgs) Handles PicImage.MouseDown
		Dim currentPoint As New Point(e.X, e.Y)

		_dragState = DragState.None
		_activeSharp = Nothing

		' 枠内をクリックしたかどうか?
		Dim isRepaint As Boolean = False
		For i As Integer = _rectList.Count - 1 To 0 Step -1
			Dim rect As RectangleShape = _rectList(i)
			' リサイズハンドル内か
			Dim hitResult = rect.HitTest(currentPoint)

			rect.IsSelected = False
			Select Case hitResult
				Case HitResult.None
					Exit Select
				Case HitResult.Body
					If Not isRepaint Then
						_dragState = DragState.Move
						_activeSharp = rect
						_activeSharp.IsSelected = True
						_dragOffset = New Point(currentPoint.X - rect.Bounds.Left, currentPoint.Y - rect.Bounds.Top)
						isRepaint = True
					End If
					Exit Select
				Case Else
					If Not isRepaint Then
						_dragState = DragState.Resize
						_activeSharp = rect
						rect.IsSelected = True
						_activeSharp.IsSelected = True
						isRepaint = True
					End If
			End Select
		Next

		If isRepaint Then
			PicImage.Invalidate()
			Return
		End If

		' 領域選択を1つのみにする場合、コメントを外す
		'If _rectList.Count > 0 Then
		'	Return
		'End If

		_dragState = DragState.Start
		_dragStartLocation = e.Location
	End Sub

	''' <summary>
	''' マウス移動イベント処理
	''' </summary>
	''' <param name="sender">イベント発行元</param>
	''' <param name="e">イベント情報</param>
	Private Sub PicImage_MouseMove(sender As Object, e As MouseEventArgs) Handles PicImage.MouseMove
		Dim currentPoint As New Point(e.X, e.Y)

		Select Case _dragState
			Case DragState.Start
				' 枠サイズ変更処理
				_dragEndLocation = currentPoint
				PicImage.Invalidate()
				_oldPoint = currentPoint
				Exit Select

			Case DragState.Move
				' 枠移動処理
				_activeSharp.MoveTo(New Point(currentPoint.X - _dragOffset.X, currentPoint.Y - _dragOffset.Y))
				PicImage.Invalidate()
				Exit Select

			Case DragState.Resize
				' リサイズ処理
				_activeSharp.Drag(_oldPoint, currentPoint)
				PicImage.Invalidate()
				Exit Select

			Case DragState.None
				' カーソル変更処理
				Cursor = Cursors.Arrow
				For Each rect As RectangleShape In _rectList
					' リサイズハンドル内か
					Dim hitResult = rect.HitTest(currentPoint)

					'ヒットした部位に応じてカーソルの形状を変更する
					Select Case hitResult
						Case HitResult.Body
							Cursor = Cursors.SizeAll
							Exit Select
						Case HitResult.ResizeN, HitResult.ResizeS
							Cursor = Cursors.SizeNS
							Exit Select
						Case HitResult.ResizeE, HitResult.ResizeW
							Cursor = Cursors.SizeWE
							Exit Select
						Case HitResult.ResizeNW, HitResult.ResizeSE
							Cursor = Cursors.SizeNWSE
							Exit Select
						Case HitResult.ResizeNE, HitResult.ResizeSW
							Cursor = Cursors.SizeNESW
							Exit Select
					End Select
				Next
				Exit Select
		End Select
	End Sub

	''' <summary>
	''' マウスアップイベント処理
	''' </summary>
	''' <param name="sender">イベント発行元</param>
	''' <param name="e">イベント情報</param>
	Private Sub PicImage_MouseUp(sender As Object, e As MouseEventArgs) Handles PicImage.MouseUp
		Cursor = Cursors.Arrow

		Select Case _dragState
			Case DragState.Start
				' 一定の大きさのみ許容
				Dim bounds As Rectangle = RegionSharp.GetRegion(_dragStartLocation, _dragEndLocation)
				If bounds.Width >= 20 AndAlso bounds.Height >= 20 AndAlso _dragEndLocation.X > 0 Then
					For Each rect2 As RectangleShape In _rectList
						rect2.IsSelected = False
					Next

					Dim rect As New RectangleShape(bounds)
					_rectList.Add(rect)
				End If
				_dragStartLocation = New Point(-1, -1)
				_dragEndLocation = New Point(-1, -1)

				PicImage.Invalidate()
				Exit Select

			Case DragState.Resize
				' リサイズ確定処理
				_activeSharp.Drop()
				PicImage.Invalidate()
				Exit Select
		End Select

		_dragState = DragState.None
	End Sub

	''' <summary>
	''' 画像表示イベント処理
	''' </summary>
	''' <param name="sender">イベント発行元</param>
	''' <param name="e">イベント情報</param>
	Private Sub PicImage_Paint(sender As Object, e As PaintEventArgs) Handles PicImage.Paint
		If _dragState = DragState.Start Then
			' 領域描画途中処理
			Dim bounds As Rectangle = RegionSharp.GetRegion(_dragStartLocation, _dragEndLocation)
			RegionSharp.Color = Color.Red
			RegionSharp.DrawRegionMove(e.Graphics, bounds)
		End If

		' 領域描画処理
		For Each rect As RectangleShape In _rectList
			rect.Draw(e.Graphics)
		Next
	End Sub

	''' <summary>
	''' 領域選択クリアー
	''' </summary>
	''' <param name="sender">イベント発行元</param>
	''' <param name="e">イベント情報</param>
	Private Sub BtnRangeClear_Click(sender As Object, e As EventArgs) Handles BtnRangeClear.Click
		_rectList.Clear()
		PicImage.Invalidate()
	End Sub

	''' <summary>
	''' 領域選択出力
	''' </summary>
	''' <param name="sender">イベント発行元</param>
	''' <param name="e">イベント情報</param>
	Private Sub BtnRangeOutput_Click(sender As Object, e As EventArgs) Handles BtnRangeOutput.Click
		Dim sb As StringBuilder = New StringBuilder()
		For Each rect As RectangleShape In _rectList
			Dim bounds As Rectangle = rect.Bounds
			sb.AppendLine(String.Format("Left={0},Top={1},Width={2},Height={3}", bounds.Left, bounds.Top, bounds.Width, bounds.Height))
		Next
		MessageBox.Show(sb.ToString())
	End Sub
End Class

結果

領域選択クリアボタンをクリックすると、全ての領域選択をクリアします。
領域選択出力ボタンをクリックすると、領域の位置とサイズをメッセージボックスに出力します。

最後に

簡単なツールを作成するのに、WinFormがまだまだ便利です。WPFは慣れてないので扱いにくい。
VB版とC#版については、GitHub側で公開する予定です。

最近はBlazorを勉強中なので、そっちに移植できたらと思ってます。