'窗体部分

Option Explicit

Private Sub Form_Resize() '单步调试这个过程

Me.Show
On Error Resume Next

Label2.Top = 5
Label2.Left = 15

'***********************************************************************

leftup.Top = 0
leftup.Left = 0

uppe.Top = 0
uppe.Left = 15
uppe.Width = Me.ScaleWidth - 30

rightup.Left = Me.ScaleWidth - 15
rightup.Top = 0

right.Left = Me.ScaleWidth - 15 '包装边框
right.Top = 15
right.Height = Me.ScaleHeight - 30

rightdown.Left = Me.ScaleWidth - 15
rightdown.Top = Me.ScaleHeight - 15

down.Top = Me.ScaleHeight - 15
down.Left = 15
down.Width = Me.ScaleWidth - 30

leftdown.Left = 0
leftdown.Top = Me.ScaleHeight - 15

leftpic.Left = 0
leftpic.Top = 15
leftpic.Height = Me.ScaleHeight - 30

'***********************************************************************

ShapeTheForm Me '设置形状

End Sub

'***********************************************************************

' 窗体和控件移动

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

DrapWindow

End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

DrapWindow

End Sub

Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

DrapWindow

End Sub

Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

DrapWindow

End Sub

'***********************************************************************

Private Sub Form_KeyPress(KeyAscii As Integer) '按下ESC键退出

If KeyAscii = vbKeyEscape Then Unload Me

End Sub

'***********************************************************************

'上下左右8个方向调整窗体大小

Private Sub uppe_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture '上边
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTTOP, 0

End Sub

Private Sub down_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture '下边
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOM, 0

End Sub

Private Sub leftpic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTLEFT, 0 '左边

End Sub

Private Sub right_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTRIGHT, 0& '右边

End Sub

Private Sub leftup_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTTOPLEFT, 0 '左上角

End Sub

Private Sub leftdown_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOMLEFT, 0 '左下角

End Sub

Private Sub rightup_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTTOPRIGHT, 0 '右上角

End Sub

Private Sub rightdown_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0 '右下角

End Sub

'***********************************************************************

--------------------------------------------------------------------------------
'模块

Option Explicit

'*************************************************************************
'**模 块 名： Module1
'**说 明： Mr.David 版权所有2006 - 2007(C)
'**创 建 人： Mr.David
'**日 期： 2006-09-04 15:26:12
'**修 改 人：
'**日 期：
'**描 述： 拖动无标题窗体
'**版 本： V1.0.0
'*************************************************************************

'释放当前线程鼠标的控制权，从而恢复正常的鼠标输入处理过程 。
'那么不管鼠标指针在哪里，都会获得所有的鼠标信息，除非单击一次。

Declare Function ReleaseCapture Lib "user32" () As Long

'调用一个窗口的窗口函数，将一条消息发给那个窗口。除非消息处理完毕，否则该函数不会返回。
Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'窗体处理API

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'相关常数

Public Const HTCAPTION = 2 '代表窗体的标题区
Public Const WM_NCLBUTTONDOWN = &HA1 '表示非工作区左键按下

Public Const HTLEFT = 10 '分别是从左、右、上、左上、右上、下、左下、右下8个方向改变窗体大小的常数
Public Const HTRIGHT = 11
Public Const HTTOP = 12
Public Const HTTOPLEFT = 13
Public Const HTTOPRIGHT = 14
Public Const HTBOTTOM = 15
Public Const HTBOTTOMLEFT = 16
Public Const HTBOTTOMRIGHT = 17

Public Const RGN_DIFF = 4 ' hDestRgn被设置为hSrcRgn1中与hSrcRgn2不相交的部分

Public Sub ShapeTheForm(TheForm As Form) '对窗体的控制

Dim thematrix As Long
Dim notthematrix As Long
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, g As Long, m As Long

With TheForm '坐标理解可以用鼠标位置和坐标设置.exe配合分析,为了方便，我将窗体启动位置设置为窗体左上角

If .Width < 4200 Then .Width = 4200: Exit Sub '限制窗体的大小
If .Height < 3000 Then .Height = 3000: Exit Sub

thematrix = CreateRectRgn(0, 0, .ScaleWidth, .ScaleHeight) '整个窗体
notthematrix = CreateRectRgn(0, 0, .ScaleWidth, .ScaleHeight)

a = CreateRectRgn(10, 0, .ScaleWidth - 10, .ScaleHeight) '窗体左上角
b = CreateRectRgn(0, 10, .ScaleWidth, .ScaleHeight - 10) '窗体右下角

c = CreateEllipticRgn(0, 0, 20, 20) '窗体左上角
d = CreateEllipticRgn(0, .ScaleHeight, 20, .ScaleHeight - 20) '窗体左下角

e = CreateEllipticRgn(.ScaleWidth, 0, .ScaleWidth - 20, 20) '窗体右上角
f = CreateEllipticRgn(.ScaleWidth, .ScaleHeight, .ScaleWidth - 20, .ScaleHeight - 20) '窗体右下角

g = CombineRgn(thematrix, thematrix, a, RGN_DIFF) '清除窗体角上多余的部分
g = CombineRgn(thematrix, thematrix, b, RGN_DIFF)
g = CombineRgn(thematrix, thematrix, c, RGN_DIFF)
g = CombineRgn(thematrix, thematrix, d, RGN_DIFF)
g = CombineRgn(thematrix, thematrix, e, RGN_DIFF)
g = CombineRgn(thematrix, thematrix, f, RGN_DIFF)
g = CombineRgn(thematrix, notthematrix, thematrix, RGN_DIFF)

m = SetWindowRgn(.hwnd, thematrix, True)

DeleteObject thematrix
DeleteObject notthematrix
DeleteObject a
DeleteObject b
DeleteObject c '释放资源
DeleteObject d
DeleteObject e
DeleteObject f
DeleteObject g
DeleteObject m

End With

End Sub

Public Sub DrapWindow() '拖动无标题的窗体

ReleaseCapture
SendMessage Form1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&

End Sub

参考文献 Win32api.txt

The return value of the DefWindowProc function is one of the following values, indicating the position of the cursor hot spot.

Value Location of hot spot
HTBORDER In the border of a window that does not have a sizing border.
HTBOTTOM In the lower-horizontal border of a resizable window (the user can click the mouse to resize the window vertically).
HTBOTTOMLEFT In the lower-left corner of a border of a resizable window (the user can click the mouse to resize the window diagonally).
HTBOTTOMRIGHT In the lower-right corner of a border of a resizable window (the user can click the mouse to resize the window diagonally).
HTCAPTION In a title bar.
HTCLIENT In a client area.
HTCLOSE In a Close button.
HTERROR On the screen background or on a dividing line between windows (same as HTNOWHERE, except that the DefWindowProc function produces a system beep to indicate an error).
HTGROWBOX In a size box (same as HTSIZE).
HTHELP In a Help button.
HTHSCROLL In a horizontal scroll bar.
HTLEFT In the left border of a resizable window (the user can click the mouse to resize the window horizontally).
HTMENU In a menu.
HTMAXBUTTON In a Maximize button.
HTMINBUTTON In a Minimize button.
HTNOWHERE On the screen background or on a dividing line between windows.
HTREDUCE In a Minimize button.
HTRIGHT In the right border of a resizable window (the user can click the mouse to resize the window horizontally).
HTSIZE In a size box (same as HTGROWBOX).
HTSYSMENU In a window menu or in a Close button in a child window.
HTTOP In the upper-horizontal border of a window.
HTTOPLEFT In the upper-left corner of a window border.
HTTOPRIGHT In the upper-right corner of a window border.
HTTRANSPARENT In a window currently covered by another window in the same thread (the message will be sent to underlying windows in the same thread until one of them returns a code that is not HTTRANSPARENT).
HTVSCROLL In the vertical scroll bar.
HTZOOM In a Maximize button.