Please can you show me the content of your function "Win32SetWindowTheme" and the declaration of the windows api "SetWindowTheme"?
Printable View
VBCCR18 DTPicker control:
Attachment 195919
Using the code:
Attachment 195920Code:SetWindowTheme dtpSelectDate.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
The editbox got the darkmode-look but the icons in the right dropdown-section are gone and the calendar still looks normal...
I also tried .hWndCalendar but no effect.
> The editbox got the darkmode-look but the icons in the right dropdown-section are gone and the calendar still looks normal...
This is the best I could achieve back when I was researching the darkmode for our apps.
cheers,
</wqw>
It expects Unicode strings so the declare itself has to be in vb6
Public Declare Function SetWindowTheme Lib "uxtheme" (ByVal hwnd As LongPtr, ByVal pszSubAppName As LongPtr, ByVal pszSubIdList As LongPtr) As Long
You use 0 for NULL and StrPtr("text") for anything besides null. Presumably wqweto's wrapper is handling that.
(As always if you don't have oleexp.tlb, VB6LongPtr.tlb, or another existing def, you can add LongPtr support with Public Enum LongPtr: [_]: End Enum)
In tB my API lib accepts the LongPtr version and has an overload to also accept String directly,
Public DeclareWide PtrSafe Function SetWindowTheme Lib "uxtheme" (ByVal hwnd As LongPtr, ByVal pszSubAppName As String, ByVal pszSubIdList As String) As Long
Yes, it's a thin convenience wrapper over the LongPtr (optional) parameters:
cheers,Code:Private Declare Function SetWindowTheme Lib "uxtheme" (ByVal hwnd As Long, ByVal pszSubAppName As Long, ByVal pszSubIdList As Long) As Long
Public Function Win32SetWindowTheme(ByVal hwnd As Long, pszSubAppName As String, Optional pszSubIdList As String) As Long
Win32SetWindowTheme = SetWindowTheme(hwnd, StrPtr(pszSubAppName), StrPtr(pszSubIdList))
End Function
</wqw>
Anyone got that working for ImageCombos?
I use this code for VBCCR ImageCombos DarkMode:
This will change the combobox to DarkMode and the scrollbar of the dropdown-list but you cant change the background color of the dropdown-list.Code:If sTypeName = "ImageCombo" Then
If g_IsWindows10orHigher = True Then
Call SetDarkModeCFD(CTL.hWndCombo) ' "DarkMode_CFD"
Call SetDarkModeExplorer(CTL.hWndList) ' "DarkMode_Explorer"
End If
End If
I guess the dropdown-list is owner-drawed and ignore the darkmode settings.
VBCCR 1.8.86
The best DarkMode for the DateTimePicker-Control we can get so far.
Maybe we will find a solution to change the color of the right DropDown-Button in the future too:
Attachment 195929Code:DTPicker1.VisualStyles = FALSE
SetWindowTheme DTPicker1.hwnd, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
DTPicker1.CalendarBackColor = gDarkMode_BackColor
DTPicker1.CalendarForeColor = gDarkMode_FontColor
DTPicker1.CalendarTitleBackColor = gDarkMode_BackColor2
DTPicker1.CalendarTitleForeColor = gDarkMode_FontColor
I get this with DTPicker and MonthView :
Attachment 195932
Calendar does not fill up its window.
Attachment 195933
Monthview is cropped
@Crapahute
i guess you dont use VBCCR v1.8.86 ?
I do
Edit :
Oops, my bad, for an obscure reason, the recorded ocx was not the one in my SYSWOW64 folder. Thank you for sending me on this track.
Now I only have the problem with the cropped MonthView.
I cant reproduce this with VBCCR v1.8.86 and the MonthView.
You should provide more information and ask Krool about this at the VBCCR thread: https://www.vbforums.com/showthread....mmon-controls)
Mith,
the drop-down calendar can be made to dark mode on the DropDown event. It is now fixed that it will resize itself upon WM_THEMECHANGED.
Attachment 195949Code:Private Sub DTPicker1_DropDown()
SetWindowTheme DTPicker1.hWndCalendar, 0&, StrPtr("DarkMode::FileExplorerBannerContainer")
End Sub
Crapahute,
the MonthView now recompute itself upon WM_THEMECHANGED so you can use SetWindowTheme to make it darkmode and all is fine.
This is my work in progress. I tried to find a solution for the ForeColor of OptionButtons and CheckBoxes. The code is dirty as it is only a test. It works for me (VBCCR + VBFLEXGRID).
Attachment 195974
Attachment 195982Code:'
' Tested under Windows 11 with VBCCR v1.08.0092
'
' Everything does not render well in DarkMode,
' especially the OptionButtons and the CheckBoxes.
' Therefore, we need to place an invisible label called
' LabelOption(0) on the form.
' This will be used to create a clickable pseudo-caption
' for these objects.
' The OptionButtons and the Checkboxes will be shorten
' so that their real caption disappear leaving only
' their icon visible. Then a LabelOption is created and
' positioned next to the icon. This way, the icon
' and the LabelOption are clickable.
' With VBCCR, LabelOption(0) can be a LabelW.
' We need to add the following to the form code :
'
'Private Sub LabelOption_Click(Index As Integer)
' LabelOptionClick Me, Index
'End Sub
'
' If you don’t put a LabelOption(0) on the form,
' labels are dynamically created as captions but
' they won’t be clickable.
' It is also done this way for option buttons
' and check boxes that are in a container.
'
' For OptionButtonW and CheckBoxW, you can choose
' to draw the object. You have to change the
' property DrawMode of your object to 1.
' Then in your form add for each object (ex: OptionButtonW1 and CheckBoxW1):
'
'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
'
'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
'
' It's easier and cleaner to use BUT the drawn icons aren't in DarkMode.
'
to fix the CheckboxW and OptionButtonW color problem you should use .DrawMode=1 and at the OwnerDraw-Event you should use a function to draw the control yourself.
I wanted to point out again that the dropdown calendar in dark mode style cannot be used in practice because the two buttons (arrows) for month forward and back are so tiny that you can hardly see them and it is also extremely difficult to click them. I have to use this hybrid-DarkMode-Style: https://www.vbforums.com/showthread....=1#post5690100
Yes, and when CheckBox / OptionButton do not work out of the box then this whole dark mode thing is a mess work in progress by MS and not yet ready for production.
The CommandButton does work. So there the internal DrawThemeText makes a light text color.
It cannot be the solution to be forced to owner draw..
I have followed your suggestion and modified my code (https://www.vbforums.com/showthread....=1#post5690179).
The problem is that the circle and the box are no longer in dark mode.
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