VB.NET 在PictureBox控件里面实现图片放大缩小

2019-12-18 10:50:05 浏览数 (2)

--动画展示--


   看了上面的动画是不是也想在自己的项目里面实现同样的效果呢?接下来且看代码的实现过程吧!

一、先定义相关变量

代码语言:javascript复制
  Private vb_img As Image  ''定义图片对象
  Private moe_p As Point  ''鼠标坐标点
  Private st_x As Single = 0, st_y As Single = 0 ''开始坐标点
  Private img_x As Single = 0, img_y As Single = 0 ''图片开始坐标点
  Private moe_tf As Boolean = False  ''鼠标状态
  Private img_sc As Single = 1, img_sc_dpi As Single = 1  ''缩放

二、窗体事件

代码语言:javascript复制
  Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        vb_img = Image.FromFile(Application.StartupPath & "test.jpg")  ''装载图片
        Init_img() '’初始化对象
  End Sub

三、初始化图片参数

代码语言:javascript复制
    Private Sub Init_img()
        If vb_img Is Nothing Then
            Return
        End If
        Dim gh As Graphics = CreateGraphics()
        img_sc = (PictureBox1.Width / CType(vb_img.Width, Single)) * (vb_img.HorizontalResolution / gh.DpiX)
        PictureBox1.Refresh()
        img_sc_dpi = (vb_img.HorizontalResolution / gh.DpiX)
    End Sub

四、图片框PictureBox1_Paint事件

代码语言:javascript复制

    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
        If vb_img Is Nothing Then
            Return
        End If
        e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        e.Graphics.ScaleTransform(img_sc, img_sc)
        e.Graphics.DrawImage(vb_img, img_x, img_y)
    End Sub

五、图片框PictureBox1_MouseMove事件

代码语言:javascript复制
    Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
        Dim moe_e As MouseEventArgs = e, noe_n As Point = moe_e.Location
        If moe_e.Button = MouseButtons.Left Then
            If moe_tf Then
                Dim de_X As Integer = noe_n.X - moe_p.X, de_Y As Integer = noe_n.Y - moe_p.Y
                img_x = CType(st_x   (de_X / img_sc), Integer)
                img_y = CType(st_y   (de_Y / img_sc), Integer)

                PictureBox1.Refresh()
            End If
        End If

        ''显示坐标
        Dim m_imgx As Integer = img_sc_dpi * ((moe_e.Location.X / img_sc) - img_x)
        Dim m_imgy As Integer = img_sc_dpi * ((moe_e.Location.Y / img_sc) - img_y)
        Text = "当前坐标:"   vbCrLf   " X:"   m_imgx.ToString()   " Y:"   m_imgy.ToString()
    End Sub

六、图片框PictureBox1_MouseDown事件

代码语言:javascript复制
    Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
        Dim moe_e As MouseEventArgs = e
        If moe_e.Button = Global.System.Windows.Forms.MouseButtons.Left Then
            If Not moe_tf Then
                moe_tf = True
                moe_p = moe_e.Location
                st_x = img_x
                st_y = img_y
            End If
        End If
    End Sub

七、图片框PictureBox1_MouseUp事件

代码语言:javascript复制
   Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
        moe_tf = False
    End Sub

八、窗体Form1_MouseWheel鼠标滚轮事件

代码语言:javascript复制
Private Sub Form1_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
        Dim old_sc As Single = img_sc

        If e.Delta > 0 Then
            img_sc  = 0.1F

        ElseIf e.Delta < 0 Then
            img_sc = Math.Max(img_sc - 0.1F, 0.01F)
        End If

        Dim moe_e As MouseEventArgs = e, noe_n As Point = moe_e.Location

        Dim x As Integer = noe_n.X - PictureBox1.Location.X
        Dim y As Integer = noe_n.Y - PictureBox1.Location.Y

        Dim old_img_x As Integer = x / old_sc
        Dim old_img_y As Integer = y / old_sc

        Dim new_img_x As Integer = x / img_sc
        Dim new_img_y As Integer = y / img_sc

        img_x = new_img_x - old_img_x   img_x
        img_y = new_img_y - old_img_y   img_y

        PictureBox1.Refresh()

        ''显示坐标
        Dim m_img_x As Integer = (moe_e.Location.X / img_sc) - img_x
        Dim m_img_y As Integer = (moe_e.Location.Y / img_sc) - img_y
        Text = "当前坐标:"   vbCrLf   " X:"   m_img_x.ToString()   " Y:"   m_img_y.ToString()
    End Sub

九、图片框PictureBox1_DoubleClick事件

代码语言:javascript复制
    Private Sub PictureBox1_DoubleClick(sender As Object, e As EventArgs) Handles PictureBox1.DoubleClick
        img_x = 0
        img_y = 0
        Init_img()
    End Sub

本公众号个人博客

代码语言:javascript复制
 http://vbee.xyz

好了今天教程到此结束啦!

0 人点赞