窗体上放置一个按钮button1,一个图片框picture1和一个图象框image1
image1是放在picture1中的.实现了图片拖放平移的功能,今天朋友要我帮他解决,也就即刻写了这么一段
' 拖动标志
Dim bEnDrag As Boolean
' 当前鼠标位置
Dim curX As Long
Dim curY As Long
Private Sub Command1_Click()
'加载新图片
Image1.Picture = LoadPicture(App.Path & "/71.jpg")
End Sub
Private Sub Form_Load()
'初始化控件
Image1.Left = 0
Image1.Top = 0
bEnDrag = False
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' 拖放开始
bEnDrag = True
curX = X
curY = Y
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' On Error Resume Next
If bEnDrag Then
Dim newX As Long, newY As Long
' 先算出要拖放的新位置
newX = Image1.Left + X - curX
newY = Image1.Top + Y - curY
' 判断边界防止图片出界(左上角位置)
If newY > 0 Then newY = 0
If newX > 0 Then newX = 0
' 判断边界防止图片出界(右边位置)
If Image1.Width > Picture1.Width Then
If newX < -(Image1.Width - Picture1.Width) Then
newX = -(Image1.Width - Picture1.Width)
End If
Else
newX = 0
End If
' 判断边界防止图片出界(底部边位置)
If Image1.Height > Picture1.Height Then
If newY < -(Image1.Height - Picture1.Height) Then
newY = -(Image1.Height - Picture1.Height)
End If
Else
newY = 0
End If
' 给图片设置新的位置
Image1.Left = newX
Image1.Top = newY
End If
End Sub
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'拖放结束
bEnDrag = False
End Sub