Die wichtigsten Funktionen:
--- nur Windows ---
- Kopfzeile und Spalten ausrichten (Links/Rechts/Zentriert)
- automatische Spaltenbreite
- Zeichensatz ändern
- Spalten zählen
- Sortieren bei Klick auf Spaltenkopf (incl Sortierrichtungswechsel)
- Einträge bearbeiten nach Doppelklick
--- plattformübergreifend ---
- Zeilen sortieren nach deutschen Regeln (DIN 5007)
- Mehrfachsortierung mit max. 3 Spalten (z.B. Geschlecht, Nachname, Vorname)
- benutzerdefinierter Sortierschlüssel anstatt Listenspalte möglich (Standard und/oder für jede Spalte)
Neue Befehle:
CountListColumns(GadgetID.i)
DefineListCallback(GadgetID.i, Flags.l=#False) ; Sort after HeaderClick / Edit Cells
ResetHeaderSort(GadgetID.i) ; Remove sort arrows from header
JustifyColumn(GadgetID.i, Column.i, Flag.l=#Center)
AutoWidthColumns(GadgetID.i)
SetFont(GadgetID.i, HeaderFont.i, ListFont.i=#False)
SetListItemColumnWidth(GadgetID.i, Position.i, Value.i, Column.i=0)
GetListItemColumnWidth(GadgetID.i, Position.i, Column.i=0)
DefineSort(GadgetID.i, Norm.l) ; Define German Sort Norm
SetColumnFlag(GadgetID.i, Column.i, Flags.l)
AddUserSort(GadgetID.i, Column.i, UserSort.s)
ChangeUserSortColumn(GadgetID.i, Position.i, Column.i, UserSort.s)
ChangeUserSortDefault(GadgetID.i, Position.i, UserSort.s="")
SortListItems(GadgetID.i, SortCol.i, Flags.l=#False)
MultiSortListItems(GadgetID.i, SortCol1.i, SortCol2.i, SortCol3.i=#PB_Ignore, Flags.l=#False)
RemoveSortData(GadgetID.i)
Ersetzte Befehle: (Gadget -> List)
AddListItem(GadgetID.i, Position.i, Text.s, UserSort.s="", ImageID.i=#False)
SetListItemData(GadgetID.i, Position.i, Value.i)
SetListItemImage(GadgetID.i, Position.i, ImageID.i)
SetListItemText(GadgetID.i, Position.i, Text.s , Column.i)
SetListItemColor(GadgetID.i, Position.i, ColorTyp.i, Color.i, Column.i=0)
GetListItemColor(GadgetID.i, Position.i, ColorTyp.i, Column.i=0)
SetListColor(GadgetID.i, ColorTyp.i, Color.i)
GetListColor(GadgetID.i, ColorTyp.i)
RemoveListItem(GadgetID.i, Position.i)
ClearListItems(GadgetID.i)
AddListColumn(GadgetID.i, Column.i, Titel.s, Width.i)
RemoveListColumn(GadgetID.i, Column.i)
ListIconModule.pbi
Code: Alles auswählen
;/ === ListIconModule.pbi === [ PureBasic V5.6x ]
;/
;/ September 2017 by Thorsten1867
;/ Sort on header click - based on the code of RSBasic
;/ Edit ListIcon items - based on LvEditMini of hjbremer
; ===== Replaced Commands ==================
; AddGadgetItem() -> AddListItem()
; RemoveGadgetItem() -> RemoveListItem()
; ClearGadgetItems() -> ClearListItems()
; SetGadgetItemData() -> SetListItemData()
; SetGadgetItemImage() -> SetListItemImage()
; SetGadgetItemText() -> SetListItemText()
; AddGadgetColumn() -> AddListColumn()
; RemoveGadgetColumn() -> RemoveListColumn()
; SetGadgetColor() -> SetListColor()
; GetGadgetColor() -> GetListColor()
; SetGadgetItemColor() -> SetListItemColor()
; GetGadgetItemColor() -> GetListItemColor()
; ===== New Commands =======================
; JustifyColumn(GadgetID.i, Column.i, Flag.l=#Center) -> Flag: #Left / #Right / #Center
; AutoWidthColumns(GadgetID.i)
; CountListColumns(GadgetID.i)
; SetFont(GadgetID.i, HeaderFont.i, ListFont.i=#False)
; SetListItemColumnWidth(GadgetID.i, Position.i, Value.i, Column.i=0)
; GetListItemColumnWidth(GadgetID.i, Position.i, Column.i=0)
; ===== Sort Commands ======================
; DefineListCallback(GadgetID.i, Flags.l=#False) -> Sort after HeaderClick / Edit Cells
; ResetHeaderSort(GadgetID.i) -> Remove sort arrows from header
; SetColumnFlag(GadgetID.i, Column.i, Flags.l) -> Flags: #String / #Float / #Integer / #NoSort / #NoEdit / #UserSort / #NoResize / #Hide
; DefineSort(GadgetID.i, Norm.l) -> German sort: #Standard / #Lexikon (ä => ae) / #Namen (ä => a)
; AddUserSort(GadgetID.i, Column.i, UserSort.s) -> User text for sort ("Peter Muster" => "MuPe")
; SortListItems(GadgetID.i, SortCol.i, Flags.l=#False) -> Flags: #UserSort / #Descending / #Ascending / #CaseSensitive / #CaseInSensitive
; MultiSortListItems(GadgetID.i, SortCol1.i, SortCol2.i, SortCol3.i=#PB_Ignore, Flags.l=#False)
; RemoveSortData(GadgetID.i)
; ==========================================
DeclareModule ListIcon
Enumeration 1
#Left
#Right
#Center
#Namen = 0
#Lexikon = 1
#Standard = 2
EndEnumeration
Enumeration 1
#Default = -1
#UserSort = 1
#CaseSensitive = 1 << 1
#CaseInSensitive = 1 << 2
#Ascending = 1 << 3
#Descending = 1 << 4
#NoSort = 1 << 5
#NoEdit = 1 << 6
#String = 1 << 7
#Integer = 1 << 8
#Float = 1 << 9
#Edit = 1 << 10
#NoResize = 1 << 11
#Hide = 1 << 12
EndEnumeration
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
Declare CountColumns(GadgetID.i)
CompilerIf #PB_Compiler_Version >= 560
Declare CountListColumns(GadgetID.i)
CompilerEndIf
Declare DefineListCallback(GadgetID.i, Flags.l=#False) ; Sort after HeaderClick / Edit Cells
Declare ResetHeaderSort(GadgetID.i) ; Remove sort arrows from header
Declare JustifyColumn(GadgetID.i, Column.i, Flag.l=#Center)
Declare AutoWidthColumns(GadgetID.i)
Declare SetFont(GadgetID.i, HeaderFont.i, ListFont.i=#False)
CompilerCase #PB_OS_Linux
CompilerIf #PB_Compiler_Version >= 560
Declare CountColumns(GadgetID.i)
CompilerEndIf
Declare JustifyColumn(GadgetID.i, Column.i, Flag.l=#Center)
CompilerCase #PB_OS_MacOS
; ???
CompilerEndSelect
Declare DefineSort(GadgetID.i, Norm.l) ; Define German Sort Norm
Declare SetColumnFlag(GadgetID.i, Column.i, Flags.l)
Declare.i AddListItem(GadgetID.i, Position.i, Text.s, UserSort.s="", ImageID.i=#False) ; UserSort.s <- #Default
Declare SetListItemData(GadgetID.i, Position.i, Value.i)
Declare.i GetListItemData(GadgetID.i, Position.i)
Declare SetListItemImage(GadgetID.i, Position.i, ImageID.i)
Declare AddUserSort(GadgetID.i, Column.i, UserSort.s) ; Use it only after AddListItem() !
Declare ChangeUserSortColumn(GadgetID.i, Position.i, Column.i, UserSort.s)
Declare ChangeUserSortDefault(GadgetID.i, Position.i, UserSort.s="")
Declare SetListColor(GadgetID.i, ColorTyp.i, Color.i)
Declare.i GetListColor(GadgetID.i, ColorTyp.i)
Declare SetListItemText(GadgetID.i, Position.i, Text.s , Column.i)
Declare SetListItemColor(GadgetID.i, Position.i, ColorTyp.i, Color.i, Column.i=0)
Declare.i GetListItemColor(GadgetID.i, Position.i, ColorTyp.i, Column.i=0)
Declare RemoveListItem(GadgetID.i, Position.i)
Declare ClearListItems(GadgetID.i) ; Don't use ClearGadgetItems() !
Declare AddListColumn(GadgetID.i, Column.i, Titel.s, Width.i, ReFill.l=#True)
Declare RemoveListColumn(GadgetID.i, Column.i)
Declare SetListItemColumnWidth(GadgetID.i, Position.i, Value.i, Column.i=0)
Declare.i GetListItemColumnWidth(GadgetID.i, Position.i, Column.i=0)
Declare SortListItems(GadgetID.i, SortCol.i, Flags.l=#False)
Declare MultiSortListItems(GadgetID.i, SortCol1.i, SortCol2.i, SortCol3.i=#PB_Ignore, Flags.l=#False)
Declare RemoveSortData(GadgetID.i)
EndDeclareModule
Module ListIcon
EnableExplicit
Structure ColorStructure
Front.i
Back.i
changedFront.l
changedBack.l
EndStructure
Structure ListItemStructure
Position.i
ImageID.i
ItemData.i
Checked.l
Text.s
Sort.s
SortInteger.i
SortFloat.f
Map Color.ColorStructure()
Map UserSort.s()
EndStructure
Structure ListIconStructure
Flags.l
SortNorm.i
UserSort.i
Map Column.i()
List Item.ListItemStructure()
EndStructure
Global NewMap ListIcon.ListIconStructure()
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
Structure ListEditStructure
*CallBack ; ListIcon Callback
*StrgCallBack ; String Callback
GadgetID.i ; ListIconGadget ID
StrgID.i ; Stringgadget ID
HeaderHnd.i ; Header Id
Row.i ; List Row (Position)
Column.i ; List Column
CellText.s
SortDirection.i
EditFlag.i ; EditMode = 1
StructureUnion
lParam.i ; lParam from Callback
points.points ; lParam => x + y
EndStructureUnion
EndStructure
Procedure ResetHeaderSort(GadgetID.i)
Protected *ListEdit.ListEditStructure = GetWindowLongPtr_(GadgetID(GadgetID), #GWL_USERDATA)
Protected i.i, HDItem.HD_ITEM, ColsCount.i = SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEMCOUNT, 0, 0)
HDItem\mask = #HDI_FORMAT
For i = 0 To ColsCount - 1
SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEM, i, HDItem)
HDItem\fmt & ~ (#HDF_SORTDOWN | #HDF_SORTUP)
SendMessage_(*ListEdit\HeaderHnd, #HDM_SETITEM, i, HDItem)
Next
EndProcedure
Procedure StopListEdit(*ListEdit.ListEditStructure)
If IsGadget(*ListEdit\StrgID)
If *ListEdit\EditFlag
*ListEdit\EditFlag = #False
*ListEdit\CellText = GetGadgetText(*ListEdit\StrgID)
SetListItemText(*ListEdit\GadgetID, *ListEdit\Row, *ListEdit\CellText, *ListEdit\Column)
HideGadget(*ListEdit\StrgID, #True)
EndIf
EndIf
EndProcedure
Procedure.i ListIcon_CallBack(hWnd, Message, wParam, lParam)
Protected.i Column, x, y, width, height, i
Protected *ListEdit.ListEditStructure = GetWindowLongPtr_(hWnd, #GWL_USERDATA)
Protected *Header.HD_NOTIFY, *nm.NMHDR, *nmhdr.NMHEADER, MouseClick.LVHITTESTINFO, rect.rect
Protected HDItem.HD_ITEM, ColsCount.i = SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEMCOUNT, 0, 0)
Protected GID.s=Str(*ListEdit\GadgetID), SortDirection.l, Flags.l = ListIcon(GID)\Flags
Protected Result.i = CallWindowProc_(*ListEdit\CallBack, hWnd, Message, wParam, lParam)
Select Message
Case #WM_NOTIFY ;{ ListIcon
If Flags & #Edit ;{ Edit
*nm = lParam
If *nm\hWndFrom = *ListEdit\HeaderHnd
StopListEdit(*ListEdit)
EndIf
EndIf ;}
*nmhdr = lParam ;{ Column NoResize/Hide
If *nmhdr\hdr\code = #HDN_ITEMCHANGING
Column = *nmhdr\iItem
If ListIcon(GID)\Column(Str(Column)) & #NoResize Or Flags & #NoResize Or ListIcon(GID)\Column(Str(Column)) & #Hide
Result=#True
EndIf
EndIf ;}
*Header = lParam ;{ Header Click
If *Header\hdr\code=#HDN_ITEMCLICK
Column = *Header\iItem
If Not ListIcon(GID)\Column(Str(Column)) & #NoSort
HDItem\mask = #HDI_FORMAT
For i = 0 To ColsCount - 1
If i <> column
SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEM, i, HDItem)
HDItem\fmt & ~ (#HDF_SORTDOWN | #HDF_SORTUP)
SendMessage_(*ListEdit\HeaderHnd, #HDM_SETITEM, i, HDItem)
EndIf
Next
SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEM, Column, HDItem)
If HDItem\fmt & #HDF_SORTDOWN
HDItem\fmt & ~ #HDF_SORTDOWN
HDItem\fmt | #HDF_SORTUP
SortDirection = #Descending
Else
HDItem\fmt & ~ #HDF_SORTUP
HDItem\fmt | #HDF_SORTDOWN
SortDirection = #Ascending
EndIf
Flags & ~ (#Ascending|#Descending)
SendMessage_(*ListEdit\HeaderHnd, #HDM_SETITEM, Column, HDItem)
SortListItems(*ListEdit\GadgetID, Column, Flags|SortDirection)
EndIf
EndIf ;}
;}
Case #WM_MOUSEMOVE ;{ Mouse position
If *ListEdit\EditFlag = #False
*ListEdit\lParam = lParam
EndIf ;}
Case #WM_VSCROLL, #WM_HSCROLL, #WM_RBUTTONDOWN, #WM_LBUTTONDOWN ;{
StopListEdit(*ListEdit)
;}
Case #WM_LBUTTONDBLCLK ;{ Left mouse button
If Flags & #Edit
StopListEdit(*ListEdit)
MouseClick\pt\x = *ListEdit\points\x ; \points <- #WM_MOUSEMOVE
MouseClick\pt\y = *ListEdit\points\y
SendMessage_(hWnd, #LVM_SUBITEMHITTEST, 0, MouseClick)
*ListEdit\Row = MouseClick\iitem
*ListEdit\Column = MouseClick\iSubItem
If Not ListIcon(GID)\Column(Str(MouseClick\iSubItem)) & #NoEdit
rect\top = *ListEdit\Column
rect\left = #LVIR_LABEL
SendMessage_(hWnd, #LVM_GETSUBITEMRECT, *ListEdit\Row, rect)
*ListEdit\CellText = GetGadgetItemText(*ListEdit\GadgetID, *ListEdit\Row, *ListEdit\Column)
x = rect\left + 1
y = rect\top + 0
width = rect\right - rect\left - 1
height = rect\bottom - rect\top - 0
If width > 32767 : width = 32767 : EndIf
ResizeGadget(*ListEdit\StrgID, x, y, width, height)
SetGadgetText(*ListEdit\StrgID, *ListEdit\CellText)
HideGadget(*ListEdit\StrgID, 0)
SetActiveGadget(*ListEdit\StrgID)
*ListEdit\EditFlag = #True
EndIf
EndIf
;}
EndSelect
ProcedureReturn Result
EndProcedure
Procedure.i ListEdit_CallBack(hWnd, Message, wParam, lParam)
Protected *ListEdit.ListEditStructure = GetWindowLongPtr_(hWnd, #GWL_USERDATA)
Select Message
Case #WM_CHAR
Select wParam
Case #VK_RETURN
StopListEdit(*ListEdit)
Case #VK_ESCAPE
If *ListEdit\EditFlag
*ListEdit\EditFlag = #False
HideGadget(*ListEdit\StrgID, #True)
EndIf
EndSelect
Case #WM_KILLFOCUS
StopListEdit(*ListEdit)
EndSelect
ProcedureReturn CallWindowProc_(*ListEdit\StrgCallBack, hWnd, Message, wParam, lParam)
EndProcedure
Procedure DefineListCallback(GadgetID.i, Flags.l=#False)
Protected StrgID.i, GID.s = Str(GadgetID)
Protected *ListEdit.ListEditStructure = AllocateMemory(SizeOf(ListEditStructure))
ListIcon(GID)\Flags = Flags
SetWindowLongPtr_(GadgetID(GadgetID), #GWL_USERDATA, *ListEdit)
*ListEdit\CallBack = SetWindowLongPtr_(GadgetID(GadgetID), #GWL_WNDPROC, @ListIcon_CallBack())
*ListEdit\GadgetID = GadgetID
*ListEdit\HeaderHnd = SendMessage_(GadgetID(GadgetID), #LVM_GETHEADER, 0, 0)
If Flags & #Edit
StrgID = StringGadget(#PB_Any, 0, 0, 0, 0, "")
*ListEdit\StrgID = StrgID
SetGadgetFont(StrgID, GetGadgetFont(GadgetID))
HideGadget(StrgID, 1)
SetParent_(GadgetID(StrgID), GadgetID(GadgetID)) ; important !!!
SetWindowLongPtr_(GadgetID(StrgID), #GWL_USERDATA, *ListEdit)
*ListEdit\StrgCallBack = SetWindowLongPtr_(GadgetID(StrgID), #GWL_WNDPROC, @ListEdit_CallBack())
EndIf
EndProcedure
Procedure.i CountColumns(GadgetID.i)
CompilerIf #PB_Compiler_Version < 560
ProcedureReturn SendMessage_(SendMessage_(GadgetID(GadgetID),#LVM_GETHEADER,0,0), #HDM_GETITEMCOUNT,0,0)
CompilerElse
ProcedureReturn GetGadgetAttribute(GadgetID, #PB_ListIcon_ColumnCount)
CompilerEndIf
EndProcedure
CompilerIf #PB_Compiler_Version >= 560
Procedure.i CountListColumns(GadgetID.i)
ProcedureReturn GetGadgetAttribute(GadgetID, #PB_ListIcon_ColumnCount)
EndProcedure
CompilerEndIf
Procedure AutoWidthColumns(GadgetID.i)
Protected col.i, W1.i, W2.i, ColWidth.i, hHnd.i = GadgetID(GadgetID)
Protected ColsCount.i = SendMessage_(SendMessage_(hHnd,#LVM_GETHEADER,0,0),#HDM_GETITEMCOUNT,0,0)
For col = 0 To ColsCount-1
SendMessage_(hHnd, #LVM_SETCOLUMNWIDTH, col, #LVSCW_AUTOSIZE)
W1 = SendMessage_(hHnd, #LVM_GETCOLUMNWIDTH, col, 0)
SendMessage_(hHnd, #LVM_SETCOLUMNWIDTH, col, #LVSCW_AUTOSIZE_USEHEADER)
W2 = SendMessage_(hHnd, #LVM_GETCOLUMNWIDTH, col, 0)
If W1 > W2
ColWidth = W1
Else
ColWidth = W2
EndIf
SendMessage_(hHnd, #LVM_SETCOLUMNWIDTH, col, ColWidth)
Next
EndProcedure
Procedure JustifyColumn(GadgetID.i, Column.i, Flag.l=#Center)
Protected ListIcon.LV_COLUMN
ListIcon\mask = #LVCF_FMT
Select Flag
Case #Center
ListIcon\fmt = #LVCFMT_CENTER
Case #Right
ListIcon\fmt = #LVCFMT_RIGHT
Default
ListIcon\fmt = #LVCFMT_LEFT
EndSelect
SendMessage_(GadgetID(GadgetID), #LVM_SETCOLUMN, Column, @ListIcon)
EndProcedure
Procedure SetFont(GadgetID.i, HeaderFont.i, ListFont.i=#False)
If IsFont(ListFont)
SendMessage_(GadgetID(GadgetID), #WM_SETFONT, ListFont, 1)
EndIf
If IsFont(HeaderFont)
SendMessage_(SendMessage_(GadgetID(GadgetID), #LVM_GETHEADER,0,0), #WM_SETFONT, HeaderFont, 1)
EndIf
EndProcedure
CompilerCase #PB_OS_Linux
;{ used for justify ListIcon columns
ImportC ""
g_object_set_double(*Object, Property.P-ASCII, Value.D, Null) As "g_object_set"
EndImport
;}
Procedure JustifyColumn(GadgetID.i, Column.i, Flag.l=#Center)
; based on code from Shardik
Protected *CellRenderers, *Column
Protected.d AlignmentFactor
Protected.i Count, i
Select Flag
Case #Left
AlignmentFactor = 0.0
Case #Center
AlignmentFactor = 0.5
Case #Right
AlignmentFactor = 1.0
EndSelect
*Column = gtk_tree_view_get_column_(GadgetID(GadgetID), Column)
If *Column
gtk_tree_view_column_set_alignment_(*Column, AlignmentFactor)
*CellRenderers = gtk_tree_view_column_get_cell_renderers_(*Column)
If *CellRenderers
Count = g_list_length_(*CellRenderers)
For i = 0 To Count - 1
g_object_set_double(g_list_nth_data_(*CellRenderers, i), "xalign", AlignmentFactor, #Null)
Next i
g_list_free_(*CellRenderers)
EndIf
EndIf
EndProcedure
CompilerIf #PB_Compiler_Version >= 560
Procedure.i CountColumns(GadgetID.i)
ProcedureReturn GetGadgetAttribute(GadgetID, #PB_ListIcon_ColumnCount)
EndProcedure
CompilerEndIf
CompilerCase #PB_OS_MacOS
CompilerEndSelect
; ===================================================================
Procedure.i GetListItemColumnWidth(GadgetID.i, Position.i, Column.i=0)
ProcedureReturn GetGadgetItemAttribute(GadgetID, Position, #PB_ListIcon_ColumnWidth, Column)
EndProcedure
Procedure SetListItemColumnWidth(GadgetID.i, Position.i, Value.i, Column.i=0)
SetGadgetItemAttribute(GadgetID, Position, #PB_ListIcon_ColumnWidth, Value, Column)
EndProcedure
Procedure DefineSort(GadgetID.i, Norm.l) ; Set german DIN norm for sort
Protected.s GID = Str(GadgetID)
ListIcon(GID)\SortNorm = Norm
EndProcedure
; --- Replaced ListIcon Commands ---
Procedure.i AddListItem(GadgetID.i, Position.i, Text.s, UserSort.s="", ImageID.i=#False)
Protected *ptr, GID.s = Str(GadgetID)
AddGadgetItem(GadgetID, Position, Text, ImageID)
If Position = -1
*ptr = AddElement(ListIcon(GID)\Item())
ListIcon(GID)\Item()\Text = Text
ListIcon(GID)\Item()\Position = CountGadgetItems(GadgetID)-1
Else
ForEach ListIcon(GID)\Item()
If ListIcon(GID)\Item()\Position >= Position
ListIcon(GID)\Item()\Position + 1
EndIf
Next
*ptr = AddElement(ListIcon(GID)\Item())
ListIcon(GID)\Item()\Text = Text
ListIcon(GID)\Item()\Position = Position
Endif
ListIcon(GID)\Item()\ImageID = ImageID
If UserSort : ListIcon(GID)\Item()\UserSort("D") = UserSort : EndIf ; Default UserSort (No Column)
ProcedureReturn *ptr
EndProcedure
Procedure RemoveListItem(GadgetID.i, Position.i)
Protected GID.s = Str(GadgetID)
RemoveGadgetItem(GadgetID, Position)
SelectElement(ListIcon(GID)\Item(), Position)
DeleteElement(ListIcon(GID)\Item())
EndProcedure
Procedure ClearListItems(GadgetID.i)
Protected GID.s = Str(GadgetID)
ClearGadgetItems(GadgetID)
ClearList(ListIcon(GID)\Item())
EndProcedure
Procedure SetListItemData(GadgetID.i, Position.i, Value.i)
Protected GID.s = Str(GadgetID)
SetGadgetItemData(GadgetID, Position, Value)
SelectElement(ListIcon(GID)\Item(), Position)
ListIcon(GID)\Item()\ItemData = Value
EndProcedure
Procedure.i GetListItemData(GadgetID.i, Position.i)
Protected GID.s = Str(GadgetID)
SelectElement(ListIcon(GID)\Item(), Position)
ProcedureReturn ListIcon(GID)\Item()\ItemData
EndProcedure
Procedure SetListItemImage(GadgetID.i, Position.i, ImageID.i)
Protected GID.s = Str(GadgetID)
SetGadgetItemImage(GadgetID, Position, ImageID)
SelectElement(ListIcon(GID)\Item(), Position)
ListIcon(GID)\Item()\ImageID = ImageID
EndProcedure
Procedure SetListItemText(GadgetID.i, Position.i, Text.s, Column.i)
Protected GID.s = Str(GadgetID), Row.i, col.i, StartPos.i, EndPos.i
SetGadgetItemText(GadgetID, Position, Text, Column)
ForEach ListIcon(GID)\Item()
If Row = Position
If Column > 0 ;{
For col=1 To Column
StartPos = FindString(ListIcon(GID)\Item()\Text, #LF$, StartPos+1)
Next
EndIf ;}
EndPos = FindString(ListIcon(GID)\Item()\Text, #LF$, StartPos+1)
If Column = 0
ListIcon(GID)\Item()\Text = Text + Mid(ListIcon(GID)\Item()\Text, EndPos)
ElseIf EndPos
ListIcon(GID)\Item()\Text = Left(ListIcon(GID)\Item()\Text, StartPos) + Text + Mid(ListIcon(GID)\Item()\Text, EndPos)
Else ; Last Column
ListIcon(GID)\Item()\Text = Left(ListIcon(GID)\Item()\Text, StartPos) + Text
EndIf
Break
EndIf
Row + 1
Next
EndProcedure
Procedure SetListColor(GadgetID.i, ColorTyp.i, Color.i)
SetGadgetColor(GadgetID, ColorTyp, Color)
EndProcedure
Procedure.i GetListColor(GadgetID.i, ColorTyp.i)
ProcedureReturn GetGadgetColor(GadgetID, ColorTyp)
EndProcedure
Procedure SetListItemColor(GadgetID.i, Position.i, ColorTyp.i, Color.i, Column.i=0)
Protected GID.s = Str(GadgetID)
SetGadgetItemColor(GadgetID, Position, ColorTyp, Color, Column)
SelectElement(ListIcon(GID)\Item(), Position)
Select ColorTyp
Case #PB_Gadget_FrontColor
ListIcon(GID)\Item()\Color(Str(Column))\Front = Color
ListIcon(GID)\Item()\Color(Str(Column))\changedFront = #True
Case #PB_Gadget_BackColor
ListIcon(GID)\Item()\Color(Str(Column))\Back = Color
ListIcon(GID)\Item()\Color(Str(Column))\changedBack = #True
EndSelect
EndProcedure
Procedure.i GetListItemColor(GadgetID.i, Position.i, ColorTyp.i, Column.i=0)
ProcedureReturn GetGadgetItemColor(GadgetID, Position, ColorTyp, Column)
EndProcedure
Procedure AddListColumn(GadgetID.i, Column.i, Titel.s, Width.i, ReFill.l=#True)
Protected GID.s = Str(GadgetID), c.i, col.i, ColPos.i = 0
AddGadgetColumn(GadgetID, Column, Titel, Width)
If Refill : ClearGadgetItems(GadgetID) : Endif
ForEach ListIcon(GID)\Item()
ColPos = 0
If Column > 0 ;{
For col=1 To Column
ColPos = FindString(ListIcon(GID)\Item()\Text, #LF$, ColPos+1)
Next
EndIf ;}
If Column = 0
ListIcon(GID)\Item()\Text = #LF$ + ListIcon(GID)\Item()\Text
ElseIf ColPos
ListIcon(GID)\Item()\Text = InsertString(ListIcon(GID)\Item()\Text, #LF$, ColPos)
Else ; last column
ListIcon(GID)\Item()\Text + #LF$
EndIf
If ReFill
AddGadgetItem(GadgetID, -1, ListIcon(GID)\Item()\Text, ListIcon(GID)\Item()\ImageID)
Endif
Next
For c = CountGadgetItems(GadgetID)-1 To Column+1 Step -1
If ListIcon(GID)\Column(Str(c-1))
ListIcon(GID)\Column(Str(c)) = ListIcon(GID)\Column(Str(c-1))
EndIf
Next
ListIcon(GID)\Column(Str(Column)) = #False
EndProcedure
Procedure RemoveListColumn(GadgetID.i, Column.i)
Protected GID.s = Str(GadgetID), col.i, StartPos.i, EndPos.i
RemoveGadgetColumn(GadgetID, Column)
ForEach ListIcon(GID)\Item()
StartPos = 0
If Column > 0 ;{ Column 1 - Last
For col=1 To Column
StartPos = FindString(ListIcon(GID)\Item()\Text, #LF$, StartPos+1)
Next
EndIf ;}
EndPos = FindString(ListIcon(GID)\Item()\Text, #LF$, StartPos+1)
If Column = 0
ListIcon(GID)\Item()\Text = Mid(ListIcon(GID)\Item()\Text, EndPos+1)
ElseIf EndPos
ListIcon(GID)\Item()\Text = Left(ListIcon(GID)\Item()\Text, StartPos-1) + Mid(ListIcon(GID)\Item()\Text, EndPos)
Else ; Last Column
ListIcon(GID)\Item()\Text = Left(ListIcon(GID)\Item()\Text, StartPos-1)
EndIf
Next
ListIcon(GID)\Column(Str(Column)) = #False
For col = Column+1 To CountGadgetItems(GadgetID)
If ListIcon(GID)\Column(Str(col))
ListIcon(GID)\Column(Str(col-1)) = ListIcon(GID)\Column(Str(col))
EndIf
Next
ListIcon(GID)\Column(Str(CountGadgetItems(GadgetID))) = #False
EndProcedure
; --- Sort List Commands ---
Procedure SetColumnFlag(GadgetID.i, Column.i, Flags.l)
; Flags: #String / #Float / #Integer / #NoSort / #NoEdit / #UserSort / #NoResize / #Hide
Protected GID.s = Str(GadgetID)
ListIcon(GID)\Column(Str(Column)) = Flags
If Flags & #Hide
SetGadgetItemAttribute(GadgetID, #Null, #PB_ListIcon_ColumnWidth, 0, Column)
EndIf
EndProcedure
Procedure AddUserSort(GadgetID.i, Column.i, UserSort.s)
Protected GID.s = Str(GadgetID)
If ListIndex(ListIcon(GID)\Item()) <> -1
ListIcon(GID)\Item()\UserSort(Str(Column)) = UserSort
EndIf
EndProcedure
Procedure ChangeUserSortDefault(GadgetID.i, Position.i, UserSort.s="")
Protected GID.s = Str(GadgetID)
ForEach ListIcon(GID)\Item()
If ListIcon(GID)\Item()\Position = Position
ListIcon(GID)\Item()\UserSort("D") = UserSort
Break
EndIf
Next
EndProcedure
Procedure ChangeUserSortColumn(GadgetID.i, Position.i, Column.i, UserSort.s)
Protected GID.s = Str(GadgetID)
ForEach ListIcon(GID)\Item()
If ListIcon(GID)\Item()\Position = Position
ListIcon(GID)\Item()\UserSort(Str(Column)) = UserSort
Break
EndIf
Next
EndProcedure
Procedure.s SortDEU(Text.s, SortNorm.l=#Namen) ; german charakters (DIN 5007)
Select SortNorm
Case #Lexikon
Text = ReplaceString(Text, "Ä", "A")
Text = ReplaceString(Text, "Ö", "O")
Text = ReplaceString(Text, "Ü", "U")
Text = ReplaceString(Text, "ä", "a")
Text = ReplaceString(Text, "ö", "o")
Text = ReplaceString(Text, "ü", "u")
Text = ReplaceString(Text, "ß", "ss")
Case #Namen
Text = ReplaceString(Text, "Ä", "Ae")
Text = ReplaceString(Text, "Ö", "Oe")
Text = ReplaceString(Text, "Ü", "Ue")
Text = ReplaceString(Text, "ä", "ae")
Text = ReplaceString(Text, "ö", "oe")
Text = ReplaceString(Text, "ü", "ue")
Text = ReplaceString(Text, "ß", "ss")
EndSelect
ProcedureReturn Text
EndProcedure
Procedure.s GetSortString(Text.s, Flags.i, SortNorm.l=#Namen)
Text = SortDEU(Text, SortNorm)
If Flags & #CaseSensitive
ProcedureReturn Left(Text, 4)
Else
ProcedureReturn Left(LCase(Text), 4)
EndIf
EndProcedure
Procedure SetItemColor(GadgetID.i, Position.i)
Protected GID.s = Str(GadgetID), Column$
If MapSize(ListIcon(GID)\Item()\Color())
ResetMap(ListIcon(GID)\Item()\Color())
While NextMapElement(ListIcon(GID)\Item()\Color())
Column$ = MapKey(ListIcon(GID)\Item()\Color())
If ListIcon(GID)\Item()\Color(Column$)\changedFront
SetGadgetItemColor(GadgetID, Position, #PB_Gadget_FrontColor, ListIcon(GID)\Item()\Color()\Front, Val(Column$))
EndIf
If ListIcon(GID)\Item()\Color(Column$)\changedBack
SetGadgetItemColor(GadgetID, Position, #PB_Gadget_BackColor, ListIcon(GID)\Item()\Color()\Back, Val(Column$))
EndIf
Wend
EndIf
EndProcedure
Procedure SetSortOrder(GadgetID.i, Flags.l, SortCol1.i, SortCol2.i=#PB_Ignore, SortCol3.i=#PB_Ignore)
Protected.s GID = Str(GadgetID)
ForEach ListIcon(GID)\Item()
If Flags & #NoSort
ListIcon(GID)\Item()\Sort = RSet(Str(ListIcon(GID)\Item()\Position), 4, "0")
Else
ListIcon(GID)\Item()\Sort = GetSortString(StringField(ListIcon(GID)\Item()\Text, SortCol1+1, #LF$), Flags, ListIcon(GID)\SortNorm)
If SortCol2 <> #PB_Ignore
ListIcon(GID)\Item()\Sort + GetSortString(StringField(ListIcon(GID)\Item()\Text, SortCol2+1, #LF$), Flags, ListIcon(GID)\SortNorm)
ElseIf SortCol3 <> #PB_Ignore
ListIcon(GID)\Item()\Sort + GetSortString(StringField(ListIcon(GID)\Item()\Text, SortCol3+1, #LF$), Flags, ListIcon(GID)\SortNorm)
EndIf
Endif
Next
EndProcedure
Procedure SetSortOrderInteger(GadgetID.i, Flags.l, SortCol.i)
Protected.s GID = Str(GadgetID)
ForEach ListIcon(GID)\Item()
If Flags & #NoSort
ListIcon(GID)\Item()\SortInteger = ListIcon(GID)\Item()\Position
Else
ListIcon(GID)\Item()\SortInteger = Val(StringField(ListIcon(GID)\Item()\Text, SortCol+1, #LF$))
EndIf
Next
EndProcedure
Procedure SetSortOrderFloat(GadgetID.i, Flags.l, SortCol.i)
Protected.s GID = Str(GadgetID)
ForEach ListIcon(GID)\Item()
If Flags & #NoSort
ListIcon(GID)\Item()\SortFloat = ListIcon(GID)\Item()\Position
Else
ListIcon(GID)\Item()\SortFloat = ValF(ReplaceString(StringField(ListIcon(GID)\Item()\Text, SortCol+1, #LF$), ",", "."))
EndIf
Next
EndProcedure
Procedure SetSortUserOrder(GadgetID.i, Flags.l, SortCol.i=#Default)
Protected.s GID = Str(GadgetID), COL$ = Str(SortCol)
If SortCol=#Default : COL$="D" : EndIf
ForEach ListIcon(GID)\Item()
If Flags & #NoSort
ListIcon(GID)\Item()\Sort = RSet(Str(ListIcon(GID)\Item()\Position), 4, "0")
Else
If Flags & #CaseSensitive
ListIcon(GID)\Item()\Sort = ListIcon(GID)\Item()\UserSort(COL$)
Else
ListIcon(GID)\Item()\Sort = LCase(ListIcon(GID)\Item()\UserSort(COL$))
EndIf
EndIf
Next
EndProcedure
Procedure SortListItems(GadgetID.i, SortCol.i, Flags.l=#False)
; Flags: #UserSort / #Descending / #Ascending / #CaseSensitive / #CaseInSensitive
; SortCol: #Default (if #UserSort)
Protected i.i, Row.i, GID.s = Str(GadgetID), ColumnFlag = ListIcon(GID)\Column(Str(SortCol))
If ListSize(ListIcon(GID)\Item())
; --- Read Checked / GadgetItemData ---
For i = 0 To CountGadgetItems(GadgetID)-1
ListIcon(GID)\Item()\Checked = GetGadgetItemState(GadgetID, i)
ListIcon(GID)\Item()\ItemData = GetListItemData(GadgetID, i)
Next
; -------------------------------------
If ColumnFlag & #Integer ;{ Sort Integer
SetSortOrderInteger(GadgetID, Flags, SortCol)
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\SortInteger), TypeOf(ListItemStructure\SortInteger))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\SortInteger), TypeOf(ListItemStructure\SortInteger))
EndIf ;}
ElseIf ColumnFlag & #Float ;{ Sort Float
SetSortOrderFloat(GadgetID, Flags, SortCol)
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\SortFloat), TypeOf(ListItemStructure\SortFloat))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\SortFloat), TypeOf(ListItemStructure\SortFloat))
EndIf ;}
ElseIf ColumnFlag & #UserSort ;{ Sort User
SetSortUserOrder(GadgetID, Flags, SortCol)
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
EndIf ;}
Else ;{ Sort String
If Flags & #UserSort
SetSortUserOrder(GadgetID, Flags, SortCol)
Else
SetSortOrder(GadgetID, Flags, SortCol)
EndIf
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
EndIf ;}
EndIf
ClearGadgetItems(GadgetID)
ForEach ListIcon(GID)\Item()
AddGadgetItem(GadgetID, Row, ListIcon(GID)\Item()\Text, ListIcon(GID)\Item()\ImageID)
SetGadgetItemState(GadgetID, Row, ListIcon(GID)\Item()\Checked)
SetGadgetItemData(GadgetID, Row, ListIcon(GID)\Item()\ItemData)
SetItemColor(GadgetID, Row)
Row + 1
Next
EndIf
EndProcedure
Procedure MultiSortListItems(GadgetID.i, SortCol1.i, SortCol2.i, SortCol3.i=#PB_Ignore, Flags.l=#False)
; Flags: #UserSort / #Descending / #Ascending / #CaseSensitive / #CaseInSensitive
Protected.s Row.i, GID = Str(GadgetID)
; Ignore SortCol3 with #PB_Ignore
If ListSize(ListIcon(GID)\Item())
If Flags & #UserSort
SetSortUserOrder(GadgetID, Flags, SortCol1)
Else
SetSortOrder(GadgetID, Flags, SortCol1, SortCol2, SortCol3)
EndIf
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
EndIf
ClearGadgetItems(GadgetID)
ForEach ListIcon(GID)\Item()
AddGadgetItem(GadgetID, Row, ListIcon(GID)\Item()\Text, ListIcon(GID)\Item()\ImageID)
SetGadgetItemData(GadgetID, Row, ListIcon(GID)\Item()\ItemData)
SetItemColor(GadgetID, Row)
Row + 1
Next
EndIf
EndProcedure
Procedure RemoveSortData(GadgetID.i)
DeleteMapElement(ListIcon(), Str(GadgetID))
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
#Window = 0
#List = 1
#Font_Arial10B = 2
#Font_Arial9I = 3
LoadFont(#Font_Arial10B,"Arial",10,#PB_Font_Bold)
LoadFont(#Font_Arial9I,"Arial",9,#PB_Font_Italic)
If OpenWindow(#Window,0,0,320,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ListIconGadget(#List,10,10,300,230,"Column 0",80,#PB_ListIcon_GridLines)
AddGadgetColumn(#List,1,"Column 1",80)
AddGadgetColumn(#List,2,"Column 2",80)
AddGadgetColumn(#List,3,"Number",54)
AddGadgetColumn(#List,4,"Hide",40)
UseModule ListIcon
AddListItem(#List, -1, "Left" +#LF$+ "Center"+#LF$+"Right"+#LF$+"2.66")
AddListItem(#List, -1, "Alpha" +#LF$+ "Gamma" +#LF$+"Beta" +#LF$+"1.33")
AddListItem(#List, -1, "Ärmel" +#LF$+ "Esel" +#LF$+"Öfen" +#LF$+"2.33")
AddListItem(#List, -1, "Besen" +#LF$+ "Gans" +#LF$+"Quark" +#LF$+"10.33")
AddListItem(#List, -1, "Faden" +#LF$+ "Affe" +#LF$+"Zebra" +#LF$+"2.33")
SetColumnFlag(#List, 1, #NoSort|#NoResize)
SetColumnFlag(#List, 2, #NoEdit)
SetColumnFlag(#List, 3, #Float)
SetColumnFlag(#List, 4, #Hide) ; Hide Column 4
;If AddListItem(#List, -1, "Ärmel"+#LF$+"Esel"+#LF$+"Öfen")
; AddUserSort(#List, 0, "A")
; AddUserSort(#List, 1, "E")
; AddUserSort(#List, 2, "O")
;EndIf
UnuseModule ListIcon
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
UseModule ListIcon
DefineListCallback(#List, #Edit|#NoResize)
SetFont(#List, FontID(#Font_Arial10B), FontID(#Font_Arial9I))
UnuseModule ListIcon
Debug ListIcon::CountColumns(#List)
ListIcon::JustifyColumn(#List, 1, ListIcon::#Center)
ListIcon::JustifyColumn(#List, 3, ListIcon::#Right)
CompilerEndIf
MessageRequester("ListIcon Test","Sort ListIcon Items")
ListIcon::SortListItems(#List, 0, ListIcon::#Descending)
;ListIcon::AutoWidthColumns(#List)
;ListIcon::SortListItems(#List, #Default, #UserSort) ; Default User Sort
;ListIcon::MultiSortListItems(#List, 0, 1, #PB_Ignore)
;ListIcon::SetListItemText(#List, 1, "New Text", 2)
MessageRequester("ListIcon Test","Add ListIcon Column")
ListIcon::AddListColumn(#List, 1, "New", 40)
;MessageRequester("ListIcon Test","Remove ListIcon Items")
;ListIcon::RemoveListItem(#List, 3)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
CompilerEndIf
24.03.15 Bugfix: Löschen von Spalten
14.03.15 Bugfix: Flags für einzelne Spalten (Hinzufügen bzw. Entfernen von Spalten)
14.06.15 Unterstützung für Images hinzugefügt
24.10.17 Unterstützung von Farben in Listenfelder / Anpassungen an PureBasic 5.6x