我想在一个picturebox中拖动另一个picturebox,当松开鼠标时被拖动的pic会定位在鼠标的当前位置,给个例子代码好吗

wangwei1980 2003-08-21 11:08:55
我想在一个picturebox中拖动另一个picturebox,当松开鼠标时被拖动的pic会定位在鼠标的当前位置,给个例子代码好吗
...全文
24 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
danielinbiti 2003-08-21
  • 打赏
  • 举报
回复
picture1为容器
Dim old_picX As Single
Dim old_picY As Single
Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is PictureBox Then
Source.Move (X - old_picX), (Y - old_picY)
End If
End Sub

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
old_picX = X
old_picY = Y
Picture2.Drag vbBeginDrag
End Sub

Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture2.Drag vbEndDrag
End Sub
dandy1437 2003-08-21
  • 打赏
  • 举报
回复
模块中
Public Sub picSelMoveDown(ByVal vobject As picturebox, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
isMove = True
bX = x
bY = y
End If
If Button = 1 And vobject.MousePointer = 8 Then
bX = x
bY = y
bW = vobject.Width
bH = vobject.Height
End If
End Sub
Public Sub picSelMoveIn(ByVal vobject As picturebox, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 And isMove And vobject.MousePointer = 0 Then
vobject.Move x + vobject.Left - bX, y + vobject.Top - bY
End If
If Button = 0 Then
If x > vobject.Width - 150 And x < vobject.Width + 50 And y > vobject.Height - 150 And y < vobject.Height + 50 Then
vobject.MousePointer = 8
Else
vobject.MousePointer = 0
End If
ElseIf Button = 1 And vobject.MousePointer = 8 Then
If bW + x - bX <= 0 Or bH + y - bY <= 0 Then Exit Sub
vobject.Width = bW + x - bX
vobject.Height = bH + y - bY
End If
End Sub
Public Sub picSelMoveUp(ByVal vobject As picturebox, Button As Integer, Shift As Integer, x As Single, y As Single)
isMove = False
OTOP = vobject.Top
OLEFT = vobject.Left
OHEIGHT = vobject.Height
OWIDTH = vobject.Width
End Sub

窗体程序中
Private Sub pic2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Call picSelMoveDown(pic2, Button, Shift, x, y)
End Sub
Private Sub pic2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Call picSelMoveIn(pic2, Button, Shift, x, y)
End Sub
Private Sub pic2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Call picSelMoveUp(pic2, Button, Shift, x, y)
End Sub
wangwei1980 2003-08-21
  • 打赏
  • 举报
回复
高手们都哪里去了?

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧