Module ListIconGadget Owner Draw

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Module ListIconGadget Owner Draw

Post by mk-soft »

Because of the request, I divorced this module.

Link: viewtopic.php?f=13&t=73284

Always use RemoveItem, ClearItems and DestroyGadget from the module. Otherwise there will be a memory leak.

Update v1.1.0
- Added DestroyGadget(...)

Update v1.2.0
- Optimizes the column before and after the changed column

Update v1.2.1
- Bugfix font

Update v1.3.0
- Added optional parameter 'Format' to SetItemFont

Update v1.4.0
- Added Functions - AddColumn and RemoveColumn
- Change SetItemFont - TextColor and BackColor optional /#PB-Ignore
- Change Set Default Colors from Windows GetSysColor(...)

Code: Select all

;- TOP

; Comment : Modul ListIconGadget Owner Draw
; Author  : mk-soft
; Version : v1.4.0
; Create  : 31.07.2019
; Update  : 02.08.2019
; OS      : Windows
; Link    : https://www.purebasic.fr/english/viewtopic.php?f=12&t=73305

; Procedure for SetWindowCallback 
;
;   Procedure MyWindowCallback(hWnd, uMsg, wParam, lParam)
;     Protected Result = #PB_ProcessPureBasicEvents
;     Select uMsg
;       Case #WM_NOTIFY
;         If LV::NotifyCB(lParam)
;           result = #CDRF_SKIPDEFAULT
;         EndIf
;     EndSelect ; uMsg
;     ProcedureReturn Result
;   EndProcedure
  
;- Begin Of Module

DeclareModule LV
  
  Declare NotifyCB(*lvCD.NMLVCUSTOMDRAW)
  Declare AddGadget(Gadget)
  Declare RemoveGadget(Gadget)
  Declare DestroyGadget(Gadget)
  Declare SetGridLines(Gadget, State)
  Declare SetSelectionColor(Gadget, TextColor, BackColor)
  Declare SetItemFont(Gadget, Item, Font = #PB_Ignore, TextColor = #PB_Ignore, BackColor = #PB_Ignore, Column = 0, Format = #PB_Ignore)
  Declare RemoveItem(Gadget, Item)
  Declare ClearItems(Gadget)
  Declare AddColumn(Gadget, Column, Title.s, Width)
  Declare RemoveColumn(Gadget, Column)
  Declare SetData(Gadget, Item, Value)
  Declare GetData(Gadget, Item)
  
EndDeclareModule

Module LV
  
  EnableExplicit
  
  ;-- Structures
  
  Structure udtGadgetData
    Gadget.i
    Handle.i
    GridLines.i
    SelectedTextColor.i
    SelectedBackColor.i
  EndStructure
  
  Structure udtColumnData
    FontID.i
    Format.i
    TextColor.i
    BackColor.i
  EndStructure
  
  Structure udtItemData
    Ident.i
    UserData.i
    Array Column.udtColumnData(0)
  EndStructure
  
  
  ;-- Variables
  
  Global NewMap GadgetData.udtGadgetData()
  
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
      ;{
      ;-- Private Procedures
      
      Procedure DrawItem(*Gadget.udtGadgetData, *ItemData.udtItemData, *lvCD.NMLVCUSTOMDRAW)
        Protected thisRow, thisCol, thisText.s, hBrush, TextColor, BackColor, rc.RECT
        
        If *ItemData
          If *ItemData\Ident <> $AA2019EE
            ProcedureReturn 0
          EndIf
          With *ItemData
            thisRow = *lvCD\nmcd\dwItemSpec
            thisCol = *lvCD\iSubItem
            ; Get text from ListIcon
            thisText = GetGadgetItemText(0, thisRow ,thisCol)
            ; Limit thisCol to the available column data
            If thisCol > ArraySize(\Column())
              thisCol = ArraySize(\Column())
            EndIf
            ; Draw Background
            If *lvCD\nmcd\uItemState & #CDIS_SELECTED
              TextColor = *Gadget\SelectedTextColor
              BackColor = *Gadget\SelectedBackColor
            Else
              TextColor = \Column(thisCol)\TextColor
              BackColor = \Column(thisCol)\BackColor
            EndIf  
            hBrush = CreateSolidBrush_(BackColor)
            If *Gadget\GridLines
              FrameRect_(*lvCD\nmcd\hdc, *lvCD\nmcd\rc, GetSysColorBrush_(#COLOR_WINDOWFRAME))
              *lvCD\nmcd\rc\bottom - 1
              *lvCD\nmcd\rc\right - 1
            EndIf
            FillRect_(*lvCD\nmcd\hdc, *lvCD\nmcd\rc, hBrush)
            ; Use Font
            SelectObject_(*lvCD\nmcd\hdc, \Column(thisCol)\FontID)
            ; Write Text
            SetBkMode_(*lvCD\nmcd\hdc,#TRANSPARENT)
            SetTextColor_(*lvCD\nmcd\hdc, TextColor)
            *lvCD\nmcd\rc\left + 2
            *lvCD\nmcd\rc\right - 2
            DrawText_(*lvCD\nmcd\hdc, @thisText, Len(thisText), *lvCD\nmcd\rc, \Column(thisCol)\Format)
            ; Free resourcees
            DeleteObject_(hBrush)
          EndWith
        EndIf
      EndProcedure
      
      ;-- Public Procedures
      
      Procedure NotifyCB(*lvCD.NMLVCUSTOMDRAW)
        Protected *ItemData.udtItemData
        
        If *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
          Select *lvCD\nmcd\dwDrawStage
            Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM
              If FindMapElement(GadgetData(), Hex(*lvCD\nmcd\hdr\hwndFrom))
                *ItemData = GetGadgetItemData(GadgetData()\Gadget, *lvCD\nmcd\dwItemSpec)
                ;*ItemData = PeekI(*lvCD\nmcd\lItemlParam) ; PB-Internal Hack
                If *ItemData
                  DrawItem(GadgetData(), *ItemData,*lvCD)
                  ProcedureReturn #True
                Else
                  ProcedureReturn #False   
                EndIf
              EndIf
          EndSelect
        EndIf
        
      EndProcedure
      
      ; ----
      
      Procedure AddGadget(Gadget)
        Protected handle, key.s
        If IsGadget(Gadget)
          handle = GadgetID(Gadget)
          key = Hex(handle)
          If Not FindMapElement(GadgetData(), key)
            If AddMapElement(GadgetData(), key)
              With GadgetData()
                \Gadget = Gadget
                \Handle = handle
                \GridLines = #False
                \SelectedTextColor = GetSysColor_(#COLOR_HIGHLIGHTTEXT) ; #Black
                \SelectedBackColor = GetSysColor_(#COLOR_HIGHLIGHT) ; $FF901E
              EndWith
            EndIf
          EndIf
        EndIf  
      EndProcedure
      
      ; ----
      
      Procedure RemoveGadget(Gadget)
        Protected handle, key.s, count, index, *ItemData.udtItemData
        If IsGadget(Gadget)
          handle = GadgetID(Gadget)
          key = Hex(handle)
          If FindMapElement(GadgetData(), key)
            With GadgetData()
              count = CountGadgetItems(Gadget) - 1
              For index = 0 To count
                *ItemData = GetGadgetItemData(\Gadget, Index)
                If *ItemData And *ItemData\Ident = $AA2019EE
                  SetGadgetItemData(\Gadget, Index, 0)
                  FreeStructure(*ItemData)
                EndIf
              Next
            EndWith
            DeleteMapElement(GadgetData())
          EndIf
        EndIf
      EndProcedure
      
      ; ----
      
      Procedure DestroyGadget(Gadget)
        Protected handle, key.s, count, index, *ItemData.udtItemData
        If IsGadget(Gadget)
          handle = GadgetID(Gadget)
          key = Hex(handle)
          If FindMapElement(GadgetData(), key)
            With GadgetData()
              count = CountGadgetItems(Gadget) - 1
              For index = 0 To count
                *ItemData = GetGadgetItemData(\Gadget, Index)
                If *ItemData And *ItemData\Ident = $AA2019EE
                  SetGadgetItemData(\Gadget, Index, 0)
                  FreeStructure(*ItemData)
                EndIf
              Next
            EndWith
            DeleteMapElement(GadgetData())
          EndIf
          FreeGadget(Gadget)
        EndIf
      EndProcedure
      
      ; ----
      
      Procedure SetGridLines(Gadget, State)
        If IsGadget(Gadget)
          If FindMapElement(GadgetData(), Hex(GadgetID(Gadget)))
            GadgetData()\GridLines = State
          EndIf
        EndIf
      EndProcedure
      
      ; ----
      
      Procedure SetSelectionColor(Gadget, TextColor, BackColor)
        If IsGadget(Gadget)
          If FindMapElement(GadgetData(), Hex(GadgetID(Gadget)))
            GadgetData()\SelectedTextColor = TextColor
            GadgetData()\SelectedBackColor = BackColor
          EndIf
        EndIf
      EndProcedure
      
      ; ----
      
      Procedure SetItemFont(Gadget, Item, Font = #PB_Ignore, TextColor = #PB_Ignore, BackColor = #PB_Ignore, Column = 0, Format = #PB_Ignore)
        Protected *ItemData.udtItemData, index, col, count
        With *ItemData
          *ItemData = GetGadgetItemData(Gadget, Item)
          If *ItemData = 0
            *ItemData = AllocateStructure(udtItemData)
            \Ident = $AA2019EE
            \Column(0)\FontID = SendMessage_(GadgetID(Gadget), #WM_GETFONT, 0, 0)
            \Column(0)\Format = #DT_LEFT|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS
            \Column(0)\TextColor = GetSysColor_(#COLOR_WINDOWTEXT)
            \Column(0)\BackColor = GetSysColor_(#COLOR_WINDOW)
            SetGadgetItemData(Gadget, Item, *ItemData)
          EndIf
          count = ArraySize(\Column())
          If Column > count
            ReDim \Column(Column+1)
            For col = count + 1 To Column + 1
              CopyStructure(\Column(col-1), \Column(col), udtColumnData)
            Next
          EndIf
          If Font <> #PB_Ignore
            \Column(Column)\FontID = FontID(Font)
          EndIf
          If Format <> #PB_Ignore
            \Column(Column)\Format = Format
          EndIf
          If TextColor <> #PB_Ignore
            \Column(Column)\TextColor = TextColor
          EndIf
          If BackColor <> #PB_Ignore
            \Column(Column)\BackColor = BackColor
          EndIf
        EndWith
      EndProcedure
      
      ; ----
      
      Procedure RemoveItem(Gadget, Item)
        Protected *ItemData.udtItemData, index, count
        *ItemData = GetGadgetItemData(Gadget, Item)
        If *ItemData And *ItemData\Ident = $AA2019EE
          FreeStructure(*ItemData)
        EndIf
        RemoveGadgetItem(Gadget, Item)
      EndProcedure
      
      ; ----
      
      Procedure ClearItems(Gadget)
        Protected *ItemData.udtItemData, index, count
        count = CountGadgetItems(Gadget) - 1
        For index = 0 To count
          *ItemData = GetGadgetItemData(Gadget, Index)
          If *ItemData And *ItemData\Ident = $AA2019EE
            FreeStructure(*ItemData)
          EndIf
        Next
        ClearGadgetItems(Gadget)
      EndProcedure
      
      ; ----
      
      Procedure AddColumn(Gadget, Column, Title.s, Width)
        Protected *ItemData.udtItemData, index, item, item_count, col, count
        AddGadgetColumn(Gadget, Column, Title, Width)
        With *ItemData
          item_count = CountGadgetItems(Gadget) - 1
          For item = 0 To item_count
            *ItemData = GetGadgetItemData(Gadget, Item)
            If *ItemData
              count = ArraySize(\Column())
              If count > 0
                If Column < count
                  count + 1
                  ReDim \Column(count)
                  For col =  count To Column + 1 Step -1
                    CopyStructure(\Column(col-1), \Column(col), udtColumnData)
                  Next
                EndIf
              EndIf
            EndIf
          Next
        EndWith
      EndProcedure
      
      ; ----
          
      Procedure RemoveColumn(Gadget, Column)
        Protected *ItemData.udtItemData, index, item, item_count, col, count
        RemoveGadgetColumn(Gadget, Column)
        With *ItemData
          item_count = CountGadgetItems(Gadget) - 1
          For item = 0 To item_count
            *ItemData = GetGadgetItemData(Gadget, Item)
            If *ItemData
              count = ArraySize(\Column())
              If count > 0
                If Column < count
                  For col =  Column To count - 1
                    CopyStructure(\Column(col+1), \Column(col), udtColumnData)
                  Next
                  count - 1
                  ReDim \Column(count)
                EndIf
              EndIf
            EndIf
          Next
        EndWith
      EndProcedure
      
      ; ----
          
      Procedure SetData(Gadget, Item, Value)
        Protected *ItemData.udtItemData
        With *ItemData
          *ItemData = GetGadgetItemData(Gadget, Item)
          If *ItemData = 0
            *ItemData = AllocateStructure(udtItemData)
            \Ident = $AA2019EE
            \Column(0)\FontID = SendMessage_(GadgetID(Gadget), #WM_GETFONT, 0, 0)
            \Column(0)\Format = #DT_LEFT|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS
            \Column(0)\TextColor = GetSysColor_(#COLOR_WINDOWTEXT)
            \Column(0)\BackColor = GetSysColor_(#COLOR_WINDOW)
            SetGadgetItemData(Gadget, Item, *ItemData)
          EndIf
          *ItemData\UserData = Value
        EndWith
      EndProcedure
      
      ; ----
      
      Procedure GetData(Gadget, Item)
        Protected *ItemData.udtItemData
        *ItemData = GetGadgetItemData(Gadget, Item)
        If *ItemData
          ProcedureReturn *ItemData\UserData
        Else
          ProcedureReturn 0
        EndIf
      EndProcedure
      
      ; ----
      
      ;}
    CompilerCase #PB_OS_MacOS
      ;{
      
      ;}
    CompilerCase #PB_OS_Linux
      ;{
      
      ;}
      
  CompilerEndSelect
  
  
  
EndModule

;- End of Module

; ****

CompilerIf #PB_Compiler_IsMainFile
  
  ;- Example
  
  Enumeration fonts
    #FontStrikeoutYes
    #FontStrikeoutNo
    #FontItalic
  EndEnumeration
  
  Define i
  
  LoadFont(#FontStrikeoutYes, "", 10, #PB_Font_StrikeOut)
  LoadFont(#FontStrikeoutNo, "", 10)
  LoadFont(#FontItalic, "", 10, #PB_Font_Italic | #PB_Font_Bold)
  
  Procedure MyWindowCallback(hWnd, uMsg, wParam, lParam)
    Protected Result = #PB_ProcessPureBasicEvents
    Select uMsg
      Case #WM_NOTIFY
        If LV::NotifyCB(lParam)
          result = #CDRF_SKIPDEFAULT
        EndIf
    EndSelect ; uMsg
    ProcedureReturn Result
  EndProcedure
  
  OpenWindow(0, 200, 100, 600, 200, "ListIconGadget Owner Draw")
  
  Define style = #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines
  ListIconGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20, "Column 0", 110, style)
  AddGadgetColumn(0, 1, "Column 1", 100)
  AddGadgetColumn(0, 2, "Column 2", 300)
  AddGadgetItem(0, -1, "No Strikeout" + #LF$ + "White/Gray" + #LF$ + "Set only Column 0 for all Columns")
  AddGadgetItem(0, -1, "Strikeout" + #LF$ + "Red/Yellow" + #LF$ + "Set only Column 0 for all Columns")
  AddGadgetItem(0, -1, "Set All" + #LF$ + "Set All" + #LF$ + "Set All")
  AddGadgetItem(0, -1, "No Font" + #LF$ + "Back Color" + #LF$ + "Text and Back Color, Font Format")
  AddGadgetItem(0, -1, "Left" + #LF$ + "Center" + #LF$ + "Right")
  AddGadgetItem(0, -1, "No set" + #LF$ + "No set" + #LF$ + "No set")
  
  LV::AddGadget(0)
  LV::SetGridLines(0, #True)
  ;LV::SetSelectionColor(0, #Yellow, #Red)
  LV::SetItemFont(0, 0, #FontStrikeoutNo, #White, #Gray)
  LV::SetItemFont(0, 1, #FontStrikeoutYes, #Red, #Yellow)
  LV::SetItemFont(0, 2, #FontItalic, #Green, #Black)
  LV::SetItemFont(0, 2, #FontStrikeoutYes, #Black, #Green, 1)
  
  LV::SetItemFont(0, 3, #PB_Ignore, #PB_Ignore, #Gray, 1)
  LV::SetItemFont(0, 3, #PB_Ignore, #Yellow, #Red, 2, #DT_CENTER|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS)
  
  LV::SetItemFont(0, 4, #PB_Ignore, #Black, #Green, 0, #DT_LEFT|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS)
  LV::SetItemFont(0, 4, #PB_Ignore, #Black, #Green, 1, #DT_CENTER|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS)
  LV::SetItemFont(0, 4, #PB_Ignore, #Black, #Green, 2, #DT_RIGHT|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS)
  
  lv::AddColumn(0, 1, "Ins", 30)
  lv::AddColumn(0, 3, "Ins", 30)
  
  SetWindowCallback(@MyWindowCallback())
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Break
        
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            If EventType() = #PB_EventType_LeftDoubleClick
              i = GetGadgetState(0)
              If i >= 0
                ;LV::RemoveItem(0, i)
                lv::RemoveColumn(0, 1)
              EndIf
            EndIf
        EndSelect
    EndSelect
  ForEver
  
  LV::DestroyGadget(0)
  
CompilerEndIf
Last edited by mk-soft on Fri Aug 02, 2019 3:00 pm, edited 8 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module ListIconGadget Owner Draw

Post by Kwai chang caine »

Thanks MkSoft 8)
Here, only the "Didi Foundit 2" and "Didi Foundit 3" appears :shock:
W10 X64 / V5.70 X86
ImageThe happiness is a road...
Not a destination
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Module ListIconGadget Owner Draw

Post by RSBasic »

Thanks for sharing.
Image
Image
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ListIconGadget Owner Draw

Post by mk-soft »

Kwai chang caine wrote:Thanks MkSoft 8)
Here, only the "Didi Foundit 2" and "Didi Foundit 3" appears :shock:
W10 X64 / V5.70 X86
Work fine here...
Window 10 Pro (1703) PB v5.70 x86 and x64
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ListIconGadget Owner Draw

Post by mk-soft »

Update v1.2.0
- Optimizes the column before and after the changed column

Update v1.2.1
- Bugfix font

Update v1.3.0
- Added optional parameter 'Format' to SetItemFont
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ListIconGadget Owner Draw

Post by mk-soft »

Update v1.4.0
- Added Functions - AddColumn and RemoveColumn
- Change SetItemFont - TextColor and BackColor optional /#PB-Ignore
- Change Set Default Colors from Windows GetSysColor(...)

I think is last change... :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Module ListIconGadget Owner Draw

Post by Kwai chang caine »

Work fine here...
Window 10 Pro (1703) PB v5.70 x86 and x64
Always the same problem, but i have found why :wink:
I have often the same problem with several RASHAD's codes
I never activate XP theme, apparently i'm forced to enable it for yur code works ?
ImageThe happiness is a road...
Not a destination
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ListIconGadget Owner Draw

Post by mk-soft »

Without XP-Theme it is also no longer up to date.

If you don't want it yourself, you can also choose the Window Classic style under Customize Desktop.
So everybody can decide for himself how the interface looks like.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
dcr3
Enthusiast
Enthusiast
Posts: 165
Joined: Fri Aug 04, 2017 11:03 pm

Re: Module ListIconGadget Owner Draw

Post by dcr3 »

Because of the request, I divorced this module.

Link: viewtopic.php?f=13&t=73284
You made the right decision. :lol: :lol:
Post Reply