ListIcon Column Header Text Colour

Windows specific forum
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

ListIcon Column Header Text Colour

Post by IdeasVacuum »

I have an app with multiple ListIcons. When the app is in help mode, I temporarily change the backcolour and gridlines of the ListIcons, but I would also like to change either the backcolour or the text colour of the Column Headers. There is very simple code to change the Header font height. I have tried to mimic this for text colour, no joy:

Code: Select all

EnableExplicit

Enumeration
#MyWin
#MyList
#Font12
#Font16
EndEnumeration

LoadFont(#Font12, "Arial", 12, #PB_Font_HighQuality)
LoadFont(#Font16, "Arial", 16, #PB_Font_Bold)

Procedure MyWindow()
;#------------------
Protected   iRow.i
Protected iFlags.i = #PB_Window_SystemMenu | #PB_Window_ScreenCentered

              If OpenWindow(#MyWin, 0, 0, 420, 220, "ListIcon Font", iFlags)

                       ListIconGadget(#MyList, 10, 10, 400, 200, "Col 0", 100, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
                      AddGadgetColumn(#MyList, 1, "Col 1", 100)
                      AddGadgetColumn(#MyList, 2, "Col 2", 100)
                      AddGadgetColumn(#MyList, 3, "Col 3", 100)

                      For iRow = 0 To 10

                              AddGadgetItem(#MyList, iRow, "Col 0" + #LF$ + "Col 1" + #LF$ + "Col 2" + #LF$ + "Col 3")
                      Next

                      SetGadgetItemColor(#MyList, #PB_All, #PB_Gadget_FrontColor, RGB(0,0,255))
                           SetGadgetFont(#MyList, FontID(#Font12))
                            SendMessage_(SendMessage_(GadgetID(#MyList), #LVM_GETHEADER, 0, 0), #WM_SETFONT, FontID(#Font16), 1)
                            SendMessage_(SendMessage_(GadgetID(#MyList), #LVM_GETHEADER, 0, 0), #LVM_SETTEXTCOLOR, RGB(255, 0, 0), 1) ;<-- fail!
              EndIf
EndProcedure

Procedure WaitForUser()
;#---------------------
Protected iExit.i = #False

              Repeat

                    Select WaitWindowEvent(1)

                               Case #PB_Event_CloseWindow: iExit = #True
                    EndSelect

              Until iExit = #True
EndProcedure

   MyWindow()
WaitForUser()
End
[/size]

sRod posted code years ago that can change header backcolour and font colour, but:
1) Huge amount of code
2) Turns nice Win7 Headers into ugly classic headers
http://www.purebasic.fr/english/viewtopic.php?t=27488

So, has anyone got a magic wand solution for this?
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
Shardik
Addict
Addict
Posts: 1989
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: ListIcon Column Header Text Colour

Post by Shardik »

The following code example demonstrates how to change the color of the header text without being forced to use the ugly classic headers (option "Enable modern theme support" may remain enabled, exception: Windows XP SP3).

Image

I tested the example successfully with option "Enable modern theme support" both enabled and disabled on these Windows versions:
- Windows XP SP3 (PB 5.44 x86 in both ASCII and Unicode mode and PB 5.60 x86; works only with option "Enable modern theme support" disabled!)
- Windows 7 x86 SP1 (PB 5.44 x86 in both ASCII and Unicode mode and PB 5.60 x86)
- Windows 7 x64 SP1 (PB 5.44 x86 and x64 in both ASCII and Unicode mode and PB 5.60 x86 and x64)
- Windows 8.1 x64 (PB 5.44 x86 and x64 in both ASCII and Unicode mode and PB 5.60 x86 and x64)

Code: Select all

EnableExplicit

#HeaderTextColor = #Blue
#LVM_GETHEADER = #LVM_FIRST + 31

Define DefaultListIconCallback.I

Procedure CustomListIconCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
  Shared DefaultListIconCallback.I

  Protected *NMCUSTOMDRAW.NMCUSTOMDRAW
  Protected *NMHDR.NMHDR
  Protected Result.I

  Result = CallWindowProc_(DefaultListIconCallback, WindowHandle.I, Msg.I,
    WParam.I, LParam.I)

  If Msg = #WM_NOTIFY
    *NMHDR = LParam

    If *NMHDR\code = #NM_CUSTOMDRAW
      *NMCUSTOMDRAW = LParam
      
      Select *NMCUSTOMDRAW\dwDrawStage
        Case #CDDS_PREPAINT
          Result = #CDRF_NOTIFYITEMDRAW
        Case #CDDS_ITEMPREPAINT
          SetTextColor_(*NMCUSTOMDRAW\hdc, #HeaderTextColor)
      EndSelect
    EndIf
  EndIf

  ProcedureReturn Result
EndProcedure

OpenWindow(0, 200, 100, 400, 100, "ListIconGadget with colored header text")
ListIconGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20,
  "Name", 110, #PB_ListIcon_GridLines)
AddGadgetColumn(0, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0, 0,
  #PB_ListIcon_ColumnWidth) - 4)
AddGadgetItem(0, -1, "Harry Rannit" + #LF$ +
  "12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit" + #LF$ +
  "130 PureBasic Road, BigTown, CodeCity")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ +
  "321 Logo Drive, Mouse House, Downtown")

DefaultListIconCallback = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC,
  @CustomListIconCallback())

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
Last edited by Shardik on Thu Aug 03, 2017 2:31 pm, edited 3 times in total.
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: ListIcon Column Header Text Colour

Post by IdeasVacuum »

That is brilliant Shardik, small amount of code! Thank you.
I have bodged your code to show it can be applied to more than one ListIcon and the colour can be changed dynamically:

Code: Select all

;PB5.60 Run-time change of ListIcon column header text colour

EnableExplicit

Enumeration
#Win
#List1
#List2
#BtnB
#BtnR
EndEnumeration

#Ig = #PB_Ignore

Global igExit.i = #False
Global igDefListIconCallback.i
Global igHdTxtClr.i = RGB(0,0,0)

Procedure CustomListIconCallback(iWinHandle.i, iMsg.i, wParam.i, lParam.i)
;#------------------------------------------------------------------------
Protected *NMCUSTOMDRAW.NMCUSTOMDRAW
Protected *NMHDR.NMHDR
Protected iResult.i = CallWindowProc_(igDefListIconCallback, iWinHandle, iMsg, wParam, lParam)

          If iMsg = #WM_NOTIFY

                 *NMHDR = lParam

                 If *NMHDR\code = #NM_CUSTOMDRAW

                         *NMCUSTOMDRAW = lParam

                         Select *NMCUSTOMDRAW\dwDrawStage

                                Case #CDDS_PREPAINT
                                     iResult = #CDRF_NOTIFYITEMDRAW

                                Case #CDDS_ITEMPREPAINT
                                     SetTextColor_(*NMCUSTOMDRAW\hdc, igHdTxtClr)
                         EndSelect
                 EndIf
          EndIf

          ProcedureReturn iResult
EndProcedure

OpenWindow(#Win, 200, 100, 400, 400, "ListIcon: change header text colour")

 ListIconGadget(#List1, 10, 10, 380, 150, "Name", 110, #PB_ListIcon_GridLines)
AddGadgetColumn(#List1, 1, "Address", 260)
  AddGadgetItem(#List1, -1, "Harry Rannit"   + #LF$ + "12 Parliament Way, Battle Street, By the Bay")
  AddGadgetItem(#List1, -1, "Ginger Brokeit" + #LF$ + "130 PureBasic Road, BigTown, CodeCity")
  AddGadgetItem(#List1, -1, "Didi Foundit"   + #LF$ + "321 Logo Drive, Mouse House, Downtown")

 ListIconGadget(#List2, 10, 200, 380, 150, "Name", 110, #PB_ListIcon_GridLines)
AddGadgetColumn(#List2,  1, "Address", 260)
  AddGadgetItem(#List2, -1, "Harry Rannit"   + #LF$ + "12 Parliament Way, Battle Street, By the Bay")
  AddGadgetItem(#List2, -1, "Ginger Brokeit" + #LF$ + "130 PureBasic Road, BigTown, CodeCity")
  AddGadgetItem(#List2, -1, "Didi Foundit"   + #LF$ + "321 Logo Drive, Mouse House, Downtown")

   ButtonGadget(#BtnB, 100, 360, 100, 25, "Blue")
   ButtonGadget(#BtnR, 200, 360, 100, 25, "Red")


igDefListIconCallback = SetWindowLongPtr_(GadgetID(#List1), #GWL_WNDPROC, @CustomListIconCallback())
igDefListIconCallback = SetWindowLongPtr_(GadgetID(#List2), #GWL_WNDPROC, @CustomListIconCallback())

Repeat
         Select  WaitWindowEvent(1)

                 Case #PB_Event_CloseWindow: igExit = #True
                 Case #PB_Event_Gadget

                           Select EventGadget()

                                  Case #BtnB
                                              igHdTxtClr = RGB(0,0,200)
                                              ResizeGadget(#List1,#Ig,#Ig,#Ig,#Ig) ;"Refresh"
                                              ResizeGadget(#List2,#Ig,#Ig,#Ig,#Ig)

                                  Case #BtnR
                                              igHdTxtClr = RGB(200,0,0)
                                              ResizeGadget(#List1,#Ig,#Ig,#Ig,#Ig)
                                              ResizeGadget(#List2,#Ig,#Ig,#Ig,#Ig)
                           EndSelect
         EndSelect

Until igExit = #True

End
[/size]

Edit: One of the reasons why this is a good method, apart from code simplicity, is that it's Tablet friendly. The window or the gadgets can be zoomed and WinOS maintains the quality of the text rendering.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Re: ListIcon Column Header Text Colour

Post by firace »

Is it possible to set the header color only for a specific column ?
User avatar
Shardik
Addict
Addict
Posts: 1989
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: ListIcon Column Header Text Colour

Post by Shardik »

firace wrote:Is it possible to set the header color only for a specific column ?

Code: Select all

EnableExplicit

#ColoredColumn = 1
#HeaderTextColor = #Blue
#LVM_GETHEADER = #LVM_FIRST + 31

Define DefaultListIconCallback.I

Procedure CustomListIconCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
  Shared DefaultListIconCallback.I

  Protected *NMCUSTOMDRAW.NMCUSTOMDRAW
  Protected *NMHDR.NMHDR
  Protected Result.I

  Result = CallWindowProc_(DefaultListIconCallback, WindowHandle.I, Msg.I,
    WParam.I, LParam.I)

  If Msg = #WM_NOTIFY
    *NMHDR = LParam

    If *NMHDR\code = #NM_CUSTOMDRAW
      *NMCUSTOMDRAW = LParam
      Select *NMCUSTOMDRAW\dwDrawStage
        Case #CDDS_PREPAINT
          Result = #CDRF_NOTIFYITEMDRAW
        Case #CDDS_ITEMPREPAINT
          If *NMCUSTOMDRAW\dwItemSpec = #ColoredColumn
            SetTextColor_(*NMCUSTOMDRAW\hdc, #HeaderTextColor)
          EndIf
      EndSelect
    EndIf
  EndIf

  ProcedureReturn Result
EndProcedure

OpenWindow(0, 200, 100, 400, 100, "ListIconGadget with colored header text")
ListIconGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20,
  "Name", 110, #PB_ListIcon_GridLines)
AddGadgetColumn(0, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0, 0,
  #PB_ListIcon_ColumnWidth) - 4)
AddGadgetItem(0, -1, "Harry Rannit" + #LF$ +
  "12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit" + #LF$ +
  "130 PureBasic Road, BigTown, CodeCity")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ +
  "321 Logo Drive, Mouse House, Downtown")

DefaultListIconCallback = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC,
  @CustomListIconCallback())

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Re: ListIcon Column Header Text Colour

Post by firace »

Excellent! Thanks Shardik.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: ListIcon Column Header Text Colour

Post by Kwai chang caine »

Works very well
Thanks at you two for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: ListIcon Column Header Text Colour

Post by Fangbeast »

Shardik, can you set the header background colour as well or is that more complicated?
Amateur Radio, D-STAR/VK3HAF
User avatar
Shardik
Addict
Addict
Posts: 1989
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: ListIcon Column Header Text Colour

Post by Shardik »

Fangbeast wrote:Shardik, can you set the header background colour as well or is that more complicated?
It's indeed more complicated. To change the header's text color I stripped down a lot of unnessary stuff from old header coloring examples in order to present an easy and short example that works with modern theme support.

Have you alread tried the old header backcolor example you have asked for in this forum in 2006? Sparkie had given you this example.

You may also try out these examples:
- srod
- srod
- srod
- srod
- RASHAD (with gradient)

All examples still work on Windows 10 x64!
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: ListIcon Column Header Text Colour

Post by Fangbeast »

Good heavens, how on earth did I miss your reply????

AAARRRGHGHGHGH. I actually need this as the windows 10 updates constantly kill things.

Even SetGadgetItemColor doesn't work in my full program properly, only the simpler example from the manual.
Have to test if some api in my code that deals with the gadget is trashing it.
Amateur Radio, D-STAR/VK3HAF
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: ListIcon Column Header Text Colour

Post by Fangbeast »

I know this is an old post but is there any way to combine Shardik's post with my callback below with disturbing my needed stuff?

Only the first bit deals with the window, the rest is all the ListIconGadget stuff.

Code: Select all

; Screen snapping, editor gadget popup menu, strikethrough font in ListIcon, alternate row colour banding

Procedure MainWindowCallback(hWnd, uMsg, wParam, lParam)
  Result = #PB_ProcessPureBasicEvents
  ; Netmaestro's windowsnap code
  Static Snapped1.i, Snapped2.i, Snapped3.i, Snapped4.i
  Select uMsg
      ;     ; Popup menu for editor gadget
      ;     Case #WM_CONTEXTMENU
      ;       If IsGadget(#Gadget_MyFamily_Information)
      ;         If GadgetID (#Gadget_MyFamily_Information) = wParam
      ;           DisplayPopupMenu(#PopMenubar_Details, WindowID(#Window_MyFamily))
      ;         EndIf
      ;       EndIf
      ; Netmaestro's windowsnap code
    Case #WM_MOVING
      If Track\Number("screen snap") = #True
        *view.RECT = lparam
        curwidth  = *view\right - *view\left
        curheight = *view\bottom - *view\top
        If AutoSnap                                                                         ; AutoSnap Section
          If *view\left < SnapD
            If Not Snapped1
              *view\left = 0
              *view\right = curwidth
              snapped1 = #True
              ReturnValue = #True
            EndIf
          Else
            snapped1 = #False
          EndIf
          If *view\top < SnapD
            If Not Snapped2
              *view\top = 0
              *view\bottom = curheight
              snapped2 = #True
              ReturnValue = #True
            EndIf
          Else
            snapped2 = #False
          EndIf
          If *view\right > screenw - SnapD
            If Not Snapped3
              *view\left  = ScreenW - curwidth
              *view\right = screenW
              snapped3 = #True
              ReturnValue = #True
            EndIf
          Else
            snapped3 = #False
          EndIf     
          If *view\bottom > screenH - SnapD
            If Not Snapped4
              *view\top = screenH - curheight
              *view\bottom = screenH
              snapped4 = #True
              ReturnValue = #True
            EndIf
          Else
            snapped4 = #False
          EndIf     
        EndIf
        If *view\top < 0                                                                    ;  Inside Desktop Section
          *view\top = 0
          *view\bottom = curheight
        EndIf
        If *view\left < 0 
          *view\left = 0
          *view\right = curwidth
        EndIf
        If *view\right > screenW
          *view\right = screenW
          *view\left = *view\right - curwidth
        EndIf
        If *view\bottom > screenH
          *view\bottom = screenH
          *view\top = *view\bottom - curheight
        EndIf
        MoveWindow_(WindowID, *view\left, *view\top, *view\right - *view\left, *view\bottom - *view\top, #True)
        ReturnValue = #True
      EndIf
      ; Draw a line through an item to indicate its deleted state
    Case #WM_NOTIFY
      *nmhdr.NMHDR = lParam
      *lvCD.NMLVCUSTOMDRAW = lParam
      If IsGadget(#Gadget_Mooklogin_Loginlist)
        If *lvCD\nmcd\hdr\hwndFrom = GadgetID(#Gadget_Mooklogin_Loginlist) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
          Select *lvCD\nmcd\dwDrawStage
            Case #CDDS_PREPAINT
              result = #CDRF_NOTIFYITEMDRAW
            Case #CDDS_ITEMPREPAINT
              result = #CDRF_NOTIFYSUBITEMDRAW;
            Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM
              thisRow = *lvCD\nmcd\dwItemSpec
              thisCol = *lvCD\iSubItem
              on_off = GetGadgetItemData(#Gadget_Mooklogin_Loginlist, thisRow)
              ; If thisCol = 0 And on_off. Specifically for column 0. You can change this to any or just use on_off to set all columns
              If on_off
                SelectObject_(*lvCD\nmcd\hdc, FontID(Track\Number("font strikeout yes")))
                result = #CDRF_NEWFONT; | #CDRF_DODEFAULT
              Else
                SelectObject_(*lvCD\nmcd\hdc, FontID(Track\Number("font strikeout no")))
                result = #CDRF_NEWFONT   
              EndIf
              ; Proper colour banding in listicons
              If Track\Number("colour band") = #True  ;<-----------Add This Block (Paul Leischow)
                If (thisRow / 2) * 2 = thisRow
                  ;*lvCD\clrText   = $000000
                  ;*lvCD\clrTextBk = $D4D4D4
                  *lvCD\clrText   = $000000
                  *lvCD\clrTextBk = $EEEEEE
                Else
                  ;*lvCD\clrText   = $FFFFFF
                  ;*lvCD\clrTextBk = $C1C1C1
                  *lvCD\clrText   = $484848
                  *lvCD\clrTextBk = $DADADA
                EndIf
              EndIf
          EndSelect
        EndIf
      EndIf
  EndSelect ; uMsg
  ProcedureReturn Result
EndProcedure
Amateur Radio, D-STAR/VK3HAF
Post Reply