Titelleiste Farbe ändern und Forms automatisch einfärben
07.10.2023 19:21:35
Norman
wieder mal einer, der die Farbe der Titelleiste einer Userform ändern möchte :)
Habe die zwei Threads gefunden, deren Beantwortung aber keine Lösung geboten hat:
https://www.herber.de/forum/archiv/1472to1476/1474883_Balkenfarbe_Userform_aendern.html
https://www.herber.de/forum/archiv/284to288/285138_Farbe_Titelleiste_Userform.html
Hinweis: Ich brauche keine Antwort, die sagt "Brauchst Du nicht" oder "ist zu schwer", danke :)
Hab mich mal mit Layout und Optik beschäftigt, da ist Excel ja echt Win 3.1 oldschool. Man bekommt das natürlich nicht auf "neu" gedreht, habe mir für meine Forms aber nen Automatismus geschrieben, den ich ganz nett finde und vor dem .Show aufrufe. Teile ihn hier mal als kleines Dankeschön dafür, wie man die Titelleiste einfärbt :)
Sub heißt SetStyle und erwartet ein Form. Geht dann durch alle Controls durch und setzt die Farbe. Bin noch dran, kommt vielleicht noch das ein oder andere dazu. Will noch mal nach den Buttons schauen.
Habe den Einfärbecode für die Titelleiste mal mit drin, den ich im Netz gefunden hab, geht aber nicht, fehlt wahrscheinlich noch was. Ist der Teil mit SetLayeredWindowAttributes. Windows Handle bekomme ich, aber SetLayeredWindowAttributes scheint nix zu bewirken oder ich übergebe was falsches.
Beim Start könnt ihr zwischen 3 Styles wählen,
0 - so wie immer
1 - weiß / dark cyan
2 - schwarz / weiß
Ihr könnt natürlich die globalen Parameter anpassen und mit anderen Farben rumspielen. Wie ihr seht habe ich die Variablen mit CFG benannt, bei mir können die User von außen dann die Optik in einer CFG anpassen. Wenn ich jetzt noch die Titelleiste ändern könnte, am Ende mit Alpha. Boah wäre das toll :)
Ach, eins fällt mir noch ein: Wenn Ihr ein "MultipageControl" verwendet (TabControl), dann kann die einzelne Page keinen Hintergrund. Das kann man aber lösen, indem man einen Frame auf jede einzelne Page legt, der leicht links rechts oben und unten über die Page hinaus geht. Er liegt dann sozusagen unter den Controls der Page. Falls Ihr schon eine Page habt: Einfach alle Controls auf der Page selektieren, dann ausschneiden, dann Frame auf die Page legen und über die Ränder hinaus ziehen, dann frame mit Linksklick selektieren und mit STRG + V wieder alle controls drauflegen. Da geht dann code-technisch auch nichts kaputt, der Parent der Controls ist halt jetzt nicht mehr die Page, sondern der Frame (der auf der Page liegt). Habe das selbst so gemacht, sieht ganz nice aus.
G_cfgStyle = 1 ' oder 0 oder 2 :)
Select Case G_cfgStyle
Case 1
G_cfgBCRed = &HFF
G_cfgBCGreen = &HFF
G_cfgBCBlue = &HFF
G_cfgBorderRed = &H0
G_cfgBorderGreen = &HAC
G_cfgBorderBlue = &HC1
G_cfgHeadlineRed = &H0
G_cfgHeadlineGreen = &H83
G_cfgHeadlineBlue = &H8F
G_cfgMultiPageStyle = fmTabStyleButtons
' fmSpecialEffectFlat
' fmSpecialEffectRaised
' fmSpecialEffectSunken
' fmSpecialEffectEtched
' fmSpecialEffectBump
G_cfgSpecialEffect = fmSpecialEffectFlat
Case 2
G_cfgBCRed = &H0
G_cfgBCGreen = &H0
G_cfgBCBlue = &H0
G_cfgBorderRed = &HFF
G_cfgBorderGreen = &HFF
G_cfgBorderBlue = &HFF
G_cfgHeadlineRed = &HFF
G_cfgHeadlineGreen = &HFF
G_cfgHeadlineBlue = &HFF
G_cfgFntLight = True
G_cfgMultiPageStyle = fmTabStyleButtons
G_cfgSpecialEffect = fmSpecialEffectFlat
End Select
Am besten neues Modul nehmen für die Erweiterung:
Option Explicit
Private Declare PtrSafe Function SetWindowLongPtr _
Lib "user32" Alias "SetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr _
Lib "user32" Alias "GetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetLayeredWindowAttributes _
Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_EX_LAYERED As Long = &H80000
Private Const LWA_COLORKEY As Long = &H1
Private Const LWA_ALPHA As Long = &H2
Public G_cfgStyle As Long
Public G_cfgBCRed As Integer
Public G_cfgBCGreen As Integer
Public G_cfgBCBlue As Integer
Public G_cfgBorderRed As Integer
Public G_cfgBorderGreen As Integer
Public G_cfgBorderBlue As Integer
Public G_cfgHeadlineRed As Integer
Public G_cfgHeadlineGreen As Integer
Public G_cfgHeadlineBlue As Integer
Public G_cfgMultiPageStyle As Long
Public G_cfgFntLight As Boolean
Public G_cfgSpecialEffect As Long
Public Sub SetStyle(frm As UserForm)
If G_cfgStyle = 0 Then Exit Sub
Dim frmControl As Object
If G_cfgStyle 100 Then
On Error Resume Next
Dim hwnd As LongPtr
hwnd = FindWindow("ThunderDFrame", frm.Caption)
' Fensterstil setzen, um Layered Window-Attribute zu verwenden
SetWindowLongPtr hwnd, GWL_EXSTYLE, GetWindowLongPtr(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
' Stellen Sie das Layered Window-Attribut dieses Fensters ein.
' Hier 255 ist die Opazität des Fensters: 0 ist vollständig transparent, 255 ist undurchsichtig.
' Das Ändern dieser Zahl wird die Transparenz des gesamten Fensters beeinflussen.
' SetLayeredWindowAttributes hwnd, 0, 127, LWA_ALPHA
SetLayeredWindowAttributes hwnd, RGB(255, 0, 255), 127, LWA_COLORKEY Or LWA_ALPHA
frm.BackColor = RGB(G_cfgBCRed, G_cfgBCGreen, G_cfgBCBlue)
frm.controlbox = False
For Each frmControl In frm.Controls
' Hintergrundfarbe
If frmControl.BackColor > &H10FFFF And InStr(frmControl.Tag, "NOBACKCOL") = 0 Then
frmControl.BackColor = RGB(G_cfgBCRed, G_cfgBCGreen, G_cfgBCBlue)
If G_cfgBCRed 50 And G_cfgBCGreen 50 And G_cfgBCBlue 50 And G_cfgFntLight = True And TypeName(frmControl) > "MultiPage" Then
frmControl.ForeColor = RGB(255 - G_cfgBCRed, 255 - G_cfgBCGreen, 255 - G_cfgBCBlue)
End If
End If
' Rahmen
If frmControl.SpecialEffect > fmSpecialEffectFlat Then
' Rahmentyp setzen
frmControl.SpecialEffect = G_cfgSpecialEffect ' fmSpecialEffectBump
If G_cfgSpecialEffect = fmSpecialEffectFlat Then
' Rhamenfarbe nur setzen, wenn Flat
frmControl.BorderColor = RGB(G_cfgBorderRed, G_cfgBorderGreen, G_cfgBorderBlue)
frmControl.BorderStyle = fmBorderStyleSingle
End If
End If
' wenn Fett, dann Headlinefarbe setzen
If frmControl.Font.Bold Then
frmControl.ForeColor = RGB(G_cfgHeadlineRed, G_cfgHeadlineGreen, G_cfgHeadlineBlue)
End If
Select Case TypeName(frmControl)
Case "MultiPage"
frmControl.Style = G_cfgMultiPageStyle
Case "ListBox", "ComboBox", "TextBox", "Frame", "CommandButton"
' fmSpecialEffectFlat
' fmSpecialEffectRaised
' fmSpecialEffectSunken
' fmSpecialEffectEtched
' fmSpecialEffectBump
frmControl.SpecialEffect = G_cfgSpecialEffect ' fmSpecialEffectBump
End Select
Next frmControl
End If
End Sub
