设计方法: 把要在窗体间拖动的控件分别放置在两个窗体上,且使它们的外观完全相同。当在窗体间拖动该控件时,则将源窗体中的控件置为不可见,将目标窗体中的控件置为可见,这样就好像控件真的被拖动了一样。代码如下窗体1 Option Explicit Dim dragx As Single Dim dragy As Single Const BEGIN_DRAG = 1Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single) '如果所拖动的控件名称为"Command1" If Source.Name = "Command1" Then '将控件移动到指针所在位置 Command1.Move (X - dragx), (Y - dragy) '控制 Command1.Visible = True form2.Command1.Visible = False End If End SubPrivate Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '记录指针在控件上的位置 dragx = X dragy = Y '开始拖动 Command1.Drag BEGIN_DRAG End Sub'在窗体加载是同时显示窗体form2 Private Sub Form_Load() form2.Show form2.Command1.Visible = False End Sub窗体2Option Explicit Dim dragx As Single Dim dragy As Single Const BEGIN_DRAG = 1Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single) '如果所拖动的控件名称为"Command1" If Source.Name = "Command1" Then '将控件移动到指针所在位置 Command1.Move (X - dragx), (Y - dragy) '控制 Command1.Visible = True form1.Command1.Visible = False End If End SubPrivate Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '记录指针在控件上的位置 dragx = X dragy = Y '开始拖动 Command1.Drag BEGIN_DRAG End Sub 欢迎光临电脑爱好者论坛 bbs.cfanclub.net
’这种拖动效果好 Private Const HTCAPTION = 2Private Const WM_NCLBUTTONDOWN = &HA1 Private Const WM_NCLBUTTONUP = &HA2Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long Dim G_Index As IntegerPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then X = ReleaseCapture() Call SendMessage(Picture1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Picture1.MousePointer = 5 End Sub
把要在窗体间拖动的控件分别放置在两个窗体上,且使它们的外观完全相同。当在窗体间拖动该控件时,则将源窗体中的控件置为不可见,将目标窗体中的控件置为可见,这样就好像控件真的被拖动了一样。代码如下窗体1 Option Explicit
Dim dragx As Single
Dim dragy As Single
Const BEGIN_DRAG = 1Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
'如果所拖动的控件名称为"Command1"
If Source.Name = "Command1" Then
'将控件移动到指针所在位置
Command1.Move (X - dragx), (Y - dragy)
'控制
Command1.Visible = True
form2.Command1.Visible = False
End If
End SubPrivate Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'记录指针在控件上的位置
dragx = X
dragy = Y
'开始拖动
Command1.Drag BEGIN_DRAG
End Sub'在窗体加载是同时显示窗体form2
Private Sub Form_Load()
form2.Show
form2.Command1.Visible = False
End Sub窗体2Option Explicit
Dim dragx As Single
Dim dragy As Single
Const BEGIN_DRAG = 1Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
'如果所拖动的控件名称为"Command1"
If Source.Name = "Command1" Then
'将控件移动到指针所在位置
Command1.Move (X - dragx), (Y - dragy)
'控制
Command1.Visible = True
form1.Command1.Visible = False
End If
End SubPrivate Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'记录指针在控件上的位置
dragx = X
dragy = Y
'开始拖动
Command1.Drag BEGIN_DRAG
End Sub
欢迎光临电脑爱好者论坛 bbs.cfanclub.net
Private Const HTCAPTION = 2Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_NCLBUTTONUP = &HA2Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Dim G_Index As IntegerPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
X = ReleaseCapture()
Call SendMessage(Picture1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.MousePointer = 5
End Sub