代码(点击image4时移动窗体,你可以换成别的控件):Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointApi) As Long Dim pos As PointApi Dim mouselsdown As Boolean Dim dx, dy As Long Private Type PointApi X As Long Y As Long End TypePrivate Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' If Y > 240 Then Exit Sub: '当鼠标的位置在此范围时移动有效,你可以改变这一数值 mouselsdown = True dx = X / 15: dy = Y / 15 End SubPrivate Sub Image4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If mouselsdown Then GetCursorPos pos Move (pos.X - dx) * Screen.TwipsPerPixelX, (pos.Y - dy) * Screen.TwipsPerPixelX End If End SubPrivate Sub Image4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) mouselsdown = False End Sub
Private 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 Any) As Long Const HTCAPTION = 2 Const WM_NCLBUTTONDOWN = &HA1 Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& End Sub Form可改为其它的控件
^_^
http://www.egooglet.com 资料、源码下载http://bbs.j2soft.cn 论坛交流
═══════════════════
Dim pos As PointApi
Dim mouselsdown As Boolean
Dim dx, dy As Long
Private Type PointApi
X As Long
Y As Long
End TypePrivate Sub Image4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If Y > 240 Then Exit Sub: '当鼠标的位置在此范围时移动有效,你可以改变这一数值
mouselsdown = True
dx = X / 15: dy = Y / 15
End SubPrivate Sub Image4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mouselsdown Then
GetCursorPos pos
Move (pos.X - dx) * Screen.TwipsPerPixelX, (pos.Y - dy) * Screen.TwipsPerPixelX
End If
End SubPrivate Sub Image4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mouselsdown = False
End Sub
Private 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 Any) As Long
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Form可改为其它的控件