ObjectColor (Dark Mode)

[ChrisR]

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

[Kwai chang caine]

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

[RASHAD]

@KCC
Probably you forgot to enable the XP modern theme as usual

[jacdelad]

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:

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".

[ChrisR]

@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.

[ChrisR]

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.

[RASHAD]

Hi ChrisR
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

[ChrisR]

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:

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]

@KCC
Probably you forgot to enable the XP modern theme as usual

You have right !!!
You are always also strong......
I don't know how you do



for always know what i do or not

@KCC,
It's been a while since we've spoken (written), nice to see you

Me too !!!
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

[ChrisR]

Probably you forgot to enable the XP modern theme as usual

You 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

[ChrisR]

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

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

[RASHAD]

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

[ChrisR]

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.

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

[BarryG]

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!

[breeze4me]

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.

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)