09.10.2024, 16:02
Liebe Leserin, lieber Leser,
das Formatieren der Titelleiste einer Userform ist eigentlich nicht vorgesehen. Möchte man diese formatieren, blenden viele Programmierer die Titelleiste aus und formatieren die Userform an sich entsprechend.
Es entsteht sozusagen eine "Fake"-Titelleiste.
Dass es aber trotzdem geht, die Titelleiste zu formatieren, möchte ich mit nachfolgendem Code einmal aufzeigen.
Der nachfolgende Code bzw. der Code in der Beispieldatei erstellt formatiert die Titelleiste einer Userform.
Hierzu müssen wir uns in die Messageschleife der Userform einhooken und die Message WM_NCPAINT entsprechend bearbeiten, denn das Bemalen der Captionbar ist in Windows standardmäßig nicht vorgesehen.
Zum Malen in der Captionbar wird diese und der Rahmen drum herum erst mal von Windows gelöscht. Leider werden auch der Schatten und das Systemkreuz gelöscht und nicht wieder hergestellt.
Der Aufwand das Systemkreuz und den Schatten wieder herzustellen, ist mir zu groß. Das Systemkreuz wurde daher abgeschaltet und als Schatten eine kleine Sonderlösung eingebaut.
Wen's also nicht stört, der kann dann gerne so eine formatierte Userform bauen. Restliche Erklärungen wie immer im Code....
Und nun viel Spaß und Erfolg beim Ausprobieren....
Userform_Titelleiste_Formatieren.xlsb (Größe: 46,78 KB / Downloads: 0)
das Formatieren der Titelleiste einer Userform ist eigentlich nicht vorgesehen. Möchte man diese formatieren, blenden viele Programmierer die Titelleiste aus und formatieren die Userform an sich entsprechend.
Es entsteht sozusagen eine "Fake"-Titelleiste.
Dass es aber trotzdem geht, die Titelleiste zu formatieren, möchte ich mit nachfolgendem Code einmal aufzeigen.
Der nachfolgende Code bzw. der Code in der Beispieldatei erstellt formatiert die Titelleiste einer Userform.
Hierzu müssen wir uns in die Messageschleife der Userform einhooken und die Message WM_NCPAINT entsprechend bearbeiten, denn das Bemalen der Captionbar ist in Windows standardmäßig nicht vorgesehen.
Zum Malen in der Captionbar wird diese und der Rahmen drum herum erst mal von Windows gelöscht. Leider werden auch der Schatten und das Systemkreuz gelöscht und nicht wieder hergestellt.
Der Aufwand das Systemkreuz und den Schatten wieder herzustellen, ist mir zu groß. Das Systemkreuz wurde daher abgeschaltet und als Schatten eine kleine Sonderlösung eingebaut.
Wen's also nicht stört, der kann dann gerne so eine formatierte Userform bauen. Restliche Erklärungen wie immer im Code....
Und nun viel Spaß und Erfolg beim Ausprobieren....
Userform_Titelleiste_Formatieren.xlsb (Größe: 46,78 KB / Downloads: 0)
Code:
Private Const iPenB As Long = 2 ' Schattenbreite 1 bis 5
' Window-Funktionen
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetClientRect Lib "user32" ( _
ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
ByVal hwnd As LongPtr, lpRect As RECT) As Long
' Hooking-Funktionen
Private Declare PtrSafe Function CallWindowProcA Lib "user32" ( _
ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#If Win64 Then
Private Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLongA Lib "user32" Alias "GetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, _
ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, _
ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
Private Const GWL_WNDPROC As Long = -4
' GDI-Funktionen
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
'Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function CreatePen Lib "gdi32" ( _
ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As LongPtr
Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" ( _
ByVal crColor As Long) As LongPtr
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function CreateFontA Lib "gdi32.dll" ( _
ByVal nHeight As Long, ByVal nWidth As Long, _
ByVal nEscapement As Long, ByVal nOrientation As Long, _
ByVal fnWeight As Long, ByVal fdwItalic As Long, _
ByVal fdwUnderline As Long, ByVal fdwStrikeOut As Long, _
ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, _
ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, _
ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As LongPtr
Private Declare PtrSafe Function SetTextColor Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal crColor As Long) As Long
Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal nBkMode As Long) As Long
Private Declare PtrSafe Function DrawTextA Lib "user32" (ByVal hDC As LongPtr, _
ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function MoveToEx Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function LineTo Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal x As Long, ByVal y As Long) As Long
Type POINTAPI
x As Long
y As Long
End Type
Private Declare PtrSafe Function OleTranslateColor Lib "oleaut32.dll" ( _
ByVal clr As OLE_COLOR, ByVal palet As LongPtr, col As Long) As Long
Private Declare PtrSafe Function ColorAdjustLuma Lib "shlwapi.dll" ( _
ByVal clrRGB As Long, ByVal n As Long, ByVal fScale As Long) As Long
Private Declare PtrSafe Function SetRect Lib "user32" (lpRect As RECT, _
ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare PtrSafe Function FrameRect Lib "user32" (ByVal hDC As LongPtr, _
lpRect As RECT, ByVal hBrush As LongPtr) As Long
Private Declare PtrSafe Function FillRect Lib "user32" (ByVal hDC As LongPtr, _
lpRect As RECT, ByVal hBrush As LongPtr) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type Userform_Titlebar_STRUCT
Caption As String
BackFarbe As Long
Textfarbe As Long
TextPosition As Long ' 0=links, 1=Zentriert
Schriftgroesse As Long
Schriftart As String
Fett As Boolean
kursiv As Boolean
Rand As Long ' 0=keiner, 1=weiß, 5=schwarz usw.
Rahmenfarbe As Long
End Type
Global mtUF As Userform_Titlebar_STRUCT
Dim mhDlgProc As LongPtr, mhFont As LongPtr
Dim mhPen(2) As LongPtr, mhBrush(2) As LongPtr
Dim PT As POINTAPI
Sub FormatUserform()
Dim hWndUF As LongPtr, iFarbe As Long
Const GWL_STYLE As Long = -16
mhPen(1) = 0: mhPen(2) = 0: mhFont = 0
With mtUF
hWndUF = FindWindowA("ThunderDFrame", .Caption)
SetWindowLongA hWndUF, GWL_STYLE, _
GetWindowLongA(hWndUF, GWL_STYLE) And Not &H80000 ' &H80000 = WS_SYSMENU abschalten
mhBrush(1) = CreateSolidBrush(.BackFarbe) ' Pinsel Caption HG-Farbe erstellen
iFarbe = IIf(.Rahmenfarbe <> 0, .Rahmenfarbe, .BackFarbe)
mhBrush(2) = CreateSolidBrush(iFarbe) ' Pinsel Rahmen HG-Farbe erstellen
If .Schriftgroesse > 0 And .Schriftart <> "" Then ' Neue Schriftart erstellen
mhFont = CreateFontA(.Schriftgroesse, 0, 0, 0, _
IIf(.Fett, 700, 400), IIf(.kursiv, 1, 0), _
0, 0, 0, 0, 0, 0, 0, .Schriftart)
End If
' Pens für die Schattenbildung erstellen
If .Rand > 0 Then
mhPen(1) = CreatePen(0, 2, vbWhite) ' Weißen Pen erstellen (2 Pixel)
iFarbe = ColorAdjustLuma(iFarbe, -300, True) ' Farbe für Schatten abdunkeln
mhPen(2) = CreatePen(0, iPenB, iFarbe) ' Farbigen Pen erstellen (2 Pixel)
End If
End With
' Userform hooken, alle Meldungen für die Userform werden umgeleitet
mhDlgProc = SetWindowLongA(hWndUF, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Function WindowProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
' CallbackProzedur für Meldungen der Userform
Dim hDC As LongPtr
Dim B As Long, H As Long, i As Long
Dim R As RECT, RC As RECT
Select Case uMsg
Case &H85, &H6 ' WM_NCPAINT, WM_ACTIVATE
' Titelleiste und Rahmen beabeiten
GetClientRect hwnd, RC ' Userform-Fläche holen
hDC = GetWindowDC(hwnd) ' Userform-Fläche incl. Caption/Rahmen
B = RC.Right: H = RC.Bottom + 48
SetRect R, 0, 0, 9, H: FillRect hDC, R, mhBrush(2) ' linker Rahmen
SetRect R, B + 9, 0, B + 18, H: FillRect hDC, R, mhBrush(2) ' rechter Rahmen
SetRect R, 0, H - 10, B + 18, H: FillRect hDC, R, mhBrush(2) ' unterer Rahmen
SetRect R, 9, 0, B + 9, 9: FillRect hDC, R, mhBrush(2) ' oberer Rahmen
SetRect R, 9, 9, B + 9, 38: FillRect hDC, R, mhBrush(1) ' Captionbereich setzen
' SetRect R, 9, 0, B + 9, 38: FillRect hDC, R, mhBrush(1) ' Captionbereich setzen
SetBkMode hDC, 1 ' 1 = Transparent ' Hintergrundmodus transparent setzen
If mhFont <> 0 Then SelectObject hDC, mhFont ' Font aktivieren
SetTextColor hDC, mtUF.Textfarbe ' Schriftfarbe setzen
DrawTextA hDC, mtUF.Caption & vbNullChar, (-1), R, _
IIf(mtUF.TextPosition > 0, &H25, &H24) ' Jetzt Text erneut ausgeben
If mhPen(1) <> 0 And mhPen(2) <> 0 Then ' Rand bearbeiten>0
SelectObject hDC, mhPen(1) ' Weißen Pen aktivieren
MoveToEx hDC, 1, H - 1, PT: LineTo hDC, 1, 1: LineTo hDC, B + 18, 1
SelectObject hDC, mhPen(2) ' Farbigen Pen aktivieren
MoveToEx hDC, B + 18 - iPenB, 2, PT: LineTo hDC, B + 18 - iPenB, H - iPenB - 1
LineTo hDC, 2, H - iPenB - 1
Else
SetRect R, 1, 1, RC.Right + 18, RC.Bottom + 47 ' Rahmenbereich setzen
FrameRect hDC, R, GetStockObject(5) ' Userform-Umrandung zeichnen
End If
ReleaseDC hwnd, hDC ' Device Context (DC) auflösen
Exit Function
Case &H2 ' WM_DESTROY ' Userform beeenden
' Aufräumen
For i = 1 To 2
If mhPen(i) <> 0 Then DeleteObject mhPen(i) ' Pens wieder löschen
If mhBrush(i) <> 0 Then DeleteObject mhBrush(i) ' Pinsel wieder löschen
Next i
If mhFont <> 0 Then DeleteObject mhFont ' Font wieder löschen
Call SetWindowLongA(hwnd, GWL_WNDPROC, mhDlgProc) ' Userform unhooken
Exit Function
End Select
' Andere Messages an Urspungsprozedur weiterleiten
WindowProc = CallWindowProcA(mhDlgProc, hwnd, uMsg, ByVal wParam, ByVal lParam)
End Function
' Window-Funktionen
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetClientRect Lib "user32" ( _
ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
ByVal hwnd As LongPtr, lpRect As RECT) As Long
' Hooking-Funktionen
Private Declare PtrSafe Function CallWindowProcA Lib "user32" ( _
ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#If Win64 Then
Private Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLongA Lib "user32" Alias "GetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, _
ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, _
ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
Private Const GWL_WNDPROC As Long = -4
' GDI-Funktionen
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
'Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function CreatePen Lib "gdi32" ( _
ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As LongPtr
Private Declare PtrSafe Function CreateSolidBrush Lib "gdi32" ( _
ByVal crColor As Long) As LongPtr
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function CreateFontA Lib "gdi32.dll" ( _
ByVal nHeight As Long, ByVal nWidth As Long, _
ByVal nEscapement As Long, ByVal nOrientation As Long, _
ByVal fnWeight As Long, ByVal fdwItalic As Long, _
ByVal fdwUnderline As Long, ByVal fdwStrikeOut As Long, _
ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, _
ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, _
ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As LongPtr
Private Declare PtrSafe Function SetTextColor Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal crColor As Long) As Long
Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal nBkMode As Long) As Long
Private Declare PtrSafe Function DrawTextA Lib "user32" (ByVal hDC As LongPtr, _
ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function MoveToEx Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function LineTo Lib "gdi32" (ByVal hDC As LongPtr, _
ByVal x As Long, ByVal y As Long) As Long
Type POINTAPI
x As Long
y As Long
End Type
Private Declare PtrSafe Function OleTranslateColor Lib "oleaut32.dll" ( _
ByVal clr As OLE_COLOR, ByVal palet As LongPtr, col As Long) As Long
Private Declare PtrSafe Function ColorAdjustLuma Lib "shlwapi.dll" ( _
ByVal clrRGB As Long, ByVal n As Long, ByVal fScale As Long) As Long
Private Declare PtrSafe Function SetRect Lib "user32" (lpRect As RECT, _
ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare PtrSafe Function FrameRect Lib "user32" (ByVal hDC As LongPtr, _
lpRect As RECT, ByVal hBrush As LongPtr) As Long
Private Declare PtrSafe Function FillRect Lib "user32" (ByVal hDC As LongPtr, _
lpRect As RECT, ByVal hBrush As LongPtr) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type Userform_Titlebar_STRUCT
Caption As String
BackFarbe As Long
Textfarbe As Long
TextPosition As Long ' 0=links, 1=Zentriert
Schriftgroesse As Long
Schriftart As String
Fett As Boolean
kursiv As Boolean
Rand As Long ' 0=keiner, 1=weiß, 5=schwarz usw.
Rahmenfarbe As Long
End Type
Global mtUF As Userform_Titlebar_STRUCT
Dim mhDlgProc As LongPtr, mhFont As LongPtr
Dim mhPen(2) As LongPtr, mhBrush(2) As LongPtr
Dim PT As POINTAPI
Sub FormatUserform()
Dim hWndUF As LongPtr, iFarbe As Long
Const GWL_STYLE As Long = -16
mhPen(1) = 0: mhPen(2) = 0: mhFont = 0
With mtUF
hWndUF = FindWindowA("ThunderDFrame", .Caption)
SetWindowLongA hWndUF, GWL_STYLE, _
GetWindowLongA(hWndUF, GWL_STYLE) And Not &H80000 ' &H80000 = WS_SYSMENU abschalten
mhBrush(1) = CreateSolidBrush(.BackFarbe) ' Pinsel Caption HG-Farbe erstellen
iFarbe = IIf(.Rahmenfarbe <> 0, .Rahmenfarbe, .BackFarbe)
mhBrush(2) = CreateSolidBrush(iFarbe) ' Pinsel Rahmen HG-Farbe erstellen
If .Schriftgroesse > 0 And .Schriftart <> "" Then ' Neue Schriftart erstellen
mhFont = CreateFontA(.Schriftgroesse, 0, 0, 0, _
IIf(.Fett, 700, 400), IIf(.kursiv, 1, 0), _
0, 0, 0, 0, 0, 0, 0, .Schriftart)
End If
' Pens für die Schattenbildung erstellen
If .Rand > 0 Then
mhPen(1) = CreatePen(0, 2, vbWhite) ' Weißen Pen erstellen (2 Pixel)
iFarbe = ColorAdjustLuma(iFarbe, -300, True) ' Farbe für Schatten abdunkeln
mhPen(2) = CreatePen(0, iPenB, iFarbe) ' Farbigen Pen erstellen (2 Pixel)
End If
End With
' Userform hooken, alle Meldungen für die Userform werden umgeleitet
mhDlgProc = SetWindowLongA(hWndUF, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Function WindowProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
' CallbackProzedur für Meldungen der Userform
Dim hDC As LongPtr
Dim B As Long, H As Long, i As Long
Dim R As RECT, RC As RECT
Select Case uMsg
Case &H85, &H6 ' WM_NCPAINT, WM_ACTIVATE
' Titelleiste und Rahmen beabeiten
GetClientRect hwnd, RC ' Userform-Fläche holen
hDC = GetWindowDC(hwnd) ' Userform-Fläche incl. Caption/Rahmen
B = RC.Right: H = RC.Bottom + 48
SetRect R, 0, 0, 9, H: FillRect hDC, R, mhBrush(2) ' linker Rahmen
SetRect R, B + 9, 0, B + 18, H: FillRect hDC, R, mhBrush(2) ' rechter Rahmen
SetRect R, 0, H - 10, B + 18, H: FillRect hDC, R, mhBrush(2) ' unterer Rahmen
SetRect R, 9, 0, B + 9, 9: FillRect hDC, R, mhBrush(2) ' oberer Rahmen
SetRect R, 9, 9, B + 9, 38: FillRect hDC, R, mhBrush(1) ' Captionbereich setzen
' SetRect R, 9, 0, B + 9, 38: FillRect hDC, R, mhBrush(1) ' Captionbereich setzen
SetBkMode hDC, 1 ' 1 = Transparent ' Hintergrundmodus transparent setzen
If mhFont <> 0 Then SelectObject hDC, mhFont ' Font aktivieren
SetTextColor hDC, mtUF.Textfarbe ' Schriftfarbe setzen
DrawTextA hDC, mtUF.Caption & vbNullChar, (-1), R, _
IIf(mtUF.TextPosition > 0, &H25, &H24) ' Jetzt Text erneut ausgeben
If mhPen(1) <> 0 And mhPen(2) <> 0 Then ' Rand bearbeiten>0
SelectObject hDC, mhPen(1) ' Weißen Pen aktivieren
MoveToEx hDC, 1, H - 1, PT: LineTo hDC, 1, 1: LineTo hDC, B + 18, 1
SelectObject hDC, mhPen(2) ' Farbigen Pen aktivieren
MoveToEx hDC, B + 18 - iPenB, 2, PT: LineTo hDC, B + 18 - iPenB, H - iPenB - 1
LineTo hDC, 2, H - iPenB - 1
Else
SetRect R, 1, 1, RC.Right + 18, RC.Bottom + 47 ' Rahmenbereich setzen
FrameRect hDC, R, GetStockObject(5) ' Userform-Umrandung zeichnen
End If
ReleaseDC hwnd, hDC ' Device Context (DC) auflösen
Exit Function
Case &H2 ' WM_DESTROY ' Userform beeenden
' Aufräumen
For i = 1 To 2
If mhPen(i) <> 0 Then DeleteObject mhPen(i) ' Pens wieder löschen
If mhBrush(i) <> 0 Then DeleteObject mhBrush(i) ' Pinsel wieder löschen
Next i
If mhFont <> 0 Then DeleteObject mhFont ' Font wieder löschen
Call SetWindowLongA(hwnd, GWL_WNDPROC, mhDlgProc) ' Userform unhooken
Exit Function
End Select
' Andere Messages an Urspungsprozedur weiterleiten
WindowProc = CallWindowProcA(mhDlgProc, hwnd, uMsg, ByVal wParam, ByVal lParam)
End Function
_________
viele Grüße
Karl-Heinz
viele Grüße
Karl-Heinz