Private Declare Sub ReleaseCapture Lib "user32" ()
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 Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
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 CreateRectRgn 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 Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_CAPTION As Long = &HC00000
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Sub CommandButton1_Click()
Unload Me
ThisWorkbook.Close False
End Sub
Private Sub UserForm_Initialize()
Dim hwnd, hwnd1, hwnd2, wdc, colorl As Long
Dim I As Integer
If Val(Application.Version) < 9 Then
hwnd = FindWindow("ThunderXFrame", Me.Caption)
Else
hwnd = FindWindow("ThunderDFrame", Me.Caption)
End If
IStyle = GetWindowLong(hwnd, GWL_STYLE)
IStyle = IStyle And Not WS_CAPTION
SetWindowLong hwnd, GWL_STYLE, IStyle
DrawMenuBar hwnd
With Worksheets(1)
hwnd1 = CreateRectRgn(.Cells(1, 2).Value, .Cells(1, 1).Value, .Cells(1, 3).Value, .Cells(1, 1) + 1)
I = 2
Do While .Cells(I, 1).Value <> ""
hwnd2 = CreateRectRgn(.Cells(I, 2).Value, .Cells(I, 1).Value, .Cells(I, 3).Value, .Cells(I, 1) + 1)
CombineRgn hwnd1, hwnd1, hwnd2, 2
I = I + 1
Loop
End With
SetWindowRgn hwnd, hwnd1, True
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Dim hwnd As Long
If Val(Application.Version) < 9 Then
hwnd = FindWindow("ThunderXFrame", Me.Caption)
Else
hwnd = FindWindow("ThunderDFrame", Me.Caption)
End If
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
