我有一个Picturebox，我可以在上面绘制一个矩形，并且我有它，以便记录矩形尺寸（百分比），这样如果表单的大小发生变化，那么矩形大小也会变化（请参阅下面的代码）文本）
然而，当我在“缩放”模式下使用Picturebox时，调整大小时矩形不匹配（参见此处：第一个，图像http://i1262.photobucket.com/albums/ii602/bmgh85/Size1.png上定义点上的角，然后调整大小后第二个表格http://i1262.photobucket.com/albums/ii602/bmgh85/Size2.png
它在“拉伸”模式下工作正常，但是会使图像偏斜，这对我没用（我需要保持比例）。如何操作我的代码以使其按预期工作？
Private x, y As Integer
Private Rct As New Rectangle(0, 0, 0, 0)
Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
x = e.X
y = e.Y
End If
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Rct.X = Math.Min(x, e.X)
Rct.Y = Math.Min(y, e.Y)
Rct.Height = Math.Abs(e.Y - y)
Rct.Width = Math.Abs(e.X - x)
PictureBox1.Refresh()
PictureBox1.Tag = calculatePercent(Rct.X, Rct.Y, Rct.Height, Rct.Width, PictureBox1)
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
MsgBox(PictureBox1.Tag)
Dim lst1 As List(Of Int32) = returnPercent(PictureBox1.Tag)
For i = 0 To lst1.Count - 1
MsgBox(lst1(i))
Next
End Sub
Private Sub PictureBox1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
e.Graphics.DrawRectangle(Pens.Red, Rct)
End Sub
Function calculatePercent(ByVal X As Long, Y As Long, Ht As Long, Wth As Long, pBox As PictureBox)
Dim wPercent As Long = 100 * Wth / pBox.Width
Dim hPercent As Long = 100 * Ht / pBox.Height
Dim yPercent As Long = 100 * Y / pBox.Height
Dim xPercent As Long = 100 * X / pBox.Width
Return "X:" & xPercent & ", Y:" & yPercent & ", Ht:" & hPercent & ", Wth:" & wPercent
End Function
Function returnPercent(ByVal myTag As String)
Dim lst As New List(Of Int32)
Dim getX As String = getNum(Mid(myTag, InStr(myTag, "X:"), InStr(myTag, ", Y:") - InStr(myTag, "X:")))
Dim getY As String = getNum(Mid(myTag, InStr(myTag, ", Y:"), InStr(myTag, ", Ht:") - InStr(myTag, ", Y:")))
Dim getH As String = getNum(Mid(myTag, InStr(myTag, ", Ht:"), InStr(myTag, ", Wth:") - InStr(myTag, ", Ht:")))
Dim getW As String = getNum(Mid(myTag, InStr(myTag, ", Wth:")))
lst.Add(getX)
lst.Add(getY)
lst.Add(getH)
lst.Add(getW)
Return lst
End Function
Function getNum(ByVal txt As String)
Dim rtn As String = vbNullString
Dim coln As MatchCollection = Regex.Matches(txt, "\d+")
For Each mtch As Match In coln
rtn = rtn & mtch.ToString
Next
Return Convert.ToInt32(rtn)
End Function
Private Sub PictureBox1_SizeChanged(sender As Object, e As EventArgs) Handles PictureBox1.SizeChanged
Dim lst As New List(Of Int32)
If PictureBox1.Tag <> "" Then
lst = returnPercent(PictureBox1.Tag)
Rct.X = lst(0) * PictureBox1.Width / 100
Rct.Y = lst(1) * PictureBox1.Height / 100
Rct.Height = lst(2) * PictureBox1.Height / 100
Rct.Width = lst(3) * PictureBox1.Width / 100
PictureBox1.Refresh()
End If
End Sub
答案 0 :(得分：0)
我有一些可能对您有帮助的代码：
' Rectangle to draw
Private Rct As New Rectangle(0, 0, 0, 0)
Private offsetX As Integer = 0
Private offsetY As Integer = 0
Sub Main() Handles MyBase.Load
' Some image to use
MiniPictureBox.Image = My.Resources.P6130003
MainPictureBox.Image = My.Resources.P6130003
End Sub
Private Sub MiniPictureBox_MouseDown(sender As Object, e As MouseEventArgs) Handles MiniPictureBox.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
If Not Rct.Contains(e.Location) Then
' New rectangle
Rct.Location = New Point(e.X, e.Y)
Else
' Moving a rectangle
offsetX = Rct.X - e.X
offsetY = Rct.Y - e.Y
End If
ElseIf e.Button = Windows.Forms.MouseButtons.Right Then
' Clears the screen of a rectangle
Rct = New Rectangle(0, 0, 0, 0)
MiniPictureBox.Invalidate()
End If
End Sub
Private Sub MiniPictureBox_MouseMove(sender As Object, e As MouseEventArgs) Handles MiniPictureBox.MouseMove
' Event handler to update the picture of the rectangle
If e.Button = Windows.Forms.MouseButtons.Left Then
If Rct.Contains(e.Location) Then
' Move the box
Rct.X = e.X + offsetX
Rct.Y = e.Y + offsetY
MainPictureBox.Invalidate()
Else
' Update the size of the box
Rct.Width = e.X - Rct.X
Rct.Height = e.Y - Rct.Y
End If
MiniPictureBox.Invalidate()
End If
End Sub
Private Sub MiniPictureBox_MouseUp(sender As Object, e As MouseEventArgs) Handles MiniPictureBox.MouseUp
' Event handler to call the paint event for runtime display
MiniPictureBox.Invalidate()
MainPictureBox.Invalidate()
End Sub
Private Sub MiniPictureBox_Paint(sender As Object, e As PaintEventArgs) Handles MiniPictureBox.Paint
Dim myPen As Pen = New Pen(Brushes.Red, 2)
e.Graphics.DrawRectangle(myPen, Rct)
End Sub
Private Sub MainPictureBox_Paint(sender As Object, e As PaintEventArgs) Handles MainPictureBox.Paint
If Rct.Width > 0 Then
Dim biggerRec As Rectangle = CalculateRectangle(MainPictureBox)
Dim myPen As Pen = New Pen(Brushes.Red, 2)
e.Graphics.DrawRectangle(myPen, biggerRec)
End If
End Sub
Private Function CalculateRectangle(currentPicture As PictureBox) As Rectangle
Try
Dim newWidth As Integer = (Rct.Width / MiniPictureBox.Width) * currentPicture.Image.Width
Dim newHeight As Integer = (Rct.Height / MiniPictureBox.Height) * currentPicture.Image.Height
Dim newX As Integer = (Rct.X / MiniPictureBox.Width) * currentPicture.Image.Width
Dim newY As Integer = (Rct.Y / MiniPictureBox.Height) * currentPicture.Image.Height
Return New Rectangle(newX, newY, newWidth, newHeight)
Catch ex As Exception
MessageBox.Show(ex.Message + Environment.NewLine + Environment.NewLine + ex.StackTrace)
End Try
End Function
此代码允许您创建，移动和清除矩形。有一点需要注意的是，在计算更改矩形的大小时，必须确保为任何算术异常正确插入异常处理。