ListIconGadget with Sort and Arrow Icons

nalor · Post by **nalor** » Sun Jun 23, 2013 12:51 am

Hi!

I've tried a lot of sort procedures for the listicongadget, but none of them satisfied me - so I converted some code from other languages and here comes the result:

# shows the original-windows-arrow in the column header (thanks to code found on stackoverflow)
# sorts depending on the content of the column (string, number, float, date) (thanks to code from ms)
# not a single global variable!
# it's really fast (at least compared to some solutions found on the net)
# setgadgetitemdata is no problem (some of the sort routines on the net are not compatible with it)
# additionalle I've include a few procedures taken from Danilo's version (and modified/renamed them a little bit) (http://www.purearea.net/pb/CodeArchiv/G ... tArrows.pb)

Here comes my code - I think it's easy to understand what it does and in case you run into issues, just ask and I'll try to help

History:
20130622..first posted version
20130623..updated 'LvwGetText' because of memory leak (thanks little john!)
20130903..fixed a small bug in GetDateFormat (used %mm for minutes instead of the correct %ii - so sorting of datetime wasn't correct)

Found this bug during developing of my enhanced version - in case you're interested take a look here: http://www.purebasic.fr/english/viewtopic.php?t=56414

Code: Select all

EnableExplicit

Enumeration #PB_Compiler_EnumerationValue
  #MainWin
EndEnumeration

Enumeration #PB_Compiler_EnumerationValue
  #ListIcon
EndEnumeration

;- ++++++ ListIconGadget Tools Start ++++++

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

Procedure LIG_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
	lvc\mask = #LVCF_FMT
	lvc\fmt = format
	
	SendMessage_(GadgetID(gadget), #LVM_SETCOLUMN, index, @lvc)
EndProcedure

Procedure LIG_SetColumnWidth(gadget,index,new_width)
	; by Danilo, 15.12.2003 - english chat (for 'Karbon')
	;
	; change column header width
	;
	SendMessage_(GadgetID(gadget),#LVM_SETCOLUMNWIDTH,index,new_width)
EndProcedure

Procedure LIG_SetSortIcon(ListGadget.i, Column.i, SortOrder.i)
; http://stackoverflow.com/questions/254129/how-To-i-display-a-sort-arrow-in-the-header-of-a-List-view-column-using-c	
	Protected ColumnHeader.i
	Protected ColumnCount.i
	Protected hditem.HD_ITEM
	Protected Cnt.i
	
	ColumnHeader=SendMessage_(GadgetID(ListGadget), #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
EndProcedure
	
Procedure.b LIG_GetSortOrder(ListGadget.i, Column.i)
	Protected ColumnHeader.i
	Protected hditem.HD_ITEM
	Protected RetVal.b
	
	ColumnHeader=SendMessage_(GadgetID(ListGadget), #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
	
	ProcedureReturn RetVal

EndProcedure


Procedure LIG_EnsureVisible(Gadget.i, Line.i)
	; makes sure the line is visible
	
	SendMessage_(GadgetID(Gadget), #LVM_ENSUREVISIBLE, Line, #True)
	
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.
Structure LVWSORT
  hWndListView.l ; Fensterhandle des ListView-Controls
  SortKey.l ; Spalte, die sortiert werden soll
  SortType.b ; Typ der zu sortierenden Daten
  SortOrder.b ; Sortierrichtung
  DateFormat.s ; Mask for 'ParseDate'
EndStructure

Procedure.b IsNumChar(*Text, Position.i=1)
	Select Asc(PeekS(*Text+(Position-1)*SizeOf(Character), 1))
		Case 48 To 57
			ProcedureReturn #True
		Default
			ProcedureReturn #False
	EndSelect
	
EndProcedure

Procedure.l 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.l 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.l 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.l 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.l)
	; ' -----------------------------------------------------
	; ' 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.
	; ' -----------------------------------------------------
	
	; 20130623..nalor..Check if AllocateMemory succeeds
	;                  freememory at the end (kudos to 'Little John')
	
	Protected udtFindInfo.LV_FINDINFO
	Protected udtLVItem.LV_ITEM
	Protected lngIndex.l
	Protected *baBuffer
	Protected lngLength.l
	Protected 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)
	Else
		Debug "ERROR!! Allocating memory (LvwGetText)"
	EndIf
	
	ProcedureReturn RetVal
EndProcedure

Procedure.l CompareFunc(lParam1.l, lParam2.l, lParamSort.l)
	; ' -----------------------------------------------------
	; ' 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)+"%ii"
					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)+"%ii"
					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)+"%ii"+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)+"%ii"+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.l, SortKey.l, 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.i
	
	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 LIG_SortColumn(GadId.l, Column.l, OrderType.b=#SortAutoDetect)
	
	Protected ColCnt.i
	Protected Order.i
	Protected iStartT.i
	Protected iEndT.i
	Protected Temp.b
	
	Debug "LIG_SortColumn >"+Str(GadId)+"< Spalte >"+Str(Column)+"<"
	
	Select LIG_GetSortOrder(GadId, 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(GadId, 0, Column))
		If (OrderType=DetectOrderType(GetGadgetItemText(GadId, CountGadgetItems(GadId)-1, Column)))
			If (OrderType<>DetectOrderType(GetGadgetItemText(GadId, CountGadgetItems(GadId)/2, Column)))
				Debug "Different OrderType - use SortString 2"
				OrderType=#SortString
			EndIf
		Else
			Debug "Different OrderType - use SortString"
			OrderType=#SortString
		EndIf
	EndIf	
	
	SortListView(GadgetID(GadId), Column, OrderType, Order)
	
	iEndT=ElapsedMilliseconds()
	
	Debug "Dauer >"+StrF( (iEndT-iStartT)/1000, 2)+"<"
	
	LIG_SetSortIcon(GadId, Column, Order)
	
	If (GetGadgetState(GadId)>-1)
		LIG_EnsureVisible(GadId, GetGadgetState(GadId))
	EndIf
	
EndProcedure

;- ##### ListIconGadget Sort Ende ######

Procedure.b GetColumnOrderType(Gadget.i, Column.i)
	
	Protected OrderType.b
	
	OrderType=#SortAutoDetect
	
	Select Gadget
		Case #ListIcon
			Select Column
				Case 3
					OrderType=#SortNumeric
				Case 4
					OrderType=#SortFloat

			EndSelect
	EndSelect
			
	ProcedureReturn OrderType
	
EndProcedure

Procedure ColumnClickCallback(hWnd, uMsg, wParam, lParam)
	
	Protected *msg.NM_LISTVIEW

	If uMsg=#WM_NOTIFY
		*msg=lParam
		If *msg\hdr\code=#LVN_COLUMNCLICK							
			LIG_SortColumn(GetDlgCtrlID_(*msg\hdr\hwndfrom), *msg\iSubItem) ;, GetColumnOrderType(GetDlgCtrlID_(*msg\hdr\hwndfrom), *msg\iSubItem))
		EndIf
	EndIf
			
	ProcedureReturn #PB_ProcessPureBasicEvents
 
EndProcedure




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

;LIG_SortColumn(#ListIcon, 0)
	
SetWindowCallback(@ColumnClickCallback()) 

Repeat

	iEvent = WaitWindowEvent()
	iEventWindow=EventWindow()
	
	Select iEventWindow
		Case #MainWin
			If (Not MainWin_Events(iEvent))
				iCloseAll=#True
			EndIf
	EndSelect

Until iCloseAll=#True

Have fun with it!

electrochrisso · Post by **electrochrisso** » Sun Jun 23, 2013 1:41 am

Nice work nalor, very fast sorting.

rsts · Post by **rsts** » Sun Jun 23, 2013 1:56 am

Very nice.

Thanks for sharing

Zach · Post by **Zach** » Sun Jun 23, 2013 4:22 am

This is very nice. I might use this!

Little John · Post by **Little John** » Sun Jun 23, 2013 9:29 am

Thanks for sharing.

The code runs fine here with PB 5.11 on Windows XP x86 when compiled in Unicode mode. But in ASCII mode, the compiler crashes immediately.

nalor · Post by **nalor** » Sun Jun 23, 2013 9:58 am

@Little John:
Just tried it myself in Ascii mode and with nearly every combination of compiler-options but never got it to crash - all I noticed is without 'xp skin support' the arrows indicating the sort direction are not displayed... (but still doesn't crash)
Can you tell me more details about your crash in ascii mode or your specific options?

Thanks!

PS: Now I even tried it with Purebasic x64 5.11 with various compiler options and still not a single crash...

NicknameFJ · Post by **NicknameFJ** » Sun Jun 23, 2013 10:31 am

Hello,

The same problem like Little John described. In Ascii Mode the compiler crashes immediately; in Unicode mode no problem.

tested with WIN XP SP 3 (x86 32 bit) with PB 5.11

NicknameFJ

Little John · Post by **Little John** » Sun Jun 23, 2013 10:34 am

Hi,

now I've found out that it crashes here in ASCII mode if and only if the debugger is switched on. The other settings seem to be not important for this effect.

ts-soft · Post by **ts-soft** » Sun Jun 23, 2013 10:39 am

The crash comes only on WinXP in ASCII-Mode, not on newer Windows!
I think, it is a limitation of the old XP

NicknameFJ · Post by **NicknameFJ** » Sun Jun 23, 2013 10:40 am

Thank you Little John for your hint of running it with / without debugger.

Little John · Post by **Little John** » Sun Jun 23, 2013 10:43 am

NicknameFJ wrote:Thank you Little John for your hint of running it with / without debugger.

You are welcome. And I thank you for confirming the problem.

//edit:
I cannot reproduce the crash with PB 5.20 Beta 2!
So maybe it's a bug in the PB 5.11 debugger.

ts-soft · Post by **ts-soft** » Sun Jun 23, 2013 10:55 am

Little John wrote:I cannot reproduce the crash with PB 5.20 Beta 2!
So maybe it's a bug in the PB 5.11 debugger.

Okay, thanks for the info, on winxp i have only pb5.11, so the problem is not the xp.

Little John · Post by **Little John** » Sun Jun 23, 2013 12:14 pm

@nalor:
I think there is another issue.
The procedure LvwGetText() can cause a memory leak. Near the end of the procedure, there should be

Code: Select all

FreeMemory(*baBuffer)

shouldn't it?

nalor · Post by **nalor** » Sun Jun 23, 2013 1:19 pm

Hi Little John!
Your absolutely right - corrected the memory leak and updated the code in the first post.

I tried to reproduce your crash in a vmware winxp with purebasic 5.11, but still not luck - so I hope it's really just a debugger issue that occurs in some rare cases... at least I cannot reproduce it

NicknameFJ · Post by **NicknameFJ** » Sun Jun 23, 2013 1:49 pm

nalor wrote:[...] so I hope it's really just a debugger issue that occurs in some rare cases... [...]

tested it with the new 5.20 Beta2 (like Little John did before), no crash in Ascii mode nor unicode mode here, seems to be ok.

Obviously an debugger issue in PB 5.11 like nalor and Little John suspected

NicknameFJ

PureBasic Forums - English

ListIconGadget with Sort and Arrow Icons

ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons

Re: ListIconGadget with Sort and Arrow Icons