I hope that I made it right
Code: Select all
; ==================================================================================================
; --- ListIconGadget Extras & Sort
; --- ----------------------------------------------------------------------------------------------
; --- File : module_nalorLIG.pbi
; --- OriginalAuthor : nalor
; --- modified : bisonte (change to new module system of pb)
; --- Link : http://purebasic.fr/english/viewtopic.php?f=12&t=55085
; --- Date : June 23, 2013
; --- Compiler : PureBasic 5.20b2 (Windows - x64)
; --- Target OS : Windows
; --- Version : 1.0a
; ==================================================================================================
; --- Module : nalorLIG
; --- Remark : If WindowsXP is used - Disable Debugger or use Unicode Flag only
CompilerIf #PB_Compiler_Version => 520
EnableExplicit
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
MessageRequester("PureBasic", "Windows only! Sorry.") : End
CompilerEndIf
DeclareModule nalorLIG
; --- Original by : nalor
; --- Link : http://purebasic.fr/english/viewtopic.php?f=12&t=55085
; --- mod.by : bisonte (change to module) - 23.06.2013
Enumeration ; Type of Column Sort
#SortString
#SortNumeric
#SortFloat
#SortDate
#SortAutoDetect
EndEnumeration
Enumeration ; Column Sort States
#NoSort ; keine Sortierung
#AscSort ; Aufsteigende Sortierung
#DescSort ; Absteigende Sortierung
EndEnumeration
Structure LVWSORT
hWndListView.i ; Fensterhandle des ListView-Controls
SortKey.i ; Spalte, die sortiert werden soll
SortType.b ; Typ der zu sortierenden Daten
SortOrder.b ; Sortierrichtung
DateFormat.s ; Mask for 'ParseDate'
EndStructure
Declare AlignColumn(Gadget, Index, Format)
Declare SetColumnWidth(Gadget, Index, New_Width)
Declare SetSortIcon(Gadget, Column, SortOrder)
Declare.b GetSortOrder(Gadget, Column)
Declare EnsureVisible(Gadget, Line)
Declare Enable()
EndDeclareModule
Module nalorLIG
; --- Original by : nalor
; --- Link : http://purebasic.fr/english/viewtopic.php?f=12&t=55085
; --- mod.by : bisonte (change to module) - 23.06.2013
Procedure GethWnd(ID)
Protected hWnd = #False
If IsGadget(ID)
hWnd = GadgetID(ID)
Else
If IsWindow_(ID)
hWnd = ID
EndIf
EndIf
ProcedureReturn hWnd
EndProcedure
;- ++++++ ListIconGadget Tools Start ++++++
Procedure AlignColumn(Gadget, Index, Format)
; by Danilo, 15.12.2003 - english chat (for 'Karbon')
; 20130615..nalor..modified
; change text alignment for columns
; #LVCFMT_LEFT / #LVCFMT_CENTER / #LVCFMT_RIGHT
Protected lvc.LV_COLUMN, hWnd = GethWnd(Gadget)
If hWnd
lvc\mask = #LVCF_FMT
lvc\fmt = Format
SendMessage_(hWnd, #LVM_SETCOLUMN, Index, @lvc)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure SetColumnWidth(Gadget, Index, New_Width)
; by Danilo, 15.12.2003 - english chat (for 'Karbon')
;
; change column header width
;
Protected hWnd = GethWnd(Gadget)
If hWnd
SendMessage_(hWnd, #LVM_SETCOLUMNWIDTH, Index, New_Width)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure SetSortIcon(Gadget, Column, SortOrder)
; http://stackoverflow.com/questions/254129/how-To-i-display-a-sort-arrow-in-the-header-of-a-List-view-column-using-c
Protected ColumnHeader
Protected ColumnCount
Protected hditem.HD_ITEM
Protected Cnt
Protected hWnd = GethWnd(Gadget)
If hWnd
ColumnHeader = SendMessage_(hWnd, #LVM_GETHEADER, 0, 0)
ColumnCount = SendMessage_(ColumnHeader, #HDM_GETITEMCOUNT, 0, 0)
For Cnt = 0 To ColumnCount - 1
hditem\mask=#HDI_FORMAT
If SendMessage_(ColumnHeader, #HDM_GETITEM, Cnt, @hditem) = 0
Debug "ERROR! LIG_SetSortIcon 1"
EndIf
hditem\mask=#HDI_FORMAT
If (Cnt = Column And SortOrder <> #NoSort)
Select SortOrder
Case #AscSort ; wenn aufsteigend sortiert werden soll
hditem\fmt& ~#HDF_SORTDOWN
hditem\fmt|#HDF_SORTUP
Debug "sortup"
Case #DescSort
hditem\fmt& ~#HDF_SORTUP
hditem\fmt|#HDF_SORTDOWN
Debug "sortdown"
EndSelect
Else
hditem\fmt& ~#HDF_SORTUP
hditem\fmt& ~#HDF_SORTDOWN
EndIf
If (SendMessage_(ColumnHeader, #HDM_SETITEM, Cnt, @hditem) = 0)
Debug "ERROR! LIG_SetSortIcon 2"
EndIf
Next cnt
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.b GetSortOrder(Gadget, Column)
Protected ColumnHeader
Protected hditem.HD_ITEM
Protected RetVal.b = -1
Protected hWnd = GethWnd(Gadget)
If hWnd
ColumnHeader = SendMessage_(hWnd, #LVM_GETHEADER, 0, 0)
hditem\mask=#HDI_FORMAT
If SendMessage_(ColumnHeader, #HDM_GETITEM, Column, @hditem)
If (hditem\fmt&#HDF_SORTUP)=#HDF_SORTUP
Debug "sortup"
RetVal=#AscSort
ElseIf (hditem\fmt&#HDF_SORTDOWN)=#HDF_SORTDOWN
Debug "sortdown"
RetVal=#DescSort
Else
Debug "keine sortierung"
RetVal=#NoSort
EndIf
Else
Debug "ERROR! LIG_GetSortOrder"
RetVal=-1
EndIf
EndIf
ProcedureReturn RetVal
EndProcedure
Procedure EnsureVisible(Gadget, Line)
; makes sure the line is visible
Protected hWnd = GethWnd(Gadget)
If hWnd
SendMessage_(hWnd, #LVM_ENSUREVISIBLE, Line, #True)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;- ##### ListIconGadget Tools Ende #####
;- ++++++ ListIconGadget Sort Start ++++++
; http://msdn.microsoft.com/de-de/library/bb979183.aspx
; Die Struktur LVWSORT enthält Informationen über das zu sortierende ListView-Steuerelement, die Spalte,
; nach der sortiert werden soll, sowie die gewünschte Sortierrichtung.
Procedure.b IsNumChar(*Text, Position = 1)
Select Asc(PeekS(*Text+(Position-1)*SizeOf(Character), 1))
Case 48 To 57
ProcedureReturn #True
Default
ProcedureReturn #False
EndSelect
EndProcedure
Procedure CompareStrings(*sEntry1, *sEntry2, SortOrder.b)
; ' -----------------------------------------------------
; ' Gibt zurück, ob das erste der beiden unterschiedlichen
; ' Elemente nach Maßgabe des Parameters SortOrder größer
; ' (1 bei aufsteigender Sortierung) oder kleiner (-1 bei
; ' aufsteigender Sortierung) als das zweite Element ist.
; ' Gleiche Elemente wurden bereits in CompareFunc ausge-
; ' schlossen; für sie wäre sonst 0 zurückzugeben.
; ' -----------------------------------------------------
; ' Rückgabewert je nach erwünschter Sortierung:
If SortOrder = #AscSort
; Aufsteigende Sortierung zweier unterschiedlicher Strings
If CompareMemoryString(*sEntry1, *sEntry2, #PB_String_NoCase) = #PB_String_Lower
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
Else ; Absteigende Sortierung
If CompareMemoryString(*sEntry1, *sEntry2, #PB_String_NoCase) = #PB_String_Greater
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure CompareNumbers(sEntry1.s, sEntry2.s, SortOrder.b)
; ' -----------------------------------------------------
; ' Gibt zurück, ob das erste der beiden unterschiedlichen
; ' Elemente nach Maßgabe des Parameters SortOrder größer
; ' (1 bei aufsteigender Sortierung) oder kleiner (-1 bei
; ' aufsteigender Sortierung) als das zweite Element ist.
; ' Gleiche Elemente wurden bereits in CompareFunc ausge-
; ' schlossen; für sie wäre sonst 0 zurückzugeben.
; ' -----------------------------------------------------
; ' Rückgabewert je nach erwünschter Sortierung:
If SortOrder = #AscSort
; Aufsteigende Sortierung zweier unterschiedlicher Zahlen
If Val(sEntry1) < Val(sEntry2)
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
Else ; Absteigende Sortierung
If Val(sEntry1) > Val(sEntry2)
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure CompareFloat(sEntry1.s, sEntry2.s, SortOrder.b)
; ' -----------------------------------------------------
; ' Gibt zurück, ob das erste der beiden unterschiedlichen
; ' Elemente nach Maßgabe des Parameters SortOrder größer
; ' (1 bei aufsteigender Sortierung) oder kleiner (-1 bei
; ' aufsteigender Sortierung) als das zweite Element ist.
; ' Gleiche Elemente wurden bereits in CompareFunc ausge-
; ' schlossen; für sie wäre sonst 0 zurückzugeben.
; ' -----------------------------------------------------
; ' Rückgabewert je nach erwünschter Sortierung:
ReplaceString(sEntry1, ",", ".", #PB_String_InPlace, 1, 1) ; ersetze Dezimalkomma durch Punkt, damit ValF korrekt arbeitet
ReplaceString(sEntry2, ",", ".", #PB_String_InPlace, 1, 1)
If SortOrder = #AscSort
; Aufsteigende Sortierung zweier unterschiedlicher Zahlen
If ValF(sEntry1) < ValF(sEntry2)
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
Else ; Absteigende Sortierung
If ValF(sEntry1) > ValF(sEntry2)
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure CompareDate(sEntry1.s, sEntry2.s, SortOrder.b, sDateMask.s)
; ' -----------------------------------------------------
; ' Gibt zurück, ob das erste der beiden unterschiedlichen
; ' Elemente nach Maßgabe des Parameters SortOrder größer
; ' (1 bei aufsteigender Sortierung) oder kleiner (-1 bei
; ' aufsteigender Sortierung) als das zweite Element ist.
; ' Gleiche Elemente wurden bereits in CompareFunc ausge-
; ' schlossen; für sie wäre sonst 0 zurückzugeben.
; ' -----------------------------------------------------
; ' Rückgabewert je nach erwünschter Sortierung:
If SortOrder = #AscSort
; Aufsteigende Sortierung zweier unterschiedlicher Zahlen
If ParseDate(sDateMask, sEntry1) < ParseDate(sDateMask, sEntry2)
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
Else ; Absteigende Sortierung
If ParseDate(sDateMask, sEntry1) > ParseDate(sDateMask, sEntry2)
ProcedureReturn -1
Else
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure.s LvwGetText(*ListViewSort.LVWSORT, lParam)
; ' -----------------------------------------------------
; ' Ermittelt aus dem Fensterhandle des ListView-
; ' Steuerelements, der in ListViewSort.SortKey
; ' angegebenen (nullbasierten) Spalte im ListView
; ' und der an CompareFunc übergebenen Werte lParam1/2
; ' die davon repräsentierten Zelleninhalte.
; ' -----------------------------------------------------
Protected udtFindInfo.LV_FINDINFO, udtLVItem.LV_ITEM
Protected lngIndex, *baBuffer, lngLength, RetVal.s = ""
*baBuffer = AllocateMemory(512)
If *baBuffer
; Auf Basis des Index den Text der Zelle auslesen:
udtLVItem\mask=#LVIF_TEXT
udtLVItem\iSubItem=*ListViewSort\SortKey
udtLVItem\pszText=*baBuffer
udtLVItem\cchTextMax=(512/SizeOf(Character))-1
lngLength = SendMessage_(*ListViewSort\hWndListView, #LVM_GETITEMTEXT, lParam, @udtLVItem)
; Byte-Array in passender Länge als String-Rückgabewert kopieren:
If lngLength > 0
RetVal = PeekS(*baBuffer, lngLength)
EndIf
FreeMemory(*baBuffer) ; thx LittleJohn
EndIf
ProcedureReturn RetVal
EndProcedure
Procedure CompareFunc(lParam1, lParam2, lParamSort)
; ' -----------------------------------------------------
; ' Vergleichsfunktion CompareFunc
; ' -----------------------------------------------------
; ' Verglichen werden jeweils zwei Elemente der zu
; ' sortierenden Spalte des ListView-Steuerelements,
; ' die über lParam1 und lParam2 angegeben werden.
; ' Hierbei wird über den Rückgabewert der Funktion
; ' bestimmt, welches der beiden Elemente als größer
; ' gelten soll (hier für Aufwärtssortierung):
; ' * Element 1 < Element 2: Rückgabewert < 0
; ' * Element 1 = Element 2: Rückgabewert = 0
; ' * Element 1 > Element 2: Rückgabewert > 0
; ' -----------------------------------------------------
Protected *ListViewSort.LVWSORT
Protected sEntry1.s
Protected sEntry2.s
Protected vCompare1.s ; As Variant
Protected vCompare2.s ; As Variant
; In lParamSort von SortListView als Long-Pointer übergebene LVWSORT-Struktur abholen, um auf deren
; Werte zugreifen zu können:
*ListViewSort=lParamSort
; Die Werte der zu vergleichenden Elemente werden mithilfe der privaten Funktion LvwGetText aus
; den Angaben lParam1 und lParam2 ermittelt:
sEntry1 = LvwGetText(*ListViewSort, lParam1)
sEntry2 = LvwGetText(*ListViewSort, lParam2)
; Sind die Elemente gleich, kann die Funktion sofort mit dem aktuellen Rückgabewert 0
; verlassen werden:
If sEntry1 = sEntry2
ProcedureReturn 0
EndIf
; Für die Sortierung wird unterschieden zwischen Zahlen, Fließkommazahlen und allgemeinen Strings. Hierfür
; steht jeweils eine separate, private Vergleichsfunktion zur Verfügung.
Select *ListViewSort\SortType
Case #SortNumeric ; ' Spalteninhalte sind Zahlen
ProcedureReturn CompareNumbers(sEntry1, sEntry2, *ListViewSort\SortOrder)
Case #SortFloat ; ' Spalteninhalte sind Zahlen mit Nachkommastellen
ProcedureReturn CompareFloat(sEntry1, sEntry2, *ListViewSort\SortOrder)
Case #SortString; ' Spalteninhalte sind Strings
ProcedureReturn CompareStrings(@sEntry1, @sEntry2, *ListViewSort\SortOrder)
Case #SortDate
ProcedureReturn CompareDate(sEntry1, sEntry2, *ListViewSort\SortOrder, *ListViewSort\DateFormat)
EndSelect
EndProcedure
Procedure.s GetDateFormat(Date.s)
Debug "GetDateFormat >"+Date+"<"
Protected Diff.i
Diff=Len(Date)-CountString(Date, "0")-CountString(Date, "1")-CountString(Date, "2")-CountString(Date, "3")-CountString(Date, "4")-CountString(Date, "5")-CountString(Date, "6")-CountString(Date, "7")-CountString(Date, "8")-CountString(Date, "9")
Select Diff
Case 2
If Len(Date)=10 ; Date 'dd.mm.yyyy', 'mm.dd.yyyy' or 'yyyy.mm.dd'
If (Not IsNumChar(@Date, 5) And Not IsNumChar(@Date, 8)) ; yyyy.mm.dd
ProcedureReturn "" ; faster to sort as string
ElseIf (Not IsNumChar(@Date, 3) And Not IsNumChar(@Date, 6)) ; dd.mm.yyyy or mm.dd.yyyy
If Val(Mid(Date, 4, 2))>12 ; is it mm.dd.yyyy?
ProcedureReturn "%mm"+Mid(Date, 3, 1)+"%dd"+Mid(Date, 6, 1)+"%yyyy"
Else ; default is dd.mm.yyyy
ProcedureReturn "%dd"+Mid(Date, 3, 1)+"%mm"+Mid(Date, 6, 1)+"%yyyy"
EndIf
Else
ProcedureReturn "" ; not a date - sort as string
EndIf
Else
ProcedureReturn "" ; not a date - sort as string
EndIf
Case 4
If Len(Date)=16 ;yyyy-mm-dd hh:mm, dd-mm-yyyy hh:mm or mm-dd-yyyy hh:mm
If (Not IsNumChar(@Date, 5) And Not IsNumChar(@Date, 8)) ; yyyy.mm.dd xxxxx
ProcedureReturn "" ; faster to sort as string
ElseIf (Not IsNumChar(@Date, 3) And Not IsNumChar(@Date, 6)) ; dd.mm.yyyy hh:mm or mm.dd.yyyy hh:mm
If Val(Mid(Date, 4, 2))>12 ; is it mm.dd.yyyy?
ProcedureReturn "%mm"+Mid(Date, 3, 1)+"%dd"+Mid(Date, 6, 1)+"%yyyy"+Mid(Date, 11, 1)+"%hh"+Mid(Date, 14, 1)+"%mm"
Else ; default is dd.mm.yyyy
ProcedureReturn "%dd"+Mid(Date, 3, 1)+"%mm"+Mid(Date, 6, 1)+"%yyyy"+Mid(Date, 11, 1)+"%hh"+Mid(Date, 14, 1)+"%mm"
EndIf
Else
ProcedureReturn "" ; not a date - sort as string
EndIf
Else
ProcedureReturn "" ; not a date - sort as string
EndIf
Case 5 ; 5 other chars, possibly DateTime?
If Len(Date)=19 ;yyyy-mm-dd hh:mm, dd-mm-yyyy hh:mm or mm-dd-yyyy hh:mm
If (Not IsNumChar(@Date, 5) And Not IsNumChar(@Date, 8)) ; yyyy.mm.dd xxxxx
ProcedureReturn "" ; faster to sort as string
ElseIf (Not IsNumChar(@Date, 3) And Not IsNumChar(@Date, 6)) ; dd.mm.yyyy hh:mm or mm.dd.yyyy hh:mm
If Val(Mid(Date, 4, 2))>12 ; is it mm.dd.yyyy?
ProcedureReturn "%mm"+Mid(Date, 3, 1)+"%dd"+Mid(Date, 6, 1)+"%yyyy"+Mid(Date, 11, 1)+"%hh"+Mid(Date, 14, 1)+"%mm"+Mid(Date, 17, 1)+"%ss"
Else ; default is dd.mm.yyyy
ProcedureReturn "%dd"+Mid(Date, 3, 1)+"%mm"+Mid(Date, 6, 1)+"%yyyy"+Mid(Date, 11, 1)+"%hh"+Mid(Date, 14, 1)+"%mm"+Mid(Date, 17, 1)+"%ss"
EndIf
Else
ProcedureReturn "" ; not a date - sort as string
EndIf
Else
ProcedureReturn "" ; not a date - sort as string
EndIf
Default
ProcedureReturn ""
EndSelect
EndProcedure
Procedure SortListView(hWndListView, SortKey, SortType.b, SortOrder.b)
; ' -----------------------------------------------------
; ' Öffentlich aufzurufende Prozedur SortListView, die
; ' für die individuelle Sortierung einer ListView-Spalte
; ' sorgt.
; ' -----------------------------------------------------
; ' hWndListView: Fensterhandle des ListView-Steuerelements
; ' SortKey: Spalte (nullbasiert), die sortiert werden
; ' soll (= Spaltennummer - 1).
; ' SortType: stString, um Strings zu sortieren (Standardwert)
; ' stDate, um Datumsangaben zu sortieren
; ' stNumeric, um Zahlen zu sortieren
; ' SortOrder: lvwAscending für aufsteigende Sortierung (Std.)
; ' lvwDescending für absteigende Sortierung
; ' -----------------------------------------------------
Protected udtLVWSORT.LVWSORT
Protected sDateFormat.s, sTemp.s, GadId.i
If SortType = #SortDate
GadId = GetDlgCtrlID_(hWndListView)
sDateFormat = GetDateFormat(GetGadgetItemText(GadId, 0, SortKey))
If sDateFormat = ""
SortType = #SortString
Else
sTemp = GetDateFormat(GetGadgetItemText(GadId, CountGadgetItems(GadId)-1, SortKey))
If sTemp=""
SortType=#SortString
Else
If sTemp<>sDateFormat
If Left(sTemp, 3)="%mm" ; new format starts with %mm (.dd.yyyy) - if this US format is detected it has higher prio
sDateFormat=sTemp
EndIf
EndIf
sTemp=GetDateFormat(GetGadgetItemText(GadId, CountGadgetItems(GadId)/2, SortKey))
If sTemp=""
SortType=#SortString
Else
If sTemp<>sDateFormat
If Left(sTemp, 3)="%mm" ; new format starts with %mm (.dd.yyyy) - if this US format is detected it has higher prio
sDateFormat=sTemp
EndIf
EndIf
EndIf
EndIf
EndIf
udtLVWSORT\DateFormat=sDateFormat
Debug "Final DateFormat >"+sDateFormat+"<"
EndIf
; Übergebene Informationen in einer LVWSORT-Struktur zusammenfassen:
udtLVWSORT\hWndListView=hWndListView
udtLVWSORT\SortKey=SortKey
udtLVWSORT\SortOrder=SortOrder
udtLVWSORT\SortType=SortType
; Eigene Sortierfunktionalität in der Funktion CompareFunc verwenden: Die Informationen der
; LVWSORT-Struktur wird mithilfe eines Zeigers auf die Variable udtLVWSORT beigegeben:
SendMessage_(hWndListView, #LVM_SORTITEMSEX, @udtLVWSORT, @CompareFunc())
EndProcedure
Procedure.b DetectOrderType(sText.s)
Protected Diff
Diff=Len(sText)-CountString(sText, "0")-CountString(sText, "1")-CountString(sText, "2")-CountString(sText, "3")-CountString(sText, "4")-CountString(sText, "5")-CountString(sText, "6")-CountString(sText, "7")-CountString(sText, "8")-CountString(sText, "9")
Select Diff
Case 0 ; es sind nur Ziffern
ProcedureReturn #SortNumeric
Case 1 ; nur 1 anderes Zeichen
If (CountString(sText, ",")>0 Or CountString(sText, ".")>0)
ProcedureReturn #SortFloat
ElseIf (Left(sText, 1)="$" Or Left(sText, 1)="%") ; es ist eine HEX oder Binär Zahl
ProcedureReturn #SortNumeric
Else
ProcedureReturn #SortString
EndIf
Case 2 ; 2 andere Zeichen - evtl. Datum?
If (Len(sText)=10 And
Not IsNumChar(@sText, 3) And Not IsNumChar(@sText, 6))
; dd-mm-yyyy or mm-dd-yyyy
ProcedureReturn #SortDate
Else
; yyyy-mm-dd
ProcedureReturn #SortString
EndIf
Case 4 ; 4 other chars, possibly DateTime?
If (Len(sText)=16 And
Not IsNumChar(@sText, 3) And Not IsNumChar(@sText, 6) And
Not IsNumChar(@sText, 11) And Not IsNumChar(@sText, 14))
;dd-mm-yyyy hh:mm or mm-dd-yyyy hh:mm
ProcedureReturn #SortDate
Else
ProcedureReturn #SortString
EndIf
Case 5 ; 5 other chars, possibly DateTime?
If (Len(sText)=19 And
Not IsNumChar(@sText, 3) And Not IsNumChar(@sText, 6) And
Not IsNumChar(@sText, 11) And Not IsNumChar(@sText, 14) And Not IsNumChar(@sText, 17))
;dd-mm-yyyy hh:mm:ss or mm-dd-yyyy hh:mm:ss
ProcedureReturn #SortDate
Else
ProcedureReturn #SortString
EndIf
Default
ProcedureReturn #SortString
EndSelect
EndProcedure
Procedure SortColumn(Gadget, Column, OrderType.b = #SortAutoDetect)
Protected ColCnt, Order, iStartT, iEndT, Temp.b
If Not IsGadget(Gadget) : ProcedureReturn #False : EndIf
Debug "LIG_SortColumn >"+Str(Gadget)+"< Spalte >"+Str(Column)+"<"
Select GetSortOrder(Gadget, Column)
Case #NoSort, #DescSort
Order = #AscSort
Case #AscSort
Order = #DescSort
EndSelect
iStartT=ElapsedMilliseconds()
If OrderType = #SortAutoDetect ; detect it automatically - check first, last and middle item of list
OrderType = DetectOrderType(GetGadgetItemText(Gadget, 0, Column))
If (OrderType = DetectOrderType(GetGadgetItemText(Gadget, CountGadgetItems(Gadget)-1, Column)))
If (OrderType <> DetectOrderType(GetGadgetItemText(Gadget, CountGadgetItems(Gadget)/2, Column)))
Debug "Different OrderType - use SortString 2"
OrderType = #SortString
EndIf
Else
Debug "Different OrderType - use SortString"
OrderType = #SortString
EndIf
EndIf
SortListView(GadgetID(Gadget), Column, OrderType, Order)
iEndT =ElapsedMilliseconds()
Debug "Dauer >"+StrF( (iEndT-iStartT)/1000, 2)+"<"
SetSortIcon(Gadget, Column, Order)
If (GetGadgetState(Gadget) > -1)
EnsureVisible(Gadget, GetGadgetState(Gadget))
EndIf
EndProcedure
;- ##### ListIconGadget Sort Ende ######
Procedure ColumnClickCallback(hWnd, uMsg, wParam, lParam)
Protected *msg.NM_LISTVIEW
If uMsg = #WM_NOTIFY
*msg = lParam
If *msg\hdr\code = #LVN_COLUMNCLICK
SortColumn(GetDlgCtrlID_(*msg\hdr\hwndfrom), *msg\iSubItem)
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure Enable()
SetWindowCallback(@ColumnClickCallback())
EndProcedure
EndModule
DisableExplicit
CompilerElse
MessageRequester("PureBasic", "PureBasic V5.20 or higher needed!") : End
CompilerEndIf
; --- Example
CompilerIf #PB_Compiler_IsMainFile
Enumeration #PB_Compiler_EnumerationValue
#MainWin
EndEnumeration
Enumeration #PB_Compiler_EnumerationValue
#ListIcon
EndEnumeration
Procedure OpenMainWin()
OpenWindow(#MainWin, 0, 0, 850, 500, "ListIconGadget-SortExample", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(#ListIcon, 10, 10, 830, 480, "COL 0", 150, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListIcon, 1, "COL 1", 100)
AddGadgetColumn(#ListIcon, 2, "COL 2", 100)
AddGadgetColumn(#ListIcon, 3, "COL 3 (NUM)", 100)
AddGadgetColumn(#ListIcon, 4, "COL 4 (FLOAT)", 100)
AddGadgetColumn(#ListIcon, 5, "COL 5 (DATE)", 100)
AddGadgetColumn(#ListIcon, 6, "COL 6 (DATETIME)", 150)
EndProcedure
Procedure MainWin_Events(event)
Select event
Case #PB_Event_CloseWindow
ProcedureReturn #False
EndSelect
ProcedureReturn #True
EndProcedure
Define iEvent.i
Define iEventWindow.i
Define iCloseAll.i
Define a.i, x.i
Define A$, B$, C$, D$, E$, F$, G$
OpenMainWin()
; generate Test Values:
For a = 0 To 1000
A$ = "COL 1, Row "+RSet(Str( a ),6,"0")+Chr(10)
B$ =RSet(Str(Random($FFFF)),5,"0")+Chr(10)
C$ ="$"+RSet(Hex(Random($7FFFFFFF)),8,"0")+Chr(10)
Select Random(5, 1)
Case 1
D$=Str(Random(9, 0))
Case 2
D$=Str(Random(99, 10))
Case 3
D$=Str(Random(999, 100))
Case 4
D$=Str(Random(9999, 1000))
Case 5
D$=Str(Random(99999, 10000))
EndSelect
D$+Chr(10)
Select Random(5, 1)
Case 1
E$=Str(Random(9, 0))+","+Str(Random(99, 0))
Case 2
E$=Str(Random(99, 10))+","+Str(Random(99, 0))
Case 3
E$=Str(Random(999, 100))+","+Str(Random(99, 0))
Case 4
E$=Str(Random(9999, 1000))+","+Str(Random(99, 0))
Case 5
E$=Str(Random(99999, 10000))+","+Str(Random(99, 0))
EndSelect
E$+Chr(10)
F$=FormatDate("%dd.%mm.%yyyy", Random(Date(), 0))+Chr(10)
G$=FormatDate("%mm-%dd-%yyyy %hh:%mm:%ss", Random(Date(), 0))
AddGadgetItem(#ListIcon, a, A$+B$+C$+D$+E$+F$+G$)
Next
nalorLIG::Enable()
Repeat
iEvent = WaitWindowEvent()
iEventWindow=EventWindow()
Select iEventWindow
Case #MainWin
If (Not MainWin_Events(iEvent))
iCloseAll=#True
EndIf
EndSelect
Until iCloseAll=#True
CompilerEndIf
