如何在vb.net中使用滚轮放大Picturebox

我正在使用一组图形叠加来使用图形对象在图片框控件内绘制图像.我已将PictureBox放在Panel中,并将Panel设置为自动滚动.我现在需要知道的是使用鼠标滚轮以小幅度增大图片的大小,同时保持绘制图像的质量.有人知道怎么做吗?

当我使用下面的Abdias软件代码更新时,当pictureBox的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
您可以尝试此代码.假设窗体上存在Panel1和PictureBox1(Panel1内的PanelBox1,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

相关文章

Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强...
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办...
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace...
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用...
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选...
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As Dat...