PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Module ListIconGadget Owner Draw

https://www.purebasic.fr/english/viewtopic.php?t=73305

Page 1 of 1

Module ListIconGadget Owner Draw

Posted: Wed Jul 31, 2019 8:25 pm
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

Re: Module ListIconGadget Owner Draw

Posted: Thu Aug 01, 2019 8:10 am
by Kwai chang caine
Thanks MkSoft 8)
Here, only the "Didi Foundit 2" and "Didi Foundit 3" appears :shock:
W10 X64 / V5.70 X86

Re: Module ListIconGadget Owner Draw

Posted: Thu Aug 01, 2019 8:19 am
by RSBasic
Thanks for sharing.

Re: Module ListIconGadget Owner Draw

Posted: Thu Aug 01, 2019 9:11 am
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

Re: Module ListIconGadget Owner Draw

Posted: Thu Aug 01, 2019 10:27 am
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

Re: Module ListIconGadget Owner Draw

Posted: Fri Aug 02, 2019 2:57 pm
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:

Re: Module ListIconGadget Owner Draw

Posted: Sat Aug 03, 2019 3:17 pm
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 ?

Re: Module ListIconGadget Owner Draw

Posted: Sat Aug 03, 2019 6:42 pm
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.

Re: Module ListIconGadget Owner Draw

Posted: Sat Aug 03, 2019 11:13 pm
by dcr3
Because of the request, I divorced this module.

Link: viewtopic.php?f=13&t=73284
You made the right decision. :lol: :lol:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited