VB.NET 图片在图片框内缩放及移动

一线编程

发布于 2023-03-02 12:58:32

1.2K0

发布于 2023-03-02 12:58:32

文章被收录于专栏：办公魔盒办公魔盒

本方式是通过使用GDI+的方式在图片框内,绘制图片,并实现图片的放大,缩小,移动等操作!

本教程用到了PictureBox图片框的4个事件!

第一个事件:PictureBox图片框的Paint事件用于绘制图片到图片框上!代码如下:


    ''' <summary>
    ''' 图片框绘制图片事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
        If MainImg Is Nothing Then Return
        Dim gfx As Graphics = e.Graphics
        Uscf = Math.Min(CType(e.ClipRectangle.Width, Single) / MainImg.Width, CType(e.ClipRectangle.Height, Single) / MainImg.Height)
        Dim imgCentre As New PointF() With {
            .X = MainImg.Width * 0.5F - Uofs.X,
            .Y = MainImg.Height * 0.5F - Uofs.Y
        }
        Dim plotRect As RectangleF = ImageToPbSpace(0, 0, MainImg.Width, MainImg.Height, PictureBox1.Size, imgCentre, Uzf, Uscf)
        gfx.DrawImage(MainImg, plotRect)
        gfx.Flush()
    End Sub

    ''' <summary>
    ''' 图片填充
    ''' </summary>
    ''' <param name="X"></param>
    ''' <param name="Y"></param>
    ''' <param name="width"></param>
    ''' <param name="height"></param>
    ''' <param name="pbSize"></param>
    ''' <param name="imgCentre"></param>
    ''' <param name="userZoom"></param>
    ''' <param name="fillScale"></param>
    ''' <returns></returns>
    Private Shared Function ImageToPbSpace(X As Single, Y As Single, width As Single, height As Single, pbSize As SizeF, imgCentre As PointF, userZoom As Single, fillScale As Single) As RectangleF
        Return New RectangleF(pbSize.Width * 0.5F + fillScale * userZoom * (X - imgCentre.X), pbSize.Height * 0.5F + fillScale * userZoom * (Y - imgCentre.Y), width * fillScale * userZoom, height * fillScale * userZoom)
    End Function

第二个事件:PictureBox图片框的MouseWheel事件用于鼠标滚轮放大缩小图片!代码如下:

    ''' <summary>
    ''' 图片框滚轮事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseWheel(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseWheel
        If MainImg Is Nothing Then Return
        If e.Delta > 0 Then
            Uzf *= 1.2F
        ElseIf e.Delta < 0 And Uzf >= 0.1 Then
            Uzf /= 1.2F
        End If
        PictureBox1.Invalidate()
    End Sub

以上两个步骤即可完成,图片在图片框内放大缩小图片!!!

第三个事件:PictureBox图片框的MouseDown事件,获取当前鼠标位置,用于移动图片!代码如下:

    ''' <summary>
    ''' 图片框点击事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
        If MainImg Is Nothing Then Return
        Omdp = New PointF(e.X, e.Y)
        Ouof = New PointF(Uofs.X, Uofs.Y)
    End Sub

第四个事件:PictureBox图片框的MouseMove事件,获取当前鼠标位置,并实时计算位置并显示图片!代码如下:

    ''' <summary>
    ''' 图片框图片移动事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
        If MainImg Is Nothing Then Return
        If e.Button = MouseButtons.Left Then
            Dim DeltaMouse As New PointF(e.X - Omdp.X, e.Y - Omdp.Y)
            Dim DeltaImage As New PointF(DeltaMouse.X / (Uzf * Uscf), DeltaMouse.Y / (Uzf * Uscf))
            Uofs = New PointF(Ouof.X + DeltaImage.X, Ouof.Y + DeltaImage.Y)
            If Uofs.X < -MainImg.Width / 2 Then Uofs.X = -MainImg.Width / 2
            If Uofs.X > MainImg.Width / 2 Then Uofs.X = MainImg.Width / 2
            If Uofs.Y < -MainImg.Height / 2 Then Uofs.Y = -MainImg.Height / 2
            If Uofs.Y > MainImg.Height / 2 Then Uofs.Y = MainImg.Height / 2
            PictureBox1.Invalidate()
        End If
    End Sub

以上代码即可完成,图片在图片框内缩放移动;下面贴出完整的代码

Public Class Form1
    Private MainImg As Bitmap '' 加载的全局图片
    Private Uscf As Double, Uofs As New PointF(0, 0) '' 图片缩放
    Private Uzf As Double = 1.0# ''缩放比例
    Private Omdp As PointF, Ouof As PointF '' 移动的点位

    ''' <summary>
    ''' 加载显示图片
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim imgpath As String = Application.StartupPath & "\一线编程LOGO_YS.png"
        MainImg = New Bitmap(imgpath)
        PictureBox1.Refresh()
    End Sub

    ''' <summary>
    ''' 恢复原图
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Uzf = 1
        Uofs = New PointF(0, 0)
        PictureBox1.Refresh()
    End Sub

    ''' <summary>
    ''' 图片填充
    ''' </summary>
    ''' <param name="X"></param>
    ''' <param name="Y"></param>
    ''' <param name="width"></param>
    ''' <param name="height"></param>
    ''' <param name="pbSize"></param>
    ''' <param name="imgCentre"></param>
    ''' <param name="userZoom"></param>
    ''' <param name="fillScale"></param>
    ''' <returns></returns>
    Private Shared Function ImageToPbSpace(X As Single, Y As Single, width As Single, height As Single, pbSize As SizeF, imgCentre As PointF, userZoom As Single, fillScale As Single) As RectangleF
        Return New RectangleF(pbSize.Width * 0.5F + fillScale * userZoom * (X - imgCentre.X), pbSize.Height * 0.5F + fillScale * userZoom * (Y - imgCentre.Y), width * fillScale * userZoom, height * fillScale * userZoom)
    End Function

    ''' <summary>
    ''' 图片框点击事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
        If MainImg Is Nothing Then Return
        Omdp = New PointF(e.X, e.Y)
        Ouof = New PointF(Uofs.X, Uofs.Y)
    End Sub

    ''' <summary>
    ''' 图片框图片移动事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
        If MainImg Is Nothing Then Return
        If e.Button = MouseButtons.Left Then
            Dim DeltaMouse As New PointF(e.X - Omdp.X, e.Y - Omdp.Y)
            Dim DeltaImage As New PointF(DeltaMouse.X / (Uzf * Uscf), DeltaMouse.Y / (Uzf * Uscf))
            Uofs = New PointF(Ouof.X + DeltaImage.X, Ouof.Y + DeltaImage.Y)
            If Uofs.X < -MainImg.Width / 2 Then Uofs.X = -MainImg.Width / 2
            If Uofs.X > MainImg.Width / 2 Then Uofs.X = MainImg.Width / 2
            If Uofs.Y < -MainImg.Height / 2 Then Uofs.Y = -MainImg.Height / 2
            If Uofs.Y > MainImg.Height / 2 Then Uofs.Y = MainImg.Height / 2
            PictureBox1.Invalidate()
        End If
    End Sub


    ''' <summary>
    ''' 图片框滚轮事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_MouseWheel(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseWheel
        If MainImg Is Nothing Then Return
        If e.Delta > 0 Then
            Uzf *= 1.2F
        ElseIf e.Delta < 0 And Uzf >= 0.1 Then
            Uzf /= 1.2F
        End If
        PictureBox1.Invalidate()
    End Sub

    ''' <summary>
    ''' 图片框绘制图片事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
        If MainImg Is Nothing Then Return
        Dim gfx As Graphics = e.Graphics
        Uscf = Math.Min(CType(e.ClipRectangle.Width, Single) / MainImg.Width, CType(e.ClipRectangle.Height, Single) / MainImg.Height)
        Dim imgCentre As New PointF() With {
            .X = MainImg.Width * 0.5F - Uofs.X,
            .Y = MainImg.Height * 0.5F - Uofs.Y
        }
        Dim plotRect As RectangleF = ImageToPbSpace(0, 0, MainImg.Width, MainImg.Height, PictureBox1.Size, imgCentre, Uzf, Uscf)
        gfx.DrawImage(MainImg, plotRect)
        gfx.Flush()
    End Sub
End Class

本文参与腾讯云自媒体分享计划，分享自微信公众号。

原始发表：2022-02-25，如有侵权请联系 cloudcommunity@tencent.com 删除

gdi