--动画展示--
看了上面的动画是不是也想在自己的项目里面实现同样的效果呢?接下来且看代码的实现过程吧!
一、先定义相关变量
代码语言: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