Thema: Userform bizarr

• Neue UserForm-Klasse bilden
• Aktuelle UserForm an die neue Klasse übergeben
• Form_Load-Ereignis der neuen Klasse aufrufen

Private UserformShape As c_UserFormShape

Private Sub UserForm_Initialize()
    Set UserformShape = New c_UserFormShape
    Set UserformShape.UserForm = Me
    UserformShape.Form_Load
End Sub

• Objektvariable zurücksetzen

Private Sub UserForm_Terminate()
    Set UserformShape = Nothing
End Sub

• Userform_Move-Ereignis in der neuen Klasse aufrufen

Private Sub UserForm_MouseDown _
           ( _
             ByVal Button As Integer, _
             ByVal Shift As Integer, _
             ByVal X As Single, _
             ByVal Y As Single _
           )
 If Button = 1 Then
    UserformShape.Userform_Move
 End If
End Sub

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