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

はじめに

これは、Visual Basic Advent Calendar 2022の1８日目の記事となります。
前回の記事の続きとなります。

動画

クラス

• RectangleSharp
• RegionSharp
• ResizeHandleBase
• ResizeHandleCollection

領域指定後に四隅の□マークのような"つまみ"を操作してサイズを変更します、この"つまみ"の事を「リサイズハンドル」と呼ぶことにします。

参照

技術的な説明は下記サイトで詳しく説明されています。
下記サイトを参考に必要な部分を抜き出しています。

• .NET5.0/C#9.0でオートシェイプ風図形描画ライブラリを作ろう！(Chapter1)
• .NET5.0/C#9.0でオートシェイプ風図形描画ライブラリを作ろう！(Chapter2)
• .NET5.0/C#9.0でオートシェイプ風図形描画ライブラリを作ろう！(Chapter3-1)
• .NET5.0/C#9.0でオートシェイプ風図形描画ライブラリを作ろう！(Chapter3-2)

RectangleSharpクラス

領域選択を管理するクラスとなります。
他にもマウスポインタが図形の上に乗っているかの判定（当たり判定）処理とドラッグ時の移動処理を行っています。

RectangleSharp.vb

''' <summary>
''' 四角形クラス
''' </summary>
Public Class RectangleShape
	Implements IShape

	Public Property Bounds() As Rectangle
	Protected Property ResizeHandles() As ResizeHandleCollection
	Public Property IsSelected() As Boolean Implements IShape.IsSelected

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">範囲</param>
	Public Sub New(bounds As Rectangle)
		Me.Bounds = bounds
		ResizeHandles = New ResizeHandleCollection(8, 8)
		ResizeHandles.SetLocation(Me.Bounds)
		IsSelected = True
	End Sub

	''' <summary>
	''' 移動処理
	''' </summary>
	''' <param name="pt">マウスポインタ座標</param>
	Public Overridable Sub MoveTo(pt As Point)
		SetBounds(New Rectangle(pt.X, pt.Y, Bounds.Width, Bounds.Height))
	End Sub

	''' <summary>
	''' 描画処理
	''' </summary>
	''' <param name="g">Graphicsオブジェクト</param>
	Public Overridable Sub Draw(g As Graphics)
		RegionSharp.Color = Color.Red
		RegionSharp.DrawRegionEnd(g, Bounds)

		If IsSelected Then
			RegionSharp.Color = Color.Black
			Dim reginBounds As New Rectangle(Bounds.X - 1, Bounds.Y - 1, Bounds.Width + 2, Bounds.Height + 2)
			RegionSharp.DrawRegionEnd(g, reginBounds)
			' リサイズハンドルの描画
			ResizeHandles.Draw(g)
		End If
	End Sub

	''' <summary>
	''' 当たり判定処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <returns>ヒットした方角</returns>
	Public Overridable Function HitTest(p As Point) As HitResult
		If IsSelected Then
			' 選択状態の場合のみ
			Dim hitResult = ResizeHandles.HitTest(p)
			If hitResult <> HitResult.None Then
				Return hitResult
			End If
		End If

		Return If(Bounds.Contains(p.X, p.Y), HitResult.Body, HitResult.None)
	End Function

	''' <summary>
	''' ドラッグ終了時処理
	''' </summary>
	''' <param name="oldPointer">ドラッグ開始時のマウスポインタ座標</param>
	''' <param name="currentPointer">現在のマウスポインタ座標</param>
	Public Overridable Sub Drag(oldPointer As Point, currentPointer As Point)
		If ResizeHandles.ActiveHandle IsNot Nothing Then
			SetBounds(ResizeHandles.Resize(currentPointer, Bounds))
			Return
		End If
		Dim dx = currentPointer.X - oldPointer.X
		Dim dy = currentPointer.Y - oldPointer.Y
		SetBounds(New Rectangle(Bounds.Left + dx, Bounds.Top + dy, Bounds.Width, Bounds.Height))
	End Sub

	''' <summary>
	''' リサイズ確定時処理
	''' </summary>
	Public Sub Drop()
		Dim left = Bounds.Left
		Dim top = Bounds.Top
		Dim width = Bounds.Width
		Dim height = Bounds.Height

		' 幅・高さが常にプラスの値となるように調整
		If Bounds.Width < 0 Then
			left = Bounds.Right
			width = Math.Abs(Bounds.Width)
		End If
		If Bounds.Height < 0 Then
			top = Bounds.Bottom
			height = Math.Abs(Bounds.Height)
		End If
		SetBounds(New Rectangle(left, top, width, height))
	End Sub

	''' <summary>
	''' 位置・サイズ再設定
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Protected Sub SetBounds(bounds As Rectangle)
		Me.Bounds = bounds
		ResizeHandles.SetLocation(bounds)
	End Sub

	Private Sub IDrawable_Draw(g As Graphics) Implements IDrawable.Draw
		Throw New NotImplementedException()
	End Sub

	Private Sub IDraggable_Drag(oldPointer As Point, currentPointer As Point) Implements IDraggable.Drag
		Throw New NotImplementedException()
	End Sub

	Private Function IHitTest_HitTest(p As Point) As HitResult Implements IHitTest.HitTest
		Throw New NotImplementedException()
	End Function
End Class

RegionSharpクラス

領域選択の四角形と　リサイズハンドルの描画クラスとなります。

RegionSharp.vb

Imports System.Drawing.Drawing2D

''' <summary>
''' 領域クラス
''' </summary>
Public NotInheritable Class RegionSharp
	Public Shared Property Color() As Color
	Public Shared Property Style() As DashStyle

	''' <summary>
	''' 領域描画処理
	''' </summary>
	''' <param name="g">Graphicsオブジェクト</param>
	''' <param name="bounds">位置・サイズ</param>
	''' <param name="style">線スタイル</param>
	Public Shared Sub DrawRegion(g As Graphics, bounds As Rectangle, style As DashStyle)
		Dim pen As New Pen(Color)

		' 描画する線を実線に設定
		pen.DashStyle = style

		' 領域を描画
		g.DrawRectangle(pen, bounds.X, bounds.Y, bounds.Width, bounds.Height)
	End Sub

	''' <summary>
	''' 領域描画終了時処理
	''' </summary>
	''' <param name="g">Graphicsオブジェクト</param>
	''' <param name="bounds">位置・サイズ</param>
	Public Shared Sub DrawRegionEnd(g As Graphics, bounds As Rectangle)
		SetAdjust(bounds)
		DrawRegion(g, bounds, DashStyle.Solid)
	End Sub

	''' <summary>
	''' 領域描画移動時処理
	''' </summary>
	''' <param name="g">Graphicsオブジェクト</param>
	''' <param name="bounds">位置・サイズ</param>
	Public Shared Sub DrawRegionMove(g As Graphics, bounds As Rectangle)
		DrawRegion(g, bounds, DashStyle.Dash)
	End Sub

	''' <summary>
	''' 領域取得
	''' </summary>
	''' <param name="p1">開始位置</param>
	''' <param name="p2">終了位置</param>
	''' <returns>位置・サイズ</returns>
	Public Shared Function GetRegion(p1 As Point, p2 As Point) As Rectangle
		Dim start As New Point()
		Dim [end] As New Point()

		start.X = Math.Min(p1.X, p2.X)
		start.Y = Math.Min(p1.Y, p2.Y)

		[end].X = Math.Max(p1.X, p2.X)
		[end].Y = Math.Max(p1.Y, p2.Y)

		Return New Rectangle(start.X, start.Y, Math.Abs(start.X - [end].X), Math.Abs(start.Y - [end].Y))
	End Function

	''' <summary>
	''' 幅・高さが常にプラスの値となるように調整処理
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Shared Sub SetAdjust(ByRef bounds As Rectangle)
		Dim left = bounds.Left
		Dim top = bounds.Top
		Dim width = bounds.Width
		Dim height = bounds.Height

		If bounds.Width < 0 Then
			left = bounds.Right
			width = Math.Abs(bounds.Width)
		End If
		If bounds.Height < 0 Then
			top = bounds.Bottom
			height = Math.Abs(bounds.Height)
		End If

		bounds = New Rectangle(left, top, width, height)
	End Sub
End Class

ResizeHandleBaseクラス

リサイズハンドル用の管理クラスとなります。実際の描画はRegionSharpクラスで行っています。

ResizeHandleBase.vb

''' <summary>
''' 方角列挙型
''' </summary>
Public Enum HitResult
	None
	ResizeN
	ResizeNE
	ResizeE
	ResizeSE
	ResizeS
	ResizeSW
	ResizeW
	ResizeNW
	Body
End Enum

''' <summary>
''' 描画可能なオブジェクトのインターフェース
''' </summary>
Public Interface IDrawable
	Sub Draw(g As Graphics)
End Interface

''' <summary>
'''ドラッグ可能なオブジェクトのインターフェース
''' </summary>
Public Interface IDraggable
	Sub Drag(oldPointer As Point, currentPointer As Point)
End Interface

''' <summary>
''' 当たり判定チェック機能を提供するインターフェース
''' </summary>
Public Interface IHitTest
	Function HitTest(p As Point) As HitResult
End Interface

''' <summary>
''' 図形インターフェース
''' </summary>
Public Interface IShape
	Inherits IDrawable
	Inherits IDraggable
	Inherits IHitTest
	Property IsSelected() As Boolean
End Interface

''' <summary>
''' リサイズハンドルベースクラス
''' </summary>
Public MustInherit Class ResizeHandleBase
	Implements IDrawable
	Implements IHitTest

	Public Property HitResult() As HitResult
	Public Property Bounds() As Rectangle
	Public MustOverride Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
	Public MustOverride Sub SetLocation(parentBounds As Rectangle)

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">サイズ・位置</param>
	Protected Sub New(bounds As Rectangle)
		Me.Bounds = bounds
	End Sub

	''' <summary>
	''' リサイズハンドル描画処理
	''' </summary>
	''' <param name="g">Graphicsオブジェクト</param>
	Public Sub Draw(g As Graphics)
		Dim whitePen As New Pen(Color.Black)
		g.DrawRectangle(whitePen, Bounds)
		g.FillRectangle(Brushes.White, Bounds.Left + 1, Bounds.Top + 1, Bounds.Width - 1, Bounds.Height - 1)
	End Sub

	''' <summary>
	''' 当たり判定処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <returns>ヒットした方角</returns>
	Public Function HitTest(p As Point) As HitResult
		Return If((Bounds.Left <= p.X AndAlso p.X <= Bounds.Right AndAlso
				   Bounds.Top <= p.Y AndAlso p.Y <= Bounds.Bottom),
				   Me.HitResult, HitResult.None)
	End Function

	''' <summary>
	''' 移動処理
	''' </summary>
	''' <param name="center">センター位置</param>
	Protected Sub MoveTo(center As Point)
		Bounds = New Rectangle(
					center.X - Bounds.Width / 2,
					center.Y - Bounds.Height / 2,
					Bounds.Width,
					Bounds.Height)
	End Sub

	Private Sub IDrawable_Draw(g As Graphics) Implements IDrawable.Draw
		Throw New NotImplementedException()
	End Sub

	Private Function IHitTest_HitTest(p As Point) As HitResult Implements IHitTest.HitTest
		Throw New NotImplementedException()
	End Function
End Class

''' <summary>
''' リサイズハンドル東側方向
''' </summary>
Public Class ResizeHandleE
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeE
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns>リサイズ位置・サイズ</returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(parentBounds.Left, parentBounds.Top, p.X - parentBounds.Left, parentBounds.Height)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Right, parentBounds.Top + parentBounds.Height / 2)
		MoveTo(center)
	End Sub
End Class

''' <summary>
''' リサイズハンドル北側方向(North)
''' </summary>
Public Class ResizeHandleN
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeN
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns></returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(parentBounds.Left, p.Y, parentBounds.Width, parentBounds.Bottom - p.Y)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Left + parentBounds.Width / 2, parentBounds.Top)
		MoveTo(center)
	End Sub
End Class

''' <summary>
''' リサイズハンドル北東側方向(North East)
''' </summary>
Public Class ResizeHandleNE
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeNE
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns>リサイズ位置・サイズ</returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(parentBounds.Left, p.Y, p.X - parentBounds.Left, parentBounds.Bottom - p.Y)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Right, parentBounds.Top)
		MoveTo(center)
	End Sub
End Class

''' <summary>
''' リサイズハンドル北西側方向(North West)
''' </summary>
Public Class ResizeHandleNW
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeNW
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns>リサイズ位置・サイズ</returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(p.X, p.Y, parentBounds.Right - p.X, parentBounds.Bottom - p.Y)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Left, parentBounds.Top)
		MoveTo(center)
	End Sub
End Class

''' <summary>
''' リサイズハンドル南側方向(South)
''' </summary>
Public Class ResizeHandleS
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeS
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns>リサイズ位置・サイズ</returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(parentBounds.Left, parentBounds.Top, parentBounds.Width, p.Y - parentBounds.Top)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Left + parentBounds.Width / 2, parentBounds.Bottom)
		MoveTo(center)
	End Sub
End Class

''' <summary>
''' リサイズハンドル南東側方向(South East)
''' </summary>
Public Class ResizeHandleSE
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeSE
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns>リサイズ位置・サイズ</returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(parentBounds.Left, parentBounds.Top, p.X - parentBounds.Left, p.Y - parentBounds.Top)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Right, parentBounds.Bottom)
		MoveTo(center)
	End Sub
End Class

''' <summary>
''' リサイズハンドル南西側方向(South West)
''' </summary>
Public Class ResizeHandleSW
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeSW
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns>リサイズ位置・サイズ</returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(p.X, parentBounds.Top, parentBounds.Right - p.X, p.Y - parentBounds.Top)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Left, parentBounds.Bottom)
		MoveTo(center)
	End Sub
End Class

''' <summary>
''' リサイズハンドル西側方向(West)
''' </summary>
Public Class ResizeHandleW
	Inherits ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="bounds">位置・サイズ</param>
	Public Sub New(bounds As Rectangle)
		MyBase.New(bounds)
		HitResult = HitResult.ResizeW
	End Sub

	''' <summary>
	''' リサイズ処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns>リサイズ位置・サイズ</returns>
	Public Overrides Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return New Rectangle(p.X, parentBounds.Top, parentBounds.Right - p.X, parentBounds.Height)
	End Function

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Overrides Sub SetLocation(parentBounds As Rectangle)
		Dim center = New Point(parentBounds.Left, parentBounds.Top + parentBounds.Height / 2)
		MoveTo(center)
	End Sub
End Class

ResizeHandleCollectionクラス

リサイズハンドルの8つのハンドルをまとめて処理するためのクラスとなります。

ResizeHandleCollection.vb

Imports System.Collections.ObjectModel

''' <summary>
''' リサイズハンドルコレクションクラス
''' </summary>
Public Class ResizeHandleCollection
	Protected Property Items() As IReadOnlyCollection(Of ResizeHandleBase)
	Public Property ActiveHandle() As ResizeHandleBase

	''' <summary>
	''' コンストラクタ
	''' </summary>
	''' <param name="width">幅</param>
	''' <param name="height">高さ</param>
	Public Sub New(width As Integer, height As Integer)
		Items = New ReadOnlyCollection(Of ResizeHandleBase)(
			New ResizeHandleBase() {
				New ResizeHandleN(New Rectangle(0, 0, width, height)),
				New ResizeHandleNE(New Rectangle(0, 0, width, height)),
				New ResizeHandleE(New Rectangle(0, 0, width, height)),
				New ResizeHandleSE(New Rectangle(0, 0, width, height)),
				New ResizeHandleS(New Rectangle(0, 0, width, height)),
				New ResizeHandleSW(New Rectangle(0, 0, width, height)),
				New ResizeHandleW(New Rectangle(0, 0, width, height)),
				New ResizeHandleNW(New Rectangle(0, 0, width, height))
			})
	End Sub

	''' <summary>
	''' 自身位置の再設定処理
	''' </summary>
	''' <param name="parentBounds">親の位置・サイズ</param>
	Public Sub SetLocation(parentBounds As Rectangle)
		For Each handle In Items
			handle.SetLocation(parentBounds)
		Next
	End Sub

	''' <summary>
	''' 当たり判定処理
	''' </summary>
	''' <param name="p">マウスポインタ座標</param>
	''' <returns>ヒットした方角</returns>
	Public Function HitTest(p As Point) As HitResult
		For Each handle In Items
			Dim hitResult = handle.HitTest(p)
			If hitResult <> HitResult.None Then
				ActiveHandle = handle
				Return hitResult
			End If
		Next
		ActiveHandle = Nothing
		Return HitResult.None
	End Function

	''' <summary>
	''' リサイズ
	''' </summary>
	''' <param name="p">ドラッグ先のマウスポインタ座標</param>
	''' <param name="parentBounds">親の位置・サイズ</param>
	''' <returns></returns>
	Public Function Resize(p As Point, parentBounds As Rectangle) As Rectangle
		Return ActiveHandle.Resize(p, parentBounds)
	End Function

	''' <summary>
	''' リサイズハンドル全描画
	''' </summary>
	''' <param name="g">Graphicsオブジェクト</param>
	Public Sub Draw(g As Graphics)
		For Each handle In Items
			handle.Draw(g)
		Next
	End Sub
End Class

最後に

コメントを付けてみたものの、作成している最中は覚えていたんですが大分忘れてますね。
領域選択した後にサイズや位置を変更したいという要望はあると思うので、役に立つと思います。

VB版とC#版については、GitHub側で公開する予定です。