マウス選択した領域を四角で囲み後、サイズや位置を変更する

はじめに

これは、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を勉強中なので、そっちに移植できたらと思ってます。