ObjectColor (Dark Mode)
ObjectColor (Dark Mode)
Set Gadget Background and Text Colors automatically based on the parent container's color or on the colors passed in parameters.
It should make some applications with a more modern and user-friendly look.
More info, supported gadget and usages in the source code header.
The code has become too big and exceeds the maximum number of allowed characters (60000)
It is now available in my GitHub space with a MIT Licence:
ObjectColor-Dark-Mode
It is a work in progress, do not hesitate to contribute with your improvements
It should make some applications with a more modern and user-friendly look.
More info, supported gadget and usages in the source code header.
The code has become too big and exceeds the maximum number of allowed characters (60000)
It is now available in my GitHub space with a MIT Licence:
ObjectColor-Dark-Mode
It is a work in progress, do not hesitate to contribute with your improvements
Last edited by ChrisR on Fri May 06, 2022 10:48 am, edited 15 times in total.
- Kwai chang caine
- Always Here
- Posts: 5342
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: ObjectColor
Hello ChrisR
Thanks for sharing
I don't know if it's normal
But when i run the code, the background checkBox is not black and trackbar change only if i click under
And when i change color the CheckBox is good and the TrackBar change only if i click under
Thanks for sharing
I don't know if it's normal
But when i run the code, the background checkBox is not black and trackbar change only if i click under
And when i change color the CheckBox is good and the TrackBar change only if i click under
The happiness is a road...
Not a destination
Not a destination
Re: ObjectColor
Hey ChrisR. Nice idea, I guess this will come in handy in the future (especially for skinning, dark mode etc.). However, one quick view at the function "TypetoValue" caught my eye. How about:
?
This way the code is faster (and only one LCase() is used).
...also your original function has three typos: 2 capital letters (which will refuse to work after LCase()) and "explorerkist".
Code: Select all
Procedure TypetoValue(Type.s)
Select LCase(Right(Type,Len(type)-15))
Case "button"
ProcedureReturn #PB_GadgetType_Button
Case "calendar"
ProcedureReturn #PB_GadgetType_Calendar
Case "checkbox"
ProcedureReturn #PB_GadgetType_CheckBox
Case "combobox"
ProcedureReturn #PB_GadgetType_ComboBox
Case "container"
ProcedureReturn #PB_GadgetType_Container
Case "date"
ProcedureReturn #PB_GadgetType_Date
Case "editor"
ProcedureReturn #PB_GadgetType_Editor
Case "explorerlist"
ProcedureReturn #PB_GadgetType_ExplorerList
Case "explorertree"
ProcedureReturn #PB_GadgetType_ExplorerTree
Case "frame"
ProcedureReturn #PB_GadgetType_Frame
Case "hyperlink"
ProcedureReturn #PB_GadgetType_HyperLink
Case "listicon"
ProcedureReturn #PB_GadgetType_ListIcon
Case "listview"
ProcedureReturn #PB_GadgetType_ListView
Case "option"
ProcedureReturn #PB_GadgetType_Option
Case "panel"
ProcedureReturn #PB_GadgetType_Panel
Case "progressbar"
ProcedureReturn #PB_GadgetType_ProgressBar
Case "scrollarea"
ProcedureReturn #PB_GadgetType_ScrollArea
Case "spin"
ProcedureReturn #PB_GadgetType_Spin
Case "string"
ProcedureReturn #PB_GadgetType_String
Case "text"
ProcedureReturn #PB_GadgetType_Text
Case "trackbar"
ProcedureReturn #PB_GadgetType_TrackBar
Case "tree"
ProcedureReturn #PB_GadgetType_Tree
EndSelect
EndProcedure
This way the code is faster (and only one LCase() is used).
...also your original function has three typos: 2 capital letters (which will refuse to work after LCase()) and "explorerkist".
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
Re: ObjectColor
@KCC,
It's been a while since we've spoken (written), nice to see you
I do not reproduce for the checkBox or trackbar on windows10 and I just tested on windows 7 in VMware and it looks good too.
I do not have XP installed in VM, to see but as Rashad said, probably you forgot to enable the XP modern theme ?
@Rashad
With your mastery of Windows APIs, maybe you can help a bit to go a little further, combobox or column headers for examples.
@jacdelad
Yes, I also think it could be useful in the future, for DarkTheme or other skinning.
I added 2 functions for that in addition: SetDarkTheme() (> windows 10) and SetExplorerTheme() (> Vista I believe)
Thanks for the correction of my typos and it's better with Select, of course.
It's been a while since we've spoken (written), nice to see you
I do not reproduce for the checkBox or trackbar on windows10 and I just tested on windows 7 in VMware and it looks good too.
I do not have XP installed in VM, to see but as Rashad said, probably you forgot to enable the XP modern theme ?
@Rashad
With your mastery of Windows APIs, maybe you can help a bit to go a little further, combobox or column headers for examples.
@jacdelad
Yes, I also think it could be useful in the future, for DarkTheme or other skinning.
I added 2 functions for that in addition: SetDarkTheme() (> windows 10) and SetExplorerTheme() (> Vista I believe)
Thanks for the correction of my typos and it's better with Select, of course.
Re: ObjectColor
I updated the code on the 1st post with:
- To get the color of the parent container, for the ScrollArea we need the grandfather (or the grandmother).
- For SetObjectColorType(), I added "NoEdit" type for all supported Gadget except String and Editor.
- By default the background color are initialized only Once now with the parent container color, to save processing time.
If your app allows color changes for windows or containers, then you must call the function AllowColorChange(), as in the demo.
- And I added 2 functions:
- SetDarkTheme() : Enable DarkMode_Explorer Theme (> Windows 10) for: Editor, ExplorerList, ExplorerTree, ListIcon, ListView, ScrollArea, ScrollBar and Tree Gadget.
- SetExplorerTheme() : Enable Explorer Theme (> Vista) for the same Gadgets.
Re: ObjectColor
Hi ChrisR
For ComboBox()
For ComboBox()
Code: Select all
Global iconsize=16,CBh=iconsize+16,hBrush,hBrush2
Global icon1=LoadIcon_(0,#IDI_EXCLAMATION)
Global icon2=LoadIcon_(0,#IDI_QUESTION)
Global icon3=LoadIcon_(0,#IDI_ERROR)
hBrush=CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
hBrush2=CreateSolidBrush_($0)
Procedure winCB(hWnd,uMsg,wParam,lParam)
Result=#PB_ProcessPureBasicEvents
Select uMsg
Case #WM_DRAWITEM
*DrawItem.DRAWITEMSTRUCT=lParam
If wparam = 2 And *DrawItem\CtlType=#ODT_COMBOBOX
If *DrawItem\itemID <> -1
If *DrawItem\itemstate & #ODS_SELECTED
FillRect_(*DrawItem\hDC,*DrawItem\rcitem,hBrush)
SetTextColor_(*DRAWITEM\hDC,$FFFFFF)
Else
FillRect_(*DrawItem\hDC,*DrawItem\rcitem,hBrush2)
SetTextColor_(*DRAWITEM\hDC,$0)
EndIf
SetBkMode_(*DrawItem\hDC,#TRANSPARENT)
If *DrawItem\itemID = 0
DrawIconEx_(*DrawItem\hDC,*DrawItem\rcItem\left+2,*DrawItem\rcItem\top+6,icon1,iconsize,iconsize,0,0,#DI_NORMAL)
ElseIf *DrawItem\itemID = 1
DrawIconEx_(*DrawItem\hDC,*DrawItem\rcItem\left+2,*DrawItem\rcItem\top+6,icon2,iconsize,iconsize,0,0,#DI_NORMAL)
ElseIf *DrawItem\itemID = 2
DrawIconEx_(*DrawItem\hDC,*DrawItem\rcItem\left+2,*DrawItem\rcItem\top+6,icon3,iconsize,iconsize,0,0,#DI_NORMAL)
EndIf
*DrawItem\rcItem\left=CBh
SetTextColor_(*DRAWITEM\hDC,$FFFFFF)
text$=GetGadgetItemText(*DrawItem\CtlID,*DrawItem\itemID)
DrawText_(*DrawItem\hDC,text$,Len(text$),*DrawItem\rcItem,#DT_SINGLELINE|#DT_VCENTER)
EndIf
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
OpenWindow(0,0,0,300,50,"ComboBox",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_TitleBar)
SetWindowCallback(@winCB())
ComboBoxGadget(2,10,10,130,CBh,#CBS_OWNERDRAWFIXED|#CBS_HASSTRINGS)
SendMessage_(GadgetID(2),#CB_SETITEMHEIGHT,0,CBh)
AddGadgetItem(2,-1,"Item # 1")
AddGadgetItem(2,-1,"Item # 2")
AddGadgetItem(2,-1,"Item # 3")
SetGadgetState(2,0)
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
Egypt my love
Re: ObjectColor
Hi Rashad,
Great, it works well
There is just the combo with Image (#PB_ComboBox_Image) that are not supported for now. It's ok for the other flags.
But not really a concern, I can go with this for now:
Otherwise, I'm a little surprised that wParam is the PB Gadget number, not the GadgetID here !
Anyway, a very good starting point for me, thanks a lot
Great, it works well
There is just the combo with Image (#PB_ComboBox_Image) that are not supported for now. It's ok for the other flags.
But not really a concern, I can go with this for now:
Code: Select all
ComboBoxGadget(2,10,10,130,CBh,#PB_ComboBox_LowerCase)
.....
If GetWindowLongPtr_(GadgetID(2), #GWL_STYLE) & #CBS_HASSTRINGS = #CBS_HASSTRINGS
SetWindowLongPtr_(GadgetID(2), #GWL_STYLE, GetWindowLongPtr_(GadgetID(2), #GWL_STYLE) | #TCS_OWNERDRAWFIXED)
EndIf
Otherwise, I'm a little surprised that wParam is the PB Gadget number, not the GadgetID here !
Anyway, a very good starting point for me, thanks a lot
- Kwai chang caine
- Always Here
- Posts: 5342
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: ObjectColor
You have right !!!
You are always also strong......
I don't know how you do
for always know what i do or not
Me too !!!ChrisR wrote:@KCC,
It's been a while since we've spoken (written), nice to see you
You have right too, i have again forgotten this history of checkbox "visual theme"
Again thanks for all this works for the community
At the new pleasure to "papote tricot" again together
The happiness is a road...
Not a destination
Not a destination
Re: ObjectColor
Kwai chang caine wrote: ↑Fri Apr 15, 2022 5:39 pmYou have right !!!
I don't know how you do
for always know what i do or not
I guess it's a matter of experience, we can discuss this at the next "papote tricot" together, with pleasure
Re: ObjectColor
Does anyone have an explanation, 2 Gadgets and 2 ways to add the same #CBS_OWNERDRAWFIXED flag. The #WM_DRAWITEM event are received for the 1st Gadget but NOT for the 2nd ?
I don't understand anything
I don't understand anything
Code: Select all
EnableExplicit
Global hBrushHighLight=CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
Global hBrushBackColor=CreateSolidBrush_($202020)
Procedure winCB(hWnd,uMsg,wParam,lParam)
Protected *DrawItem.DRAWITEMSTRUCT, text$, TextColor, Result=#PB_ProcessPureBasicEvents
Select uMsg
Case #WM_DRAWITEM
*DrawItem.DRAWITEMSTRUCT = lParam
If *DrawItem\CtlType=#ODT_COMBOBOX
Debug "#WM_DRAWITEM Event Received for Gadget: " + Str(wParam)
TextColor = #White
If *DrawItem\itemID <> -1
If *DrawItem\itemstate & #ODS_SELECTED
FillRect_(*DrawItem\hDC,*DrawItem\rcitem,hBrushHighLight)
Else
FillRect_(*DrawItem\hDC,*DrawItem\rcitem,hBrushBackColor)
EndIf
SetBkMode_(*DrawItem\hDC,#TRANSPARENT)
SetTextColor_(*DRAWITEM\hDC,TextColor)
text$=GetGadgetItemText(*DrawItem\CtlID,*DrawItem\itemID)
DrawText_(*DrawItem\hDC,text$,Len(text$),*DrawItem\rcItem,#DT_SINGLELINE|#DT_VCENTER)
EndIf
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
OpenWindow(0,0,0,200,90,"ComboBox",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_TitleBar)
SetWindowCallback(@winCB())
ComboBoxGadget(1,10,10,180,30,#CBS_HASSTRINGS|#CBS_OWNERDRAWFIXED)
Debug "Gadget: 1 > GWL_STYLE: " + Str(GetWindowLongPtr_(GadgetID(1),#GWL_STYLE)) + ". OK"
AddGadgetItem(1,-1,"Item # 1") : AddGadgetItem(1,-1,"Item # 2") : AddGadgetItem(1,-1,"Item # 3")
SetGadgetState(1,0)
Debug "-------------------"
ComboBoxGadget(2,10,50,180,30)
SetWindowLongPtr_(GadgetID(2),#GWL_STYLE,GetWindowLongPtr_(GadgetID(2),#GWL_STYLE)|#CBS_HASSTRINGS|#CBS_OWNERDRAWFIXED)
Debug "Gadget: 2 > GWL_STYLE: " + Str(GetWindowLongPtr_(GadgetID(2),#GWL_STYLE)) + ". NOT OK. #WM_DRAWITEM Event NOT Received in the CallBack?"
AddGadgetItem(2,-1,"Item # 1") : AddGadgetItem(2,-1,"Item # 2") : AddGadgetItem(2,-1,"Item # 3")
SetGadgetState(2,0)
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
Re: ObjectColor
Hi ChrisR
Code: Select all
EnableExplicit
Global hBrushHighLight=CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
Global hBrushBackColor=CreateSolidBrush_($202020)
Procedure winCB(hWnd,uMsg,wParam,lParam)
Protected *DrawItem.DRAWITEMSTRUCT, text$, TextColor, Result=#PB_ProcessPureBasicEvents
Select uMsg
Case #WM_DRAWITEM
*DrawItem.DRAWITEMSTRUCT = lParam
If *DrawItem\CtlType=#ODT_COMBOBOX
Debug "#WM_DRAWITEM Event Received for Gadget: " + Str(wParam)
TextColor = #White
If *DrawItem\itemID <> -1
If *DrawItem\itemstate & #ODS_SELECTED
FillRect_(*DrawItem\hDC,*DrawItem\rcitem,hBrushHighLight)
Else
FillRect_(*DrawItem\hDC,*DrawItem\rcitem,hBrushBackColor)
EndIf
SetBkMode_(*DrawItem\hDC,#TRANSPARENT)
SetTextColor_(*DRAWITEM\hDC,TextColor)
text$=GetGadgetItemText(*DrawItem\CtlID,*DrawItem\itemID)
DrawText_(*DrawItem\hDC,text$,Len(text$),*DrawItem\rcItem,#DT_SINGLELINE|#DT_VCENTER)
EndIf
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
OpenWindow(0,0,0,200,90,"ComboBox",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_TitleBar)
SetWindowCallback(@winCB())
ComboBoxGadget(1,10,10,180,30,#CBS_HASSTRINGS|#CBS_OWNERDRAWFIXED)
Debug "Gadget: 1 > GWL_STYLE: " + Str(GetWindowLongPtr_(GadgetID(1),#GWL_STYLE)) + ". OK"
AddGadgetItem(1,-1,"Item # 1") : AddGadgetItem(1,-1,"Item # 2") : AddGadgetItem(1,-1,"Item # 3")
SetGadgetState(1,0)
Debug "-------------------"
ComboBoxGadget(2,10,50,180,30,#CBS_HASSTRINGS|#CBS_OWNERDRAWFIXED)
;SetWindowLongPtr_(GadgetID(2),#GWL_STYLE,GetWindowLongPtr_(GadgetID(2),#GWL_STYLE)|#CBS_HASSTRINGS|#CBS_OWNERDRAWFIXED)
Debug "Gadget: 2 > GWL_STYLE: " + Str(GetWindowLongPtr_(GadgetID(2),#GWL_STYLE)) + ". NOT OK. #WM_DRAWITEM Event NOT Received in the CallBack?"
AddGadgetItem(2,-1,"Item # 1") : AddGadgetItem(2,-1,"Item # 2") : AddGadgetItem(2,-1,"Item # 3")
SetGadgetState(2,0)
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
Egypt my love
Re: ObjectColor
Hi Rashad,
So, no choice, #CBS_HASSTRINGS and #CBS_OWNERDRAWFIXED must be added at Combobox creation time, to receive its events in the Window Callback.
It does NOT work if it is done after with:
Good to know but too bad
So, no choice, #CBS_HASSTRINGS and #CBS_OWNERDRAWFIXED must be added at Combobox creation time, to receive its events in the Window Callback.
Code: Select all
ComboBoxGadget(0,X,Y,W,H,#CBS_HASSTRINGS|#CBS_OWNERDRAWFIXED)
It does NOT work if it is done after with:
Code: Select all
SetWindowLongPtr_(GadgetID(0),#GWL_STYLE,GetWindowLongPtr_(GadgetID(0),#GWL_STYLE)|#CBS_HASSTRINGS|#CBS_OWNERDRAWFIXED
Good to know but too bad
Re: ObjectColor
Can the first post please be kept updated with the most recent code? Because when I copy and paste it, the EditorGadget and StringGadget are still white instead of dark as in the screenshot, and I can't see where to fix it. Thanks!
Re: ObjectColor
It seems that the dark mode of the combobox can be set as the code below on Windows 10+.
But the image combobox is only partially possible.
But the image combobox is only partially possible.
Code: Select all
UsePNGImageDecoder()
#BackColor = $999999
Global hBrushBackground = CreateSolidBrush_(#BackColor)
#APP_OldWndProc = "MyApp_OldWndProc"
Procedure WndProc_MainWindow(hWnd, uMsg, wParam, lParam)
Protected Result = #PB_ProcessPureBasicEvents
Protected hParent, buffer.s
Select uMsg
Case #WM_CTLCOLOREDIT
buffer = Space(64)
hParent = GetParent_(lParam)
If GetClassName_(hParent, @buffer, 64)
If buffer = "ComboBox"
;SetBkMode_(wParam, #TRANSPARENT)
SetBkColor_(wParam, #BackColor)
SetTextColor_(wParam, #White)
ProcedureReturn hBrushBackground
EndIf
EndIf
Case #WM_CTLCOLORLISTBOX
buffer = Space(64)
If GetClassName_(lParam, @buffer, 64)
If buffer = "ComboLBox"
SetTextColor_(wParam, #White)
ProcedureReturn hBrushBackground
EndIf
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
Procedure WndProc_ComboboxChild(hWnd, uMsg, wParam, lParam)
Protected old = GetProp_(hWnd, #APP_OldWndProc)
Protected hParent, buffer.s
Select uMsg
Case #WM_ERASEBKGND
;GetClientRect_(hWnd, rt.RECT)
;FillRect_(wParam, rt, hBrushBackground)
;ProcedureReturn 1
Case #WM_CTLCOLOREDIT
buffer = Space(64)
hParent = GetParent_(lParam)
If GetClassName_(hParent, @buffer, 64)
If buffer = "ComboBox"
Debug "WM_CTLCOLOREDIT"
;SetBkMode_(wParam, #TRANSPARENT)
SetBkColor_(wParam, #BackColor)
SetTextColor_(wParam, #White)
ProcedureReturn hBrushBackground
EndIf
EndIf
Case #WM_CTLCOLORLISTBOX
buffer = Space(64)
If GetClassName_(lParam, @buffer, 64)
If buffer = "ComboLBox"
Debug "WM_CTLCOLORLISTBOX"
SetBkColor_(wParam, #BackColor)
SetBkMode_(wParam, #TRANSPARENT)
SetTextColor_(wParam, #White)
ProcedureReturn hBrushBackground
EndIf
EndIf
Case #WM_NCDESTROY
RemoveProp_(hWnd, #APP_OldWndProc)
EndSelect
ProcedureReturn CallWindowProc_(old, hWnd, uMsg, wParam, lParam)
EndProcedure
LoadImage(0, #PB_Compiler_Home + "examples/sources/Data/world.png")
If OpenWindow(0, 0, 0, 270, 180, "ComboBoxGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetWindowColor(0, #Gray)
SetWindowCallback(@WndProc_MainWindow())
ComboBoxGadget(0, 10, 10, 250, 25, #PB_ComboBox_Editable)
For a = 1 To 10
AddGadgetItem(0, -1, "ComboBox editable... " + Str(a))
Next
SetGadgetState(0, 0)
ComboBoxGadget(1, 10, 40, 250, 25)
For a = 1 To 10
AddGadgetItem(1, -1,"ComboBox item " + Str(a))
Next
SetGadgetState(1, 0)
ComboBoxGadget(2, 10, 70, 250, 25, #PB_ComboBox_Image)
For a = 1 To 10
AddGadgetItem(2, -1, "ComboBox item with image " + Str(a), ImageID(0))
Next
SetGadgetState(2, 0)
ComboBoxGadget(3, 10, 100, 250, 25, #PB_ComboBox_Image | #PB_ComboBox_Editable)
For a = 1 To 10
AddGadgetItem(3, -1, "Editable ComboBox item with image " + Str(a), ImageID(0))
Next
SetGadgetState(3, 0)
If OSVersion() >= #PB_OS_Windows_10
SetWindowTheme_(GadgetID(0), "DarkMode_CFD", "Combobox")
SetWindowTheme_(GadgetID(1), "DarkMode_CFD", "Combobox")
hChild = GetWindow_(GadgetID(2), #GW_CHILD)
If hChild
SetWindowTheme_(hChild, "DarkMode_CFD", "Combobox")
old = SetWindowLongPtr_(hChild, #GWLP_WNDPROC, @WndProc_ComboboxChild())
SetProp_(hChild, #APP_OldWndProc, old)
EndIf
hChild = GetWindow_(GadgetID(3), #GW_CHILD)
If hChild
SetWindowTheme_(hChild, "DarkMode_CFD", "Combobox")
old = SetWindowLongPtr_(hChild, #GWLP_WNDPROC, @WndProc_ComboboxChild())
SetProp_(hChild, #APP_OldWndProc, old)
EndIf
EndIf
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
DeleteObject_(hBrushBackground)
Last edited by breeze4me on Sat Apr 16, 2022 12:53 pm, edited 1 time in total.