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