Option Explicit
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
Private Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim lngReturnValue As Long
If Button = 1 Then
ReleaseCapture
lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Public Const WM_NCHITTEST = &H84
Public Const HTCLIENT = 1
Public Const HTCAPTION = 2
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public prevWndProc As Long
Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
If Msg = WM_NCHITTEST And WndProc = HTCLIENT Then
WndProc = HTCAPTION
End If
End Function
程序中:
Option Explicit
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub
Private Sub Form_Paint()
ForeColor = vbBlue
Cls
Print
Print "我虽然没有标题区,但您可以在工作区按下鼠标,"
Print "然后把我拖曳到其它地方."
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
gX = X
gY = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not Button = vbLeftButton Then Exit Sub
Dim dx As Long, dy As Long, ax As Long, ay As Long, t As Long, l As Long
dy = Y - gY
dx = X - gX
l = Left
t = Top
ax = (Screen.Width - l - Width)
ay = (Screen.Height - t - Height)
If dy > 0 And dy > ay Then dy = ay
If dy < 0 And Abs(dy) > t Then dy = -t
If dx > 0 And dx > ax Then dx = ax
If dx < 0 And Abs(dx) > l Then dx = -l
Move l + dx, t + dy
End Sub
Private Sub imgMove_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub