Which APIs do you use to draw them? DrawThemeBackground?
Printable View
Here is an excerpt of my code I have uploaded above (mDarkMode.bas)
Code:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function OpenThemeData Lib "uxtheme.dll" (ByVal hwnd As Long, ByVal pszClassList As Long) As Long
Private Declare Function CloseThemeData Lib "uxtheme.dll" (ByVal hTheme As Long) As Long
Private Declare Function DrawThemeBackground Lib "uxtheme.dll" (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, pRect As RECT, ByVal pClipRect As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Const BP_RADIOBUTTON = 2
Private Const RBS_UNCHECKEDNORMAL = 1
Private Const RBS_UNCHECKEDHOT = 2
Private Const RBS_UNCHECKEDPRESSED = 3
Private Const RBS_UNCHECKEDDISABLED = 4
Private Const RBS_CHECKEDNORMAL = 5
Private Const RBS_CHECKEDHOT = 6
Private Const RBS_CHECKEDPRESSED = 7
Private Const RBS_CHECKEDDISABLED = 8
Private Const TRANSPARENT = 1
Private Const BP_CHECKBOX = 3
Private Const CBS_UNCHECKEDNORMAL = 1
Private Const CBS_UNCHECKEDHOT = 2
Private Const CBS_UNCHECKEDPRESSED = 3
Private Const CBS_UNCHECKEDDISABLED = 4
Private Const CBS_CHECKEDNORMAL = 5
Private Const CBS_CHECKEDHOT = 6
Private Const CBS_CHECKEDPRESSED = 7
Private Const CBS_CHECKEDDISABLED = 8
Public Sub CBOwnerDraw(frm As Form, obj As Object, ByVal hDC As Long)
'
' Draw a CheckBoxW
' obj.DrawMode must be = 1 = ChkDrawModeOwnerDraw
'
' In your form, add something like this for each of your CheckBoxW:
'
'Private Sub CheckBoxW1_OwnerDraw(ByVal Action As Long, ByVal State As Long, ByVal hDC As Long, ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long)
' CBOwnerDraw Me, CheckBoxW1, hDC
'End Sub
'
Dim hTheme As Long
Dim rc As RECT
Dim ST As Long
hTheme = OpenThemeData(frm.hwnd, StrPtr("BUTTON"))
rc.Left = 2
rc.Top = 2
rc.Right = 18
rc.Bottom = 18
If obj.Value = 1 Then
ST = CBS_CHECKEDNORMAL
Else
ST = CBS_UNCHECKEDNORMAL
End If
DrawThemeBackground hTheme, hDC, BP_CHECKBOX, ST, rc, 0
CloseThemeData hTheme
SetBkMode hDC, TRANSPARENT
SetTextColor hDC, FRMFORECOLOR
TextOut hDC, 24, 2, obj.Caption, Len(obj.Caption)
End Sub
Public Sub OBWOwnerDraw(frm As Form, obj As Object, ByVal hDC As Long)
'
' Draw an OptionButtonW
' obj.DrawMode must be = 1 = OptDrawModeOwnerDraw
'
' In your form, add something like this for each of your OptionButtonW:
'
'Private Sub OptionButtonW1_OwnerDraw(ByVal Action As Long, ByVal State As Long, ByVal hDC As Long, ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long)
' OBWOwnerDraw Me, OptionButtonW1, hDC
'End Sub
'
Dim hTheme As Long
Dim rc As RECT
Dim part As Long
Dim ST As Long
hTheme = OpenThemeData(frm.hwnd, StrPtr("BUTTON"))
rc.Left = 2
rc.Top = 2
rc.Right = 18
rc.Bottom = 18
part = BP_RADIOBUTTON
If obj.Value = True Then
ST = RBS_CHECKEDNORMAL
Else
ST = RBS_UNCHECKEDNORMAL
End If
DrawThemeBackground hTheme, hDC, part, ST, rc, 0
CloseThemeData hTheme
SetBkMode hDC, TRANSPARENT
SetTextColor hDC, FRMFORECOLOR
TextOut hDC, 24, 2, obj.Caption, Len(obj.Caption)
End Sub
Another thing to think about would be a "ForceForeColor" property for CheckBoxW etc. to make a temporary API hook on DrawThemeText and redirect to DrawThemeTextEx to apply the text color. Either during WM_PAINT or on CDDS_PREPAINT until CDDS_POSTPAINT.
If needed there's a complete header port of those theme element consts already converted to VBx compatible syntax in WinDevLib; grouped into enums. If you don't want to even open it in tB it's browsable online, https://github.com/fafalone/WinDevLi...tl.twin#L11056
Same file has all the dwm/uxtheme APIs including a number of undocumented dark mode APIs. Large majority can be copy/pasted to vb6 as-is but you need sometimes e.g. change "DeclareWide" back to "Declare" and As String back to As Long[Ptr].
I guess i found your problem: after OpenThemeData you need to call the API GetThemePartSize to get the DarkMode-image.
btw: your code also doesnt take care of the following control-properties:
- TextAlignment
- left, top, right, bottom
- state (focus, disabled, enabled, show prefix, ...)
- WordWrap
I don't get it. I have changed my code to use GetThemePartSize to get the real size of the image but how can I use it to get the DarkMode-image ?
For the other properties, I haven't worked on them yet as I don't need them for the moment.
This is the best I can get for the moment :Code:Private Type SIZE
cx As Long
cy As Long
End Type
Private Const TS_DRAW = 2 ' TS_MIN = 0 TS_TRUE = 1
Private Declare Function GetThemePartSize Lib "uxtheme.dll" (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal prc As Long, ByVal eSize As Long, psz As SIZE) As Long
Public Sub CBOwnerDraw(frm As Form, obj As Object, ByVal hDC As Long)
Dim hTheme As Long
Dim rc As RECT
Dim ST As Long
Dim sz As SIZE
hTheme = OpenThemeData(frm.hWnd, StrPtr("BUTTON"))
If obj.Value = 1 Then
ST = CBS_CHECKEDNORMAL
Else
ST = CBS_UNCHECKEDNORMAL
End If
GetThemePartSize hTheme, hDC, BP_CHECKBOX, ST, &H0, TS_DRAW, sz
rc.Left = 2
rc.Top = 2
rc.Right = rc.Left + sz.cx ' rc.Right = 18
rc.Bottom = rc.Top + sz.cy ' rc.Bottom = 18
DrawThemeBackground hTheme, hDC, BP_CHECKBOX, ST, rc, 0
CloseThemeData hTheme
SetBkMode hDC, TRANSPARENT
SetTextColor hDC, frm.ForeColor
TextOut hDC, 20, 2, obj.Caption, Len(obj.Caption) '24
End Sub
Attachment 195990
Oh, I see. My Windows theme is not in darkmode that's why I don't get the right images.
There is a way to get the Windows DarkMode settings/images when using the normal Windows theme by using OpenThemeData with the DarkMode-classes like "DarkMode_CFD" or "DarkMode_Explorer".
I personally never tried that. I guess you will find more infos about this when searching for "OpenThemeData+DarkMode_Explorer".
Thank you, it works great.
Attachment 195993
Here is what I have changed in my code :
Code:Public Sub OwnerDrawCheckBoxW(frm As Form, obj As Object, ByVal hDC As Long, ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long)
Dim hTheme As Long
Dim rc As RECT
Dim ST As Long
Dim sz As SIZE
Dim rcGlyph As RECT
Dim rcText As RECT
Dim rcFull As RECT
initOwnerDraws frm ' move obj for alignment
hTheme = OpenThemeData(frm.hWnd, StrPtr("DarkMode_Explorer::Button")) 'BUTTON
If obj.Value = vbChecked Then
ST = CBS_CHECKEDNORMAL
Else
ST = CBS_UNCHECKEDNORMAL
End If
'Check box size
GetThemePartSize hTheme, hDC, BP_CHECKBOX, ST, rcGlyph, TS_DRAW, sz
rcGlyph.Left = Left + 2
rcGlyph.Top = Top + ((Bottom - Top - sz.cy) \ 2)
rcGlyph.Right = rcGlyph.Left + sz.cx: If rcGlyph.Right < 15 Then rcGlyph.Right = 15
rcGlyph.Bottom = rcGlyph.Top + sz.cy: If rcGlyph.Bottom < 15 Then rcGlyph.Bottom = 15
rc.Left = 2
rc.Top = 2
rc.Right = rc.Left + sz.cx: If rc.Right < 15 Then rc.Right = 15 ' rc.Right = 18
rc.Bottom = rc.Top + sz.cy: If rc.Bottom < 15 Then rc.Bottom = 15 ' rc.Bottom = 18
'Draw Check Box
DrawThemeBackground hTheme, hDC, BP_CHECKBOX, ST, rc, 0
' Text zone
GetThemeBackgroundContentRect hTheme, hDC, BP_CHECKBOX, ST, rcFull, rcText
rcText.Left = rcGlyph.Right + 4
rcText.Top = Top
rcText.Right = Right - 4
rcText.Bottom = Bottom
SetBkMode hDC, TRANSPARENT
SetTextColor hDC, frm.ForeColor
DrawText hDC, obj.Caption, -1, rcText, _
DT_LEFT Or DT_WORDBREAK 'DT_LEFT Or DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS
CloseThemeData hTheme
End Sub
Public Sub OwnerDrawOptionButtonW(frm As Form, obj As Object, ByVal hDC As Long, ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long)
Dim hTheme As Long
Dim rc As RECT
Dim ST As Long
Dim sz As SIZE
Dim rcGlyph As RECT
Dim rcText As RECT
Dim rcFull As RECT
initOwnerDraws frm ' move obj for alignment
hTheme = OpenThemeData(frm.hWnd, StrPtr("DarkMode_Explorer::Button")) 'BUTTON
If obj.Value = True Then
ST = RBS_CHECKEDNORMAL
Else
ST = RBS_UNCHECKEDNORMAL
End If
'Radio button size
GetThemePartSize hTheme, hDC, BP_RADIOBUTTON, ST, rcGlyph, TS_DRAW, sz
rcGlyph.Left = Left + 2
rcGlyph.Top = Top + ((Bottom - Top - sz.cy) \ 2)
rcGlyph.Right = rcGlyph.Left + sz.cx: If rcGlyph.Right < 15 Then rcGlyph.Right = 15
rcGlyph.Bottom = rcGlyph.Top + sz.cy: If rcGlyph.Bottom < 15 Then rcGlyph.Bottom = 15
rc.Left = 2
rc.Top = 2
rc.Right = rc.Left + sz.cx: If rc.Right < 15 Then rc.Right = 15
rc.Bottom = rc.Top + sz.cy: If rc.Bottom < 15 Then rc.Bottom = 15
'Draw radio button
DrawThemeBackground hTheme, hDC, BP_RADIOBUTTON, ST, rc, 0
' Text zone
GetThemeBackgroundContentRect hTheme, hDC, BP_CHECKBOX, ST, rcFull, rcText
rcText.Left = rcGlyph.Right + 4
rcText.Top = Top
rcText.Right = Right - 4
rcText.Bottom = Bottom
SetBkMode hDC, TRANSPARENT
SetTextColor hDC, frm.ForeColor
DrawText hDC, obj.Caption, -1, rcText, _
DT_LEFT Or DT_WORDBREAK 'DT_LEFT Or DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS
CloseThemeData hTheme
End Sub
Yes, tested under Windows 11 with VBCCR v1.08.0092.
What about the idea to hook DrawThemeText ?
I would hook it on CDDS_PREPAINT and release the hook on CDDS_POSTPAINT. It's a process wide hook so all controls using DrawThemeText are effected. But since the GUI is single threaded always it would be safe to hook for the time of the actual drawing for a particular control.
Of course it would be better to have this in-built into VBCCR and just turn a new "ForceForeColor" property to true (?) For CommandButtonW, CheckBoxW and OptionButtonW.
This works like a charm and no custom drawing of anything. Unfortunately hooking APIs is the only sane way to impl dark-mode for Win32 apps on Windows which a sad state of affairs. It’s completely under-baked at present and there are themes like Aero Lite which support it at 15% or less.
Until better solutions are available, here is my test program.
Attachment 196011
I guess there are a few more (new) themes available since Mith posted the list on June 2023.
For example for the TabStrip the following works properly. (TabStrip1.BackColor = vbBlack to conform to Form's BackColor)
Attachment 196020Code:SetWindowTheme TabStrip1.hWnd, 0, StrPtr("DarkMode_DarkTheme::Tab")
OptionButton with white text color. (NO Hooks needed !!)
Attachment 196022Code:SetWindowTheme OptionButtonW1.hWnd, StrPtr("DarkMode_DarkTheme"), 0
However, you should set the ForeColor of the OptionButtonW (or CheckBoxW) still to a white color so the focus rect is then visible on the dark theme.
I "guess" finally they do the "proper" themes with "DarkMode_DarkTheme". So, "DarkTheme" is the way to go for win32 controls instead of "Explorer".
Here a list of all the "_DarkTheme" names. I guess these should be preferred over the "_Explorer".
Attachment 196024
And yes, for example the Status bar (previously DarkMode::ExplorerStatusBar) did not theme the size grip. Now it is done properly. (DarkMode_DarkTheme::Status)
Attachment 196025
Probably will add a VisualTheme property to all VBCCR controls where you can set between 0 - Normal and 1 - Dark and it will take care everything.
But some controls seems to be still missing. DatePicker and MonthView for example.
Looks promising. I’ll test these on Aero Lite theme.
Doenst work for me using Windows 10. I guess this is only supported with win11?
edit: i tested my app with win11 and "DarkMode_DarkTheme" and i can confirm that this works with win11 (OptionButton /checkbox) but unfortunately not with any older windows version like win10!
the background-color of the ImageCombo-control is not correct with "DarkMode_DarkTheme" (win11) because of the rounded corners:
Attachment 196029
can we get a background-color property for this control?
i guess an additional background-color property for the dropdown-list is not possible, or?
Code:Call SetDarkMode_DarkTheme(icFolderIcon.hwnd)
Call SetDarkMode_DarkTheme(icFolderIcon.hWndEdit)
Call SetDarkMode_DarkTheme(icFolderIcon.hWndCombo)
Call SetDarkMode_DarkTheme(icFolderIcon.hWndList)
i tried to fix the ImageCombo-background-color issue with this code, but it doesnt work.
any ideas?
Code:Call SetControlBackColor(icFolderIcon.hwnd, gDarkMode_BackColor)
Call SetControlBackColor(icFolderIcon.hWndEdit, gDarkMode_BackColor)
Call SetControlBackColor(icFolderIcon.hWndCombo, gDarkMode_BackColor)
Call SetControlBackColor(icFolderIcon.hWndUserControl, gDarkMode_BackColor)
Public Sub SetControlBackColor(ByRef hwnd As Long, ByVal New_Color As OLE_COLOR)
'Const SB_SETBKCOLOR = &H2001
10 OleTranslateColor New_Color, 0, New_Color
20 SendMessageAny hwnd, SB_SETBKCOLOR, 0, ByVal New_Color
End Sub
There is another display-issue when using the ListViewW-control with Windows11.
Every column in Report Mode (.GridLines=false) has a light border at the right side:
Attachment 196030
This right-border is also shown when a column is hidden (.width=0):
Attachment 196031
This issue doesnt happen when using Win10.
Does anyone know how to fix this?
Code:Call SetDarkMode_DarkTheme(ListView.hwnd)
Call SetDarkMode_DarkTheme(ListView.hwndHeader)
I do not get that working for richtextcontrols (krools VBCCR)
None is working:
SetWindowTheme c.hWnd, StrPtr("DarkMode_DarkTheme"), 0&
SetWindowTheme c.hWndUserControl, StrPtr("DarkMode_DarkTheme"), 0&
SetWindowTheme c.hWnd, StrPtr("DarkMode_Explorer"), 0&
SetWindowTheme c.hWndUserControl, StrPtr("DarkMode_Explorer"), 0&
Can anyone please post code for that. Thank you
Ah, I got it working:
ScrollBars = vbBoth
has to be set before SetWindowTheme
Krool released OCX v1.8.105 with support for BackColor/ForeColor and .AllowImageHighlight for the ImageCombo!
The update fixes the white corners (Win11) and the white background color of the DropDown list (win10) by using .BackColor!
Bonus: .AllowImageHighlight=false prevents the icon from being displayed with a shadow layer after the user made a selection in the DropDown list.
Dark Mode Win10:
Attachment 196072
Dark Mode Win11:
Attachment 196073
I have improved my test program :
Attachment 196079
I have some questions, in particular (commented lines don't work for me):
Progressbar
TabStrip and CoolBarCode:Select Case TypeName(obj)
Case "ProgressBar"
' ???
' SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme::Progress")
' obj.BackColor = FRMBACKCOLOR
' obj.ForeColor = FRMFORECOLOR
' bFound = True
Code:Case "TabStrip"
'obj.VisualStyles = False
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme::Tab")
'SetWindowTheme obj.hwnd, StrPtr("DarkMode_Explorer"), 0&
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::ExplorerStatusBar") '<- ???
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer") '<- ???
obj.BackColor = FRMBACKCOLOR
bFound = True
Case "CoolBar"
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer") '<- ???
obj.BackColor = FRMBACKCOLOR
obj.ForeColor = FRMFORECOLOR
bFound = True
afaik you only have to use StrPtr("DarkMode_DarkTheme") without ":: ...". does this help?
Yes it does for ProgressBar and Coolbar. Not for TabStrip.
Code:Case "TabStrip"
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme")
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer") '<- ???
obj.BackColor = FRMBACKCOLOR
bFound = True
Case "CoolBar"
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme")
obj.BackColor = FRMBACKCOLOR
obj.ForeColor = FRMFORECOLOR
bFound = True
Case "ProgressBar"
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme")
obj.BackColor = FRMBACKCOLOR
obj.ForeColor = FRMFORECOLOR
bFound = True
Currently there is no dark mode support from MS for the TabStrip control ("SysTabControl32").
More information if you want to dive deeper: https://community.notepad-plus-plus....herit-the-mode
Ok, then I stick with
Code:SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
Here is what I get with my settings with Windows 11 (23H2)
TabStrip is dark.
Attachment 196087Attachment 196086
Code:Public Sub SetDarkMode(frm As Form, Optional bForceDarkMode As Boolean)
'
' At the end of your Form_Load(), put SetDarkMode Me
'
If DarkMode = DRKMD_AUTO Then DarkMode = TestDarkMode
If DarkMode = DRKMD_OFF And bForceDarkMode = False Then Exit Sub
' Title Bar
Dim bValue As Long
bValue = 1
Call DwmSetWindowAttribute(frm.hwnd, DWMWA_USE_IMMERSIVE_DARK_MODE, bValue, LenB(bValue))
' Form colors
frm.BackColor = FRMBACKCOLOR
frm.ForeColor = FRMFORECOLOR
Dim obj As Object
Dim i As Long
Dim idx As Long
Dim lbl As Label
Dim hCombo As Long
Dim hUpDown As Long
Dim pnl As Object
Dim bFound As Boolean
'Dim hTips As Long
'Const LVM_FIRST = &H1000
'Const LVM_GETTOOLTIPS = (LVM_FIRST + 78)
For Each obj In frm.Controls
bFound = False
'ComboBox
If (TypeOf obj Is VB.ComboBox) Then
SetWindowTheme obj.hwnd, StrPtr("DarkMode_CFD"), 0&
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::Combobox")
If obj.BackColor = vbWindowBackground Then obj.BackColor = FRMBACKCOLOR
If obj.ForeColor = vbWindowText Then obj.ForeColor = FRMFORECOLOR
bFound = True
End If
'Line
If (TypeOf obj Is VB.Line) Then
If obj.BorderColor = vbWindowText Then obj.BorderColor = WINDOWTEXTCOLOR
bFound = True
End If
'Shape
If (TypeOf obj Is VB.Shape) Then
If obj.BorderColor = vbWindowText Then obj.BorderColor = WINDOWTEXTCOLOR
If obj.FillColor = vbBlack Then obj.FillColor = vbWhite
bFound = True
End If
'PictureBox
If (TypeOf obj Is VB.PictureBox) Then
If obj.BackColor = vbButtonFace Then obj.BackColor = FRMBACKCOLOR
If obj.ForeColor = vbButtonText Then obj.ForeColor = FRMFORECOLOR
If obj.Appearance = 0 Then
If obj.BackColor = vbWindowBackground Then obj.BackColor = FRMBACKCOLOR
If obj.ForeColor = vbWindowText Then obj.ForeColor = FRMFORECOLOR
End If
bFound = True
End If
'
' VBCCR ---------------------------------------------------------------------------------[
'
If bFound = False Then
On Error Resume Next
Select Case TypeName(obj)
Case "ComboBoxW"
SetWindowTheme obj.hwnd, StrPtr("DarkMode_CFD"), 0&
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme::Combobox")
If obj.BackColor = vbWindowBackground Then obj.BackColor = FRMBACKCOLOR
If obj.ForeColor = vbWindowText Then obj.ForeColor = FRMFORECOLOR
bFound = True
Case "VirtualCombo"
SetWindowTheme obj.hwnd, StrPtr("DarkMode_CFD"), 0&
If obj.BackColor = vbWindowBackground Then obj.BackColor = FRMBACKCOLOR
If obj.ForeColor = vbWindowText Then obj.ForeColor = FRMFORECOLOR
bFound = True
Case "FontCombo"
SetWindowTheme obj.hwnd, StrPtr("DarkMode_CFD"), 0&
If obj.BackColor = vbWindowBackground Then obj.BackColor = FRMBACKCOLOR
If obj.ForeColor = vbWindowText Then obj.ForeColor = FRMFORECOLOR
bFound = True
Case "ImageCombo"
obj.VisualStyles = False
'SetWindowTheme obj.hwnd, StrPtr("DarkMode_CFD"), 0&
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme::Combobox")
hCombo = FindWindowEx(obj.hwnd, 0, "ComboBox", vbNullString)
If hCombo <> 0 Then SetWindowTheme hCombo, StrPtr("DarkMode_CFD"), 0&
On Error Resume Next
obj.BackColor = FRMBACKCOLOR
obj.ForeColor = FRMFORECOLOR
On Error GoTo 0
bFound = True
Case "ListView"
SetWindowTheme obj.hwnd, StrPtr("DarkMode_Explorer"), 0&
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::ListView")
SetWindowTheme obj.hWndHeader, StrPtr("DarkMode_ItemsView"), 0&
For i = 1 To obj.ColumnHeaders.Count ' réglage des colonnes
obj.ColumnHeaders(i).ForeColor = CMDFORECOLOR
Next i
' does not work for me or I'm missing something :
'hTips = SendMessage(obj.hWnd, LVM_GETTOOLTIPS, 0, ByVal 0)
'Call Win32SetWindowTheme(hTips, "DarkMode_Explorer")
If obj.BackColor = vbWindowBackground Then obj.BackColor = FRMBACKCOLOR
If obj.ForeColor = vbWindowText Then obj.ForeColor = FRMFORECOLOR
bFound = True
Case "ToolBar"
'SetWindowTheme obj.hwnd, StrPtr("DarkMode_Explorer"), 0&
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::Toolbar")
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme::Toolbar")
For i = 1 To obj.Buttons.Count
obj.Buttons(i).ForeColor = TLBFORECOLOR
Next i
If obj.BackColor = vbButtonFace Then obj.BackColor = FRMBACKCOLOR
If obj.InsertMarkColor = vbBlack Then obj.InsertMarkColor = vbWhite
bFound = True
Case "DTPicker"
With obj
.VisualStyles = False
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
.CalendarBackColor = FRMBACKCOLOR
.CalendarForeColor = FRMFORECOLOR
.CalendarTitleBackColor = FRMBACKCOLOR
.CalendarTitleForeColor = FRMFORECOLOR
If .UpDown = True Then
hUpDown = FindWindowEx(obj.hwnd, 0&, "msctls_updown32", "")
If hUpDown <> 0 Then SetWindowTheme hUpDown, StrPtr("DarkMode_Explorer"), 0&
End If
End With
bFound = True
Case "MonthView"
With obj
'.VisualStyles = False
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
.BackColor = FRMBACKCOLOR
.ForeColor = FRMFORECOLOR
.TitleBackColor = FRMBACKCOLOR
.TitleForeColor = FRMFORECOLOR
End With
bFound = True
Case "RichTextBox"
'SetWindowTheme obj.hwnd, StrPtr("DarkMode_Explorer"), 0&
obj.BorderStyle = 0
obj.SelStart = 0
obj.SelLength = Len(obj.Text)
If obj.SelColor = vbBlack Then obj.SelColor = TXTFORECOLOR
If obj.BackColor = vbWindowBackground Then obj.BackColor = TXTBACKCOLOR
bFound = True
Case "StatusBar"
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::ExplorerStatusBar")
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme::Status")
For Each pnl In obj.Panels
pnl.ForeColor = TXTFORECOLOR
Next
bFound = True
Case "TabStrip"
'SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme")
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer") '<- ???
obj.BackColor = FRMBACKCOLOR
bFound = True
Case "CoolBar"
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme")
obj.BackColor = FRMBACKCOLOR
obj.ForeColor = FRMFORECOLOR
bFound = True
Case "ProgressBar"
SetWindowTheme obj.hwnd, 0&, StrPtr("DarkMode_DarkTheme")
obj.BackColor = FRMBACKCOLOR
obj.ForeColor = FRMFORECOLOR
bFound = True
End Select
On Error GoTo 0
End If
'----------------------------------------------------------------------------------------]
If bFound = False Then
'
' General case
'
On Error Resume Next
SetWindowTheme obj.hwnd, StrPtr("DarkMode_Explorer"), 0&
obj.BackColor = FRMBACKCOLOR
obj.ForeColor = FRMFORECOLOR
On Error GoTo 0
'
' Special cases
'
Select Case TypeName(obj)
Case "CommandButton"
obj.BackColor = CMDBACKCOLOR
bFound = True
Case "TextBox"
obj.BackColor = TXTBACKCOLOR
obj.ForeColor = TXTFORECOLOR
obj.Appearance = 0
obj.BorderStyle = 0
bFound = True
'
' VBCCR --------------------------------------------[
'
Case "CommandButtonW"
obj.BackColor = CMDBACKCOLOR
obj.ForeColor = CMDFORECOLOR
bFound = True
Case "TextBoxW"
obj.BackColor = TXTBACKCOLOR
obj.ForeColor = TXTFORECOLOR
obj.BorderStyle = 0
bFound = True
'---------------------------------------------------]
End Select
End If
Next
'
'Option, Check, Frame, VBFlexGrid
'
If bFound = False Then
idx = 0
For Each obj In frm.Controls
Select Case TypeName(obj)
Case "OptionButton"
If Not addLabelOption(frm, obj) Then addLabel frm, obj
Case "CheckBox"
If Not addLabelOption(frm, obj) Then addLabel frm, obj
Case "Frame"
darkFrame frm, obj
Case "OptionButtonW" ' VBCCR
On Error Resume Next
If obj.DrawMode <> 1 Then ' If DrawMode is not set to OptDrawModeOwnerDraw
If Not addLabelOptionW(frm, obj) Then addLabel frm, obj
End If
On Error GoTo 0
Case "CheckBoxW" ' VBCCR
On Error Resume Next
If obj.DrawMode <> 1 Then ' If DrawMode is not set to ChkDrawModeOwnerDraw
If Not addLabelOptionW(frm, obj) Then addLabel frm, obj
End If
On Error GoTo 0
Case "VBFlexGrid" ' VBFlexGrid
On Error Resume Next
obj.GridColor = VBFLXGRD_GRIDCOLOR
obj.BackColorFixed = TXTBACKCOLOR
On Error GoTo 0
End Select
Next
End If
End Sub
Forget Windows 10.
DarkMode_DarkTheme is the right attempt by MS to address win32 applications. Not yet 100% but.. hopefully someday. Like date picker and calendar still missing.
Everything else is not right by design. Therefore I would make a OS version check and enable dark mode only when that is met. Finish.
DarkMode_DarkTheme works only with Win11 and not with Win10!
My app supports Dark Mode for Windows 10 & 11 thats the reason i check the OS version and use different API-calls to get the correct control colors.
The Win10 dark mode is not perfect but it is still possible.
> The Win10 dark mode is not perfect but it is still possible.
And it works on Win11
Only partially, for example:
1. you dont have to ownerdraw the checkbox/optionbutton anymore when using the new "DarkMode_DarkTheme" with win11!
2. the up/down buttons inside a textbox/DatePicker dont have the dark mode style & colors with win10 but with win11 and "DarkMode_DarkTheme" it works.
3. no dark mode when using the TabStrip under win10. you have to use "DarkMode_DarkTheme" with win11.
Just for information. The VBFlexGrid works now better in "dark mode colors".
As you can see below the focus rect. Top is now after an update and bottom how it was before or is in a MSFlexGrid.
Attachment 196121
Reason is that the DrawFocusRect API makes an XOR operation. And there SetBkColor/SetTextColor influences the outcome.
SetTextColor is of course used but not SetBkColor. It remained still in the default color of white. Now it's set to what the background actually is.