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