USF Title Bar mit neuen Events individuell gestalten

[d'r Bastler]

Moin allerseits,

hier ein Grundgerüst, mit dem man einer Userform ein individuelles Layout verpassen kann.

Zuerst demontiert man mal die alte Titelzeile, sodass die USF nur als graues Rechteck erscheint (nur schließbar über den VBE Zurücksetzen). Dazu braucht es diese APIs und die entsprechende Prozedur in einem allg. Modul:

Code: Alles auswählen

Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Public Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
    Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Public Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Public Const GWL_STYLE As Long = -16
Public Const WS_CAPTION As Long = &HC00000

Sub RemoveTitleBar(frm As Object)
    Dim lHwnd As LongPtr
    lHwnd = FindWindowA("ThunderDFrame", frm.Caption)
    
    If lHwnd <> 0 Then
        Dim lngStyle As Long
        lngStyle = GetWindowLongA(lHwnd, GWL_STYLE)
        lngStyle = lngStyle And Not WS_CAPTION
        SetWindowLongA lHwnd, GWL_STYLE, lngStyle
        DrawMenuBar lHwnd
    Else
        MsgBox "Fensterhandle nicht gefunden – überprüfe, ob der Caption-Text exakt übereinstimmt.", vbExclamation
    End If
End Sub

Als nächstes baut man sich eine Standard-Userform (Name spielt keine Rolle) mit drei Controls und Eigenschaften:

• Label lbl_Title: BackStyle 0 - fmBackStyleTransparent, Height 18, Left 0, Top 2, Width = USF-Width, Caption beliebig

• Label lbl_BackGround: BackColor beliebig, Height 20, Left 0, Top 0, Width = USF-Width, Caption beliebig

• CommandButton: cmd_Close: Height 20, Left USF-Left - 23, Picture beliebig Top 1, Width = 20

Alle anderen Eigenschaften bleiben Standard.

Als Code für die USF:

Code: Alles auswählen

Option Explicit

Private Sub UserForm_Initialize()
     RemoveTitleBar Me
     lbl_BackGround.ZOrder 1
     lbl_Title.ZOrder 0
     cmd_Close.ZOrder 0
End Sub

Private Sub cmd_Close_Click()
    Unload Me
End Sub

Was zur Laufzeit der USF gut funktioniert, nämlich die Anordnung Vor/Hinter (Z-Order: 1 dahinter, 0 davor, die Reihenfolge des Aufrufs entscheidet), ist im Desgin-Modus des VBE leider schlecht gelöst. Auch wenn sowohl das Kontextmenü beim Klick auf ein Control, als auch das Format-Menü eine Anordnung Vor/Hinter zulassen sollten, sind die Optionen bei mir ausgegraut. Dadurch kann z.B. der BackGround zu direkten Zugriff auf das andere Label und den Button versperren. Um dennoch an die Eigenschaften der einzelnen Controls zu kommen, nutzt man das Dropdown im Eigenschaften-Fenster.

Und schon kann eine USF so (langweilig) aussehen:

Modified USF.jpg

Um's hübscher zu gestalten, kann man natürlich dem BackGround z.B. ein Bild zuordnen, eine andere Schriftart (Standard ist übrigens Segoe UI, normal, 10 pt.) setzen.

Interessant ist die nun entstandene Option die Titelzeile mit Events zu nutzen. Label und Command haben davon zusammen ein gutes Dutzend im Angebot, was Möglichkeiten eröffnet, die die Titelzeile sonst nicht kann.

Viel Spaß damit! und schönes Wochenende

[knobbi38]

Hallo,

wenn man mit der Caption einer Userform herumspielt, ist FindWindowA vielleicht nicht die richtige API.
Mögliche Alternativen siehe hier: viewtopic.php?p=2368#p2368
oder die in RemoveTitleBar ermittelte hWnd in der Userform abspeichern, damit man immer wieder Zugriff darauf hat.

Gruß Knobbi38