Vb.net 使用缩放调整Picturebox上相对于图像绘制的矩形的大小

我有一个画框，可以在上面画一个矩形，这样就可以记录矩形的尺寸（以百分比为单位），这样，如果表单的大小发生变化，那么矩形的大小也会发生变化（请参见文本下面的代码）

但是，当我将Picturebox设置为“缩放”模式时，矩形在调整大小时不匹配（请参见此处：第一个矩形，在图像上定义的点上有角，然后在调整形状大小后第二个矩形）

它可以在“拉伸”模式下正常工作，但这会扭曲图像，这对我没有用（我需要保持比例）。如何操作代码使其按预期工作

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

Private x，y为整数
私有Rct作为新矩形（0,0,0,0）
私有子PictureBox1\u MouseDown（ByVal sender作为对象，ByVal e作为System.Windows.Forms.MouseEventArgs）处理PictureBox1.MouseDown
如果e.Button=Windows.Forms.MouseButtons.Left，则
x=e.x
y=e.y
如果结束
端接头
私有子PictureBox1\u MouseMove（ByVal sender作为对象，ByVal e作为System.Windows.Forms.MouseEventArgs）处理PictureBox1.MouseMove
如果e.Button=Windows.Forms.MouseButtons.Left，则
Rct.X=数学最小值（X，e.X）
Rct.Y=数学最小值（Y，e.Y）
Rct高度=数学绝对值（e.Y-Y）
Rct.Width=Math.Abs（e.X-X）
PictureBox1.Refresh（）
PictureBox1.Tag=计算百分比（Rct.X，Rct.Y，Rct.Height，Rct.Width，PictureBox1）
如果结束
端接头
私有子PictureBox1\u MouseUp（发送方作为对象，e作为MouseEventArgs）处理PictureBox1.MouseUp
MsgBox（PictureBox1.Tag）
Dim lst1作为列表（Int32的）=返回百分比（PictureBox1.Tag）
对于i=0到lst1。计数-1
MsgBox（lst1（i））
下一个
端接头
私有子PictureBox1_Paint（ByVal sender作为System.Object，ByVal e作为System.Windows.Forms.PaintEventArgs）处理PictureBox1.Paint
e、 图形.绘图矩形（钢笔.红色，Rct）
端接头
函数计算百分比（ByVal X为长，Y为长，Ht为长，Wth为长，pBox为图片框）
长时的尺寸百分比=100*Wth/pBox.宽
长度时的尺寸百分比=100*Ht/pBox.高度
尺寸长度=100*Y/pBox.高度
长度为100*X/pBox.宽度时的尺寸百分比
返回“X:&xPercent&”，Y:&yPercent&”，Ht:&hPercent&”，Wth:&wPercent
端函数
函数returnPercent（ByVal myTag作为字符串）
Dim lst作为新列表（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:））
第一次添加（getX）
第一次添加（getY）
第一次添加（getH）
第一次添加（getW）
返回lst
端函数
函数getNum（ByVal txt作为字符串）
Dim rtn As String=vbNullString
Dim coln As MatchCollection=Regex.Matches（txt，“\d+”）
对于每个mtch As匹配，以coln为单位
rtn=rtn&mtch.ToString
下一个
返回Convert.ToInt32（rtn）
端函数
私有子PictureBox1\u SizeChanged（发送方作为对象，e作为事件参数）处理PictureBox1.SizeChanged
Dim lst作为新列表（Int32）
如果是PictureBox1.Tag“”，则
lst=返回百分比（PictureBox1.Tag）
Rct.X=lst（0）*图1.宽度/100
Rct.Y=lst（1）*图1.高度/100
Rct.高度=lst（2）*图1.高度/100
Rct.宽度=lst（3）*图1.宽度/100
PictureBox1.Refresh（）
如果结束
端接头

我有一些代码可以帮助您：

    ' 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

---

此代码将允许您创建、移动和清除矩形。需要注意的一点是，在更改矩形大小的计算中，您必须确保为任何算术异常正确插入异常处理。

我们是双胞胎！我之前有一个非常类似的问题：虽然问题不同，但我认为您的问题是您没有使用graphics.fromimage直接在图像上绘制（这是很多人推荐的，而不是e.graphics）。我会尝试一下，并且rect会随着您的图像自动调整大小（因为它是在位图上绘制的）。问题是，我在表单的其他3个位置使用了该图像，但只希望该实例上有矩形（因此我需要执行此操作并存储百分比值，以便稍后再次调用）。如果我这样做，那么它不包括保存原始图像和编辑后的图像，这意味着磁盘上使用了更多的空间吗？或者它仍然只会在该实例上给我所需的效果，并且仍然会被动态调用吗？它包括保存一个副本位图/图像，是的。但我最终用我的照片（可以高达1980x680）完成了这项工作而且没有发现延迟或大空间问题。但是，我不知道你的要求是什么。我的老板对硬盘占用空间非常挑剔。如果某些东西可以保存得更小，那么它就必须更小（通常以牺牲质量为代价-他对it或图形没有太多的知识）。我想我可能刚刚想到了一个解决方案。如果我使用缩放，我应该仍然能够获得图像尺寸（而不是picturebox）然后从中计算出%。简单地说，你的问题中你的应用程序中的摄像头使用了什么？开始在我正在做的事情上添加摄像头加载项，但使用API调用会让我很痛苦，因为这些对XP以上的驱动程序来说都是喜怒无常的