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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim lRgn As Long
Me.ScaleMode = 3
lRgn = CreateRectRgn(5, 30, Me.ScaleWidth - 5, Me.ScaleHeight - 5)
SetWindowRgn Me.hWnd, lRgn, True
End Sub
Declare Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" () As Long
说明
为当前的应用程序释放鼠标捕获
返回值
Long,TRUE(非零)表示成功,零表示失败
注解
我的理解:与SetCapture函数一起使用,用于判断鼠标离开(mouseleave)事件
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) 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 WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Declare Sub ReleaseCapture Lib "User32" ()
Private Sub Form_Load()
Dim rtn As Long
Me.BorderStyle = 0
rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes Picture1.hWnd, 0, 200, LWA_ALPHA '将窗口设置透明度
SetLayeredWindowAttributes hWnd, &HFF0000, 0, LWA_COLORKEY '将扣去窗口中的蓝色
End Sub
Private Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Call ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub