本方式是通过使用GDI 的方式在图片框内,绘制图片,并实现图片的放大,缩小,移动等操作!
本教程用到了PictureBox图片框的4个事件!
第一个事件:PictureBox图片框的Paint事件用于绘制图片到图片框上!代码如下:
代码语言：javascript复制
''' <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事件用于鼠标滚轮放大缩小图片!代码如下:
代码语言：javascript复制 ''' <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事件,获取当前鼠标位置,用于移动图片!代码如下:
代码语言：javascript复制 ''' <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事件,获取当前鼠标位置,并实时计算位置并显示图片!代码如下:
代码语言：javascript复制 ''' <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以上代码即可完成,图片在图片框内缩放移动;下面贴出完整的代码
代码语言：javascript复制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
