Code:
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) _
As Long
Private Declare Function GetWindowDC _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long
Private Declare Function GetDC _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long
Private Declare Function ReleaseDC _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal hdc 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
Private Declare Function DeleteObject _
Lib "gdi32" _
( _
ByVal hObject As Long _
) _
As Long
Private Declare Function ReleaseCapture _
Lib "user32" () _
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 PaintRgn _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal hRgn 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 CreateEllipticRgn _
Lib "gdi32" _
( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 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 CreateRoundRectRgn _
Lib "gdi32" _
( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long, _
ByVal X3 As Long, _
ByVal Y3 As Long _
) _
As Long
Private Declare Function OffsetClipRgn _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long _
) _
As Long
Private Declare Function OffsetRgn _
Lib "gdi32" _
( _
ByVal hRgn As Long, _
ByVal X As Long, _
ByVal Y As Long _
) _
As Long
Private Declare Function CreatePolygonRgn _
Lib "gdi32" _
( _
lpPoint As POINTAPI, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long _
) _
As Long
Private Declare Function CreatePolyPolygonRgn _
Lib "gdi32" _
( _
lpPoint As POINTAPI, _
lpPolyCounts As Long, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long _
) _
As Long
Private Const NULLREGION = 1
Private Const SIMPLEREGION = 2
Private Const COMPLEXREGION = 3
Private Const RGN_AND = 1
Private Const RGN_COPY = 5
Private Const RGN_DIFF = 4
Private Const RGN_MAX = RGN_COPY
Private Const RGN_MIN = RGN_AND
Private Const RGN_XOR = 3
Private Const RGN_OR = 2
Private Const ALTERNATE = 1
Private Const WINDING = 2
Private m_Userform As UserForm
Public Property Get UserForm() As UserForm
Set UserForm = m_Userform
End Property
Public Property Set UserForm(FormObject As UserForm)
Set m_Userform = FormObject
End Property
Public Property Get Userform_hWnd() As Long
If Not m_Userform Is Nothing Then
Userform_hWnd = FindWindow _
( _
lpClassName:=IIf( _
Val(Application.Version) > 8, _
"ThunderDFrame", _
"ThunderXFrame"), _
lpWindowName:=UserForm.Caption _
)
Else
Userform_hWnd = 0
End If
End Property
Public Property Get Userform_DC() As Long
If Not m_Userform Is Nothing Then
Userform_DC = GetDC(hwnd:=Userform_hWnd)
Else
Userform_DC = 0
End If
End Property
Public Property Get Userform_WindowDC() As Long
If Not m_Userform Is Nothing Then
Userform_WindowDC = GetWindowDC(hwnd:=Userform_hWnd)
Else
Userform_WindowDC = 0
End If
End Property
Sub Form_Load()
Dim back_geometry As Long
Dim main_geometry(0 To 4) As POINTAPI
Dim main_geometry_rgn As Long
back_geometry = CreateRectRgn(0, 0, 0, 0)
main_geometry(0).X = 30: main_geometry(0).Y = 30
main_geometry(1).X = 200: main_geometry(1).Y = 50
main_geometry(2).X = 200: main_geometry(2).Y = 200
main_geometry(3).X = 120: main_geometry(3).Y = 200
main_geometry(4).X = 40: main_geometry(4).Y = 150
main_geometry_rgn = CreatePolygonRgn(main_geometry(0), 5, WINDING)
CombineRgn back_geometry, back_geometry, main_geometry_rgn, RGN_OR
SetWindowRgn Userform_hWnd, back_geometry, True
DeleteObject back_geometry
DeleteObject main_geometry_rgn
End Sub
Public Function Userform_Move()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Call ReleaseCapture
Call SendMessage(Userform_hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Function