如何在 vb.net 中使用按钮而不是滚轮放大图片框？

Question

我正在使用下面的代码使用滚轮缩放 picturebox1 中的 in\out 图像，但现在我想使用按钮而不是放大按钮和缩小按钮

提前致谢此代码来自：How to zoom in a Picturebox with scrollwheel in vb.net

Public Class Form1




    Private _originalSize As Size = Nothing
    Private _scale As Single = 1
    Private _scaleDelta As Single = 0.0005

    Private Sub Form_MouseWheel(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel

        'if very sensitive mouse, change 0.00005 to something even smaller   
        _scaleDelta = Math.Sqrt(PictureBox1.Width * PictureBox1.Height) * 0.00005

        If e.Delta < 0 Then
            _scale -= _scaleDelta
        ElseIf e.Delta > 0 Then
            _scale += _scaleDelta
        End If

        If e.Delta <> 0 Then _
        PictureBox1.Size = New Size(CInt(Math.Round(_originalSize.Width * _scale)), _
                                    CInt(Math.Round(_originalSize.Height * _scale)))

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage

        'init this from here or a method depending on your needs
        If PictureBox1.Image IsNot Nothing Then
            PictureBox1.Size = Panel1.Size
            _originalSize = Panel1.Size
        End If

    End Sub

End Class

Answer 1

下面的代码应该可以满足您的需要。当鼠标在 button1 上按下时，图片框将按比例缩小。您当然可能需要添加检查以设置最小尺寸。人们可能不赞成使用 Application.DoEvents，但在这种情况下，如果您作为用户忙于按住鼠标按钮而不做任何其他可能导致问题的事情，对您来说可能没问题。

基本上发生的事情是..当用户点击 button1 时，程序将变量 mouseIsDown 设置为 True 并执行 ShrinkPictureBox 中的代码此循环将保持运行直到 mouseIsDown 设置为假。

循环中的

Application.Doevents 使系统能够监听 MouseUp 事件。发生这种情况时，mouseIsDown 被设置为 false，循环将结束。

除了执行 EnlargeBox 代码外，按钮 2 也一样。

我要在这里补充一点，Application.DoEvents 不能随便使用。大多数时候这是一个坏主意，因为如果程序忙于做某事，它允许用户点击您可能不希望他们点击的东西。

Private _originalSize As Size = Nothing
Private _scale As Single = 1
Private _scaleDelta As Single = 0.00005
Dim mouseIsDown As Boolean = False



Private Sub ShrinkPictureBox()
    Do While mouseIsDown
        Application.DoEvents()
        If PictureBox1.Size.Width > 2 Then
            _scale -= _scaleDelta
            PictureBox1.Size = New Size(CInt(Math.Round(_originalSize.Width * _scale)),
                                CInt(Math.Round(_originalSize.Height * _scale)))
            PictureBox1.Refresh()
        End If
    Loop
End Sub

Private Sub EnlargePictureBox()
    Do While mouseIsDown
        Application.DoEvents()
        _scale += _scaleDelta
        PictureBox1.Size = New Size(CInt(Math.Round(_originalSize.Width * _scale)),
                                    CInt(Math.Round(_originalSize.Height * _scale)))
        PictureBox1.Refresh()
    Loop
End Sub

Private Sub Button1_MouseDown(sender As Object, e As MouseEventArgs) Handles Button1.MouseDown
    mouseIsDown = True
    ShrinkPictureBox()
End Sub

Private Sub Button1_MouseUp(sender As Object, e As MouseEventArgs) Handles Button1.MouseUp
    mouseIsDown = False
End Sub

Private Sub Button2_MouseDown(sender As Object, e As MouseEventArgs) Handles Button2.MouseDown
    mouseIsDown = True
    EnlargePictureBox()
End Sub

Private Sub Button2_MouseUp(sender As Object, e As MouseEventArgs) Handles Button2.MouseUp
    mouseIsDown = False
End Sub

如何在 vb.net 中使用按钮而不是滚轮放大图片框？

How to zoom in a Picturebox with Buttons instead of scrollwheel in vb.net?

vb.net

zooming