在图片框中绘制矩形没有为鼠标正确缩放

Question

我目前有一个图片框，用户将在其中单击并拖动以在图像上绘制一个矩形（可以定期更改）。完成后（mouse_up），我将在文本框中显示矩形的相对点与分辨率。

因此，例如，用户从左上角 (0,0) 到右下角绘制 1920 x 680 图像 (picturebox.right, picturebox.bottom) 的矩形，文本框将显示 (1920,680 ) 为终点。这主要是比例的东西。

我正在使用我上一个问题 (Having trouble drawing simple rectangle in picturebox) 的答案中的代码来绘制它。

问题：该框不跟随鼠标，因为图像必须在拉伸模式下完成。它们通常非常大（如 1920 x 680）并且无法放入常规 gui。有多种分辨率，所以必须动态调整比率。如果不进行编辑，此代码在正常模式下工作得很好，但这不适用于可用性。因此，当您绘制框时，它真的很小并且与鼠标无关（因此我无法在文本框上显示终点）。

这是我的意思的一个例子。我将鼠标拖到图像的一半：

我尝试过的：我尝试过通过比率来解决它，但它仍然不能解决显示终点的问题，或者它真的能很好地跟随鼠标.它通常向左偏移至少 10 个左右像素。这是我调整后的代码：

    Private Sub DrawRectangle(ByVal pnt As Point)

    Try
        Dim g As Graphics

        g = Graphics.FromImage(img)

        g.DrawImage(imgClone, 0, 0) 'we are clearing img with imgClone. imgClone contains the original image without the rectangles

        Dim w_ratio As Integer = Math.Floor(img.Width / pbZoneImage.Width)
        Dim h_ratio As Integer = Math.Floor(img.Height / pbZoneImage.Height)
        Dim customPen As New Pen(currentColor, 5)

        'If pnt.X = mouse_Down.X Or pnt.Y = mouse_Down.Y Then
        '    g.DrawLine(customPen, mouse_Down.X, mouse_Down.Y, pnt.X * w_ratio, pnt.Y * h_ratio)

        'Else
        theRectangle = New Rectangle(Math.Min(mouse_Down.X, pnt.X * w_ratio), Math.Min(mouse_Down.Y, pnt.Y * h_ratio),
                    Math.Abs(mouse_Down.X - pnt.X * w_ratio), Math.Abs(mouse_Down.Y - pnt.Y * h_ratio))

        g.DrawRectangle(customPen, theRectangle)

        'End If

        g.Dispose()

        pbZoneImage.Invalidate() 'draw img to picturebox


    Catch ex As Exception

    End Try

End Sub

我也尝试过让结束显示点 (x,y) 与矩形的相对端相匹配，但它再次无法使用比率。

关于如何使这项工作在正常模式下和在拉伸模式下一样好，有什么想法吗？我也对不同的控件或一般的任何提示持开放态度。谢谢！

Answer 1

这可以通过多种方式完成，但最简单的方法是使用 picturebox 和 SizeMode = Normal。加载图片：

img = New Bitmap(pbZoneImage.Width, pbZoneImage.Height)

imgClone = My.Resources.... 'real dimensions

Dim g As Graphics = Graphics.FromImage(img)

'it will scale the image, no need for stretch mode
g.DrawImage(imgClone, 0, 0, pbZoneImage.Width, pbZoneImage.Height)

g.Dispose()

pbZoneImage.Image = img

然后正常绘制：

Private Sub DrawRectangle(ByVal pnt As Point)

Try
    Dim g As Graphics

    g = Graphics.FromImage(img)

    g.DrawImage(imgClone, 0, 0, pbZoneImage.Width, pbZoneImage.Height) 'we are clearing img with imgClone. imgClone contains the original image without the rectangles

    Dim customPen As New Pen(currentColor, 5)

    'If pnt.X = mouse_Down.X Or pnt.Y = mouse_Down.Y Then
    '    g.DrawLine(customPen, mouse_Down.X, mouse_Down.Y, pnt.X * w_ratio, pnt.Y * h_ratio)

    'Else
    theRectangle = New Rectangle(Math.Min(mouse_Down.X, pnt.X), Math.Min(mouse_Down.Y, pnt.Y),
                Math.Abs(mouse_Down.X - pnt.X), Math.Abs(mouse_Down.Y - pnt.Y))

    g.DrawRectangle(customPen, theRectangle)

    'End If

    g.Dispose()

    pbZoneImage.Invalidate() 'draw img to picturebox


    Catch ex As Exception

    End Try

End Sub

在mouse up event缩放得到正确的结果：

Private Sub pbZoneImage_MouseUp(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles pbZoneImage.MouseUp
    Dim width, height As Integer

    width = CInt(Math.Abs(mouse_Down.X - e.X) * (imgClone.Width / pbZoneImage.Width))
    height = CInt(Math.Abs(mouse_Down.Y - e.Y) * (imgClone.Height / pbZoneImage.Height))

    TextBox1.Text = width.ToString + " " + height.ToString
End Sub