vb.net - 如何在vb.net中使用滚轮放大图片框

Question

我正在使用一组图形叠加层使用图形对象在图片框控件内绘制图像。我已将图片框放置在面板内并将面板设置为自动滚动。我现在需要知道如何使用鼠标滚轮以小增量放大图片的大小，同时保持绘制图像的质量。有人知道该怎么做吗？

当我使用下面的 Abdias 软件代码进行更新时，当图片框的 Sizemode 属性设置为 StretchImage 时，图片开始变小。我有一个鼠标平移功能，可能会干扰此代码正常工作。有任何想法吗？是什么导致它无法正常工作？

已解决

这段代码对我来说比下面两个代码效果更好:

Private Sub PictureBox_MouseWheel(sender As System.Object,
                             e As MouseEventArgs) Handles PictureBox1.MouseWheel
    If e.Delta <> 0 Then
        If e.Delta <= 0 Then
            If PictureBox1.Width < 500 Then Exit Sub 'minimum 500?
        Else
            If PictureBox1.Width > 2000 Then Exit Sub 'maximum 2000?
        End If

        PictureBox1.Width += CInt(PictureBox1.Width * e.Delta / 1000)
        PictureBox1.Height += CInt(PictureBox1.Height * e.Delta / 1000)
    End If

End Sub

Answer 1

你可以试试这个代码。它假设表单上存在 Panel1 和 PictureBox1(Panel1 内有 PictureBox1，其中 Panel1. AutoScroll = True)，并在 PictureBox 上设置图像。

代码不会计算缩放的中心点，但您可以使用 e.Location(或 e.X/e.Y)来计算。

更新 - 这是新代码(应该)比以前更强大(见底部):

Public Class Form1

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

    Private Sub Form_MouseWheel(sender As System.Object, 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(sender As System.Object, 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

旧代码 - 可以工作，但在较大变化时不稳定，可能是由于 Scale() 中的舍入错误:

Public Class Form1

    Private _scale As New SizeF(1, 1)
    Private _scaleDelta As New SizeF(0.01, 0.01) '1% for each wheel tick

    Private Sub Form_MouseWheel(sender As System.Object, 
                                e As MouseEventArgs) Handles Me.MouseWheel
'count incrementally 
        _scale.Height = 1
        _scale.Width = 1

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

        If e.Delta <> 0 Then _
        PictureBox1.Scale(_scale)

    End Sub

    Private Sub Form1_Load(sender As System.Object, 
                           e As EventArgs) Handles MyBase.Load

        PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage

        'init picturebox size = image size
        If PictureBox1.Image IsNot Nothing Then
            PictureBox1.Scale(New SizeF(1, 1))
            PictureBox1.Size = PictureBox1.Image.Size
        End If

    End Sub

End Class