如何将矩形区域选择添加到可平移/缩放的VB.Net Winforms控件中

Question

这是我找到这个网站后的第一个问题。

我目前正在尝试创建一个VB.NET用户控件，该控件包含一个面板图形对象(圆、矩形、线(应在"绘制"事件期间绘制。它可以简化面板始终为正方形(宽度=高度(的情况。不幸的是，使用图片框绘图对我来说不是一种选择。我也不想使用自动滚动并具有可见滚动条。

该面板应可由用户平移/缩放。平移应通过按下鼠标中键和缩放应该通过滚动鼠标滚轮来完成。我已经找到了如何实现这些功能的好例子，到目前为止它们都有效非常好。现在我还想添加一个功能，即用户应该能够缩放到特定的(正方形(当他按下时显示的选择矩形所占的面板面积当他按下鼠标时，鼠标左键及其大小会调整左键。(它应该是类似的行为，例如缩放到PDF文档中(。这就是我被卡住的地方。

我提取了负责面板及其事件的代码部分这就是我目前所拥有的：

Public Class Form1
Private zoomstart as Point
Private zoomfirst as Point
Private zoomwidth as Integer    
Private zoomrect as Rectangle
Private WithEvents tmrMarch as New Timer
Private MarchOffset as Integer = 0
Private OffsetDelta as Integer = 2
Private DashPattern() as Single = {5, 5}
Private zoom As Single = 1.0
Private startx as Integer = 0
Private starty as Integer = 0
Private offsetx as Integer = 0
Private offsety as Integer = 0
Private mouseDownPt as Point
Private initialwidth As Integer
Public WithEvents Canvas1 As New Canvas
Private Enum T_MouseAction
RectangleZooming
WheelZooming
Panning
None
End Enum
Private MouseAction As T_MouseAction = T_MouseAction.None

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Canvas1.Size = New Size(Me.ClientSize.Width, Me.ClientSize.Width)
Canvas1.AutoScroll = False
initialwidth = Canvas1.Width
Me.Controls.Add(Canvas1)
End Sub

Private Sub Canvas1_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles Canvas1.Paint
Select Case MouseAction
Case T_MouseAction.None
e.Graphics.TranslateTransform(offsetx, offsety)
e.Graphics.ScaleTransform(zoom, zoom)
Case T_MouseAction.Panning
e.Graphics.TranslateTransform(offsetx, offsety)
e.Graphics.ScaleTransform(zoom, zoom)
Case T_MouseAction.RectangleZooming
e.Graphics.TranslateTransform(offsetx, offsety)
e.Graphics.ScaleTransform(zoom, zoom)
Case T_MouseAction.WheelZooming
e.Graphics.ScaleTransform(zoom, zoom)
e.Graphics.TranslateTransform(offsetx, offsety)
End Select
Call DrawImage(e.Graphics)
e.Graphics.ResetTransform
If MouseAction = T_MouseAction.RectangleZooming Then
MarchOffset = MarchOffset + OffsetDelta
Dim pen as New Pen(Color.Black, 2)
pen.DashPattern = DashPattern
pen.DashOffset = MarchOffset
pen.Color = Color.Red
e.Graphics.DrawRectangle(pen, zoomrect)
End If 
End Sub

Private Sub DrawImage(ByVal gr As Graphics)
Dim rect As Rectangle
rect = New Rectangle(0, 0, initialwidth, initialwidth)
gr.FillEllipse(Brushes.LightGreen, rect)
gr.DrawEllipse(Pens.Green, rect)
rect = New Rectangle(0.375 * initialwidth, 0.375 * initialwidth, 0.25 * initialwidth, 0.375 * initialwidth)
gr.FillEllipse(Brushes.LightBlue, rect)
gr.DrawEllipse(Pens.Blue, rect)
rect = New Rectangle(0.1875 * initialwidth, 0.25 * initialwidth, 0.625 * initialwidth, 0.625 * initialwidth)
gr.DrawArc(Pens.Red, rect, 20, 140)
rect = New Rectangle(0.1875 * initialwidth, 0.1875 * initialwidth, 0.1875 * initialwidth, 0.25 * initialwidth)
gr.FillEllipse(Brushes.White, rect)
gr.DrawEllipse(Pens.Black, rect)
rect = New Rectangle(0.25 * initialwidth, 0.25 * initialwidth, 0.125 * initialwidth, 0.125 * initialwidth)
gr.FillEllipse(Brushes.Black, rect)
rect = New Rectangle(0.625 * initialwidth, 0.1875 * initialwidth, 0.1875 * initialwidth, 0.25 * initialwidth)
gr.FillEllipse(Brushes.White, rect)
gr.DrawEllipse(Pens.Black, rect)
rect = New Rectangle(0.6875 * initialwidth, 0.25 * initialwidth, 0.125 * initialwidth, 0.125 * initialwidth)
gr.FillEllipse(Brushes.Black, rect)
End Sub

Private Sub tmrMarch_Tick(ByVal sender as Object, ByVal e as EventArgs) Handles tmrMarch.Tick
Canvas1.Refresh
End Sub    


Private Sub Canvas1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Canvas1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Middle Then
MouseAction = T_MouseAction.Panning
mouseDownPt = e.Location
startx = offsetx
starty = offsety
End If
If e.Button = Windows.Forms.MouseButtons.Left Then
zoomstart = e.Location
tmrMarch.Interval = 100
tmrMarch.Enabled = True
End If        
End Sub
Private Sub Canvas1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Canvas1.MouseUp
Cursor = Cursors.Default
tmrMarch.Enabled = False
If MouseAction = T_MouseAction.RectangleZooming Then
Dim oldzoom as Single = zoom
zoom = 1 ' <=== ?
zoom = Math.Truncate(zoom / 0.2) * 0.2
Dim oldoffsetx, oldoffsety as Integer
Dim newoffsetx, newoffsety as Integer
oldoffsetx = CInt(zoomrect.X / oldzoom)
oldoffsety = CInt(zoomrect.Y / oldzoom)
newoffsetx = CInt(zoomrect.X / zoom)
newoffsety = CInt(zoomrect.Y / zoom)
offsetx = newoffsetx - oldoffsetx + offsetx ' <=== ?
offsety = newoffsety - oldoffsety + offsety ' <=== ?    
End If
MouseAction = T_MouseAction.None
Canvas1.Refresh
End Sub    

Private Sub Canvas1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Canvas1.MouseMove
If e.Button = Windows.Forms.MouseButtons.Middle
Cursor = Cursors.Hand
Dim mousePosNow as Point = e.Location
Dim deltaX, deltaY as Integer
deltaX = mousePosNow.X - mouseDownPt.X
deltaY = mousePosNow.Y - mouseDownPt.Y
offsetx = CInt(startx + deltaX)
offsety = CInt(starty + deltaY)
MouseAction = T_MouseAction.Panning
Canvas1.Refresh
End If
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim loc as Point
loc = e.Location
Dim sizex, sizey as Integer
sizex = Math.Abs(zoomstart.X - loc.X)
sizey = Math.Abs(zoomstart.Y - loc.Y)
zoomwidth = Math.Max(sizex, sizey)
If loc.X < zoomstart.X Then
zoomfirst.X = loc.X
Else
zoomfirst.X = zoomstart.x
End If
If loc.Y < zoomstart.Y Then
zoomfirst.Y = loc.Y
Else
zoomfirst.Y = zoomstart.Y
End If
If zoomwidth > 10 Then
MouseAction = T_MouseAction.RectangleZooming
End If
zoomrect = New Rectangle(zoomfirst, New Size(zoomwidth, zoomwidth))
Canvas1.Refresh
End If        
End Sub    

Private Sub Canvas1_MouseWheel(ByVal sender as Object, ByVal e as MouseEventArgs) Handles Canvas1.MouseWheel
If MouseAction = T_MouseAction.Panning Then
Exit Sub
End If
Dim oldzoom as Single = zoom
If e.Delta > 0 Then
zoom = zoom + 0.2
End If
If e.Delta < 0 Then
zoom = Math.Max(zoom - 0.2, 0.2)
End If
Dim mousePosNow as Point = e.Location
Dim x, y as Integer
x = mousePosNow.X
y = mousePosNow.Y
Dim oldoffsetx, oldoffsety as Integer
Dim newoffsetx, newoffsety as Integer
oldoffsetx = CInt(x / oldzoom)
oldoffsety = CInt(y / oldzoom)
newoffsetx = CInt(x / zoom)
newoffsety = CInt(y / zoom)
offsetx = newoffsetx - oldoffsetx + offsetx
offsety = newoffsety - oldoffsety + offsety
MouseAction = T_MouseAction.WheelZooming
Canvas1.Refresh
End Sub    

Private Sub Canvas1_MouseEnter(ByVal sender as Object, ByVal e as EventArgs) Handles Canvas1.MouseEnter
Canvas1.Focus
End Sub
Private Sub Canvas1_MouseLeave(ByVal sender as Object, ByVal e as EventArgs) Handles Canvas1.MouseLeave
Me.Focus
End Sub    
End Class

Public Class Canvas
Inherits Panel
Public Sub New
Me.DoubleBuffered = True
End Sub
End Class

Rod Stephens获得了笑脸的代码，在这种情况下，它只是一个占位符以便稍后在用户控件中绘制图形。(http://csharphelper.com/blog/2014/11/scale-a-drawing-so-it-fits-a-target-area-in-c/)

缩放矩形(行进的蚂蚁(已经在MouseMove事件中正确创建。在MouseUp事件中，我想应用缩放并将所选区域缩放到面板的。在"绘制"事件中，实际缩放由ScaleTransform和TranslateTransform操作。

但我不知道如何计算适当的缩放因子和x/y偏移，所以所选区域按面板大小缩放。我试着定位用于鼠标滚轮缩放。我有点困惑，因为在我看来实际上有两个缩放因素：一个受鼠标滚轮操作的影响以及链接到选择矩形操作的一个。我还尝试将缩放因子计算为类似"selection.width/panel.width"的内容，但这只会给面板导航带来"跳跃"行为，并且不能正确缩放。

如有任何帮助，我们将不胜感激。非常感谢。

Answer 1

所以我自己想出来了。"绘制"事件中只需要一个变换顺序。缩放到矩形的内容在MouseUp事件中处理。缩放区域不是100%适合缩放选择的边界矩形，但所实现的解决方案足以满足我的需求。

以下是有效的解决方案：

Public Class Form1
Private zoomstart as Point
Private zoomfirst as Point
Private zoomwidth as Integer    
Private zoomrect as Rectangle
Private maxzoom As Decimal = 5
Private minzoom As Decimal = 0.2
Private WithEvents tmrMarch as New Timer
Private MarchOffset as Integer = 0
Private OffsetDelta as Integer = 2
Private DashPattern() as Single = {5, 5}
Private zoom As Decimal = 1
Private startx as Integer = 0
Private starty as Integer = 0
Private offsetx as Integer
Private offsety as Integer
Private mouseDownPt as Point
Private initialwidth As Integer
Public WithEvents Canvas1 As New Canvas
Private Enum T_MouseAction
RectangleZooming
Panning
None
End Enum
Private MouseAction As T_MouseAction = T_MouseAction.None

Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
Canvas1.Size = New Size(Me.ClientSize.Width, Me.ClientSize.Width)
Canvas1.AutoScroll = False
initialwidth = Canvas1.Width
Me.Controls.Add(Canvas1)
End Sub

Private Sub Canvas1_Paint(ByVal sender As Object, ByVal e As PaintEventArgs) Handles Canvas1.Paint
e.Graphics.ScaleTransform(CSng(zoom), CSng(zoom))
e.Graphics.TranslateTransform(offsetx, offsety)        
Call DrawImage(e.Graphics)
e.Graphics.ResetTransform
If MouseAction = T_MouseAction.RectangleZooming Then
MarchOffset = MarchOffset + OffsetDelta
Dim pen as New Pen(Color.Black, 2)
pen.DashPattern = DashPattern
pen.DashOffset = MarchOffset
pen.Color = Color.Red
e.Graphics.DrawRectangle(pen, zoomrect)
End If 
End Sub

Private Sub DrawImage(ByVal gr As Graphics)
Dim rect As Rectangle
rect = New Rectangle(0, 0, initialwidth, initialwidth)
gr.FillEllipse(Brushes.LightGreen, rect)
gr.DrawEllipse(Pens.Green, rect)
rect = New Rectangle(0.375 * initialwidth, 0.375 * initialwidth, 0.25 * initialwidth, 0.375 * initialwidth)
gr.FillEllipse(Brushes.LightBlue, rect)
gr.DrawEllipse(Pens.Blue, rect)
rect = New Rectangle(0.1875 * initialwidth, 0.25 * initialwidth, 0.625 * initialwidth, 0.625 * initialwidth)
gr.DrawArc(Pens.Red, rect, 20, 140)
rect = New Rectangle(0.1875 * initialwidth, 0.1875 * initialwidth, 0.1875 * initialwidth, 0.25 * initialwidth)
gr.FillEllipse(Brushes.White, rect)
gr.DrawEllipse(Pens.Black, rect)
rect = New Rectangle(0.25 * initialwidth, 0.25 * initialwidth, 0.125 * initialwidth, 0.125 * initialwidth)
gr.FillEllipse(Brushes.Black, rect)
rect = New Rectangle(0.625 * initialwidth, 0.1875 * initialwidth, 0.1875 * initialwidth, 0.25 * initialwidth)
gr.FillEllipse(Brushes.White, rect)
gr.DrawEllipse(Pens.Black, rect)
rect = New Rectangle(0.6875 * initialwidth, 0.25 * initialwidth, 0.125 * initialwidth, 0.125 * initialwidth)
gr.FillEllipse(Brushes.Black, rect)
End Sub
Private Sub tmrMarch_Tick(ByVal sender as Object, ByVal e as EventArgs) Handles tmrMarch.Tick
Canvas1.Refresh
End Sub    

Private Sub Canvas1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Canvas1.MouseDown
If e.Button = MouseButtons.Middle Then
MouseAction = T_MouseAction.Panning
mouseDownPt = e.Location
startx = offsetx
starty = offsety
End If
If e.Button = MouseButtons.Left Then
zoomstart = e.Location
tmrMarch.Interval = 100
tmrMarch.Enabled = True
End If        
End Sub
Private Sub Canvas1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Canvas1.MouseUp
Cursor = Cursors.Default
tmrMarch.Enabled = False
If MouseAction = T_MouseAction.RectangleZooming Then
Dim oldzoom as Decimal = zoom
zoom = Canvas1.Width / zoomrect.Width * zoom
zoom = Math.Round(zoom / 0.2) * 0.2
zoom = Math.Max(zoom, minzoom)
zoom = Math.Min(zoom, maxzoom)
Dim oldoffsetx, oldoffsety as Integer
Dim newoffsetx, newoffsety as Integer
oldoffsetx = CInt((zoomrect.X + zoomrect.Width / 2) / oldzoom)
oldoffsety = CInt((zoomrect.Y + zoomrect.Height / 2) / oldzoom)
newoffsetx = CInt((zoomrect.X + zoomrect.Width / 2) / zoom)
newoffsety = CInt((zoomrect.Y + zoomrect.Height / 2) / zoom)
offsetx = newoffsetx - oldoffsetx + offsetx
offsety = newoffsety - oldoffsety + offsety
End If
MouseAction = T_MouseAction.None
Canvas1.Refresh
End Sub    

Private Sub Canvas1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Canvas1.MouseMove
If e.Button = MouseButtons.Middle
Cursor = Cursors.Hand
Dim mousePosNow as Point = e.Location
Dim deltaX, deltaY as Integer
deltaX = CInt((mousePosNow.X - mouseDownPt.X) / zoom)
deltaY = CInt((mousePosNow.Y - mouseDownPt.Y) / zoom)
offsetx = CInt(startx + deltaX)
offsety = CInt(starty + deltaY)
Canvas1.Refresh
End If
If e.Button = MouseButtons.Left Then
Dim loc as Point
loc = e.Location
Dim sizex, sizey as Integer
sizex = Math.Abs(zoomstart.X - loc.X)
sizey = Math.Abs(zoomstart.Y - loc.Y)
zoomwidth = Math.Max(sizex, sizey)
If loc.X < zoomstart.X Then
zoomfirst.X = loc.X
Else
zoomfirst.X = zoomstart.x
End If
If loc.Y < zoomstart.Y Then
zoomfirst.Y = loc.Y
Else
zoomfirst.Y = zoomstart.Y
End If
If zoomwidth > 10 Then
MouseAction = T_MouseAction.RectangleZooming
End If
zoomrect = New Rectangle(zoomfirst, New Size(zoomwidth, zoomwidth))
Canvas1.Refresh
End If        
End Sub    

Private Sub Canvas1_MouseWheel(ByVal sender as Object, ByVal e as MouseEventArgs) Handles Canvas1.MouseWheel
If MouseAction = T_MouseAction.Panning Then
Exit Sub
End If
Dim oldzoom as Decimal = zoom
If e.Delta > 0 Then
zoom = Math.Min(zoom + 0.2, maxzoom)
End If
If e.Delta < 0 Then
zoom = Math.Max(zoom - 0.2, minzoom)
End If
Dim mousePosNow as Point = e.Location
Dim x, y as Integer
x = mousePosNow.X
y = mousePosNow.Y
Dim oldoffsetx, oldoffsety as Integer
Dim newoffsetx, newoffsety as Integer
oldoffsetx = CInt(x / oldzoom)
oldoffsety = CInt(y / oldzoom)
newoffsetx = CInt(x / zoom)
newoffsety = CInt(y / zoom)
offsetx = newoffsetx - oldoffsetx + offsetx
offsety = newoffsety - oldoffsety + offsety
Canvas1.Refresh
End Sub    
Private Sub Canvas1_MouseEnter(ByVal sender as Object, ByVal e as EventArgs) Handles Canvas1.MouseEnter
Canvas1.Focus
End Sub
Private Sub Canvas1_MouseLeave(ByVal sender as Object, ByVal e as EventArgs) Handles Canvas1.MouseLeave
Me.Focus
End Sub    
End Class

Public Class Canvas
Inherits Panel
Public Sub New
Me.DoubleBuffered = True
End Sub
End Class