There are already many codes like this posted on the forum. I just tried to make something practical and robust that can work in as many contexts as possible (but only for Windows).
Highlights of this code:
- The callback implementation does not prevent other callbacks from being implemented for the same main window.
- No global variables are used, except for the CSLI_RemoveAccentsWhenSorting, CSLI_NoCaseSorting, CSLI_DateFormat$ and CSLI_DecimalSeparator$ parameters.
- Once this library is included in your project, only one line of code is needed to make a ListIconGadget sortable: MakeListIconSortable(NoGadget).
- Setgadgetitemdata can be used without problem in the rest of the code because it is not used by this library.
- It is possible to choose between sort icons on the left, sort icons above the titles and no sort icon.
- The code works on all versions of Windows from Windows XP to Windows 11 and with x86 and x64 systems.
- Date and time sorting works for all formats used in all countries (thanks to the help of forum members).
- Alphabetical sorting can be done with or without accents (for all accentuated languages) and with or without casing.
- Decimal and hexadecimal values are also sorted.
- The code is compact and fully commented.
- You can easily adapt the CSLI_ListIconSortCallback() procedure to sort 'exotic' data if needed.
To be sure to get the last version and discover other Zapman libraries, you can visit https://www.editions-humanis.com/downlo ... ads_EN.htm
Code: Select all
;*****************************************************************************
;
; ColumnSortedListIconGadget.pbi
; Zapman - March 2025-3 - Windows Only
;
; This file must be saved under the name 'ColumnSortedListIconGadget.pbi'
;
; This library provides functionality to add sorting capabilities
; to a ListIconGadget, including sorting based on ascending or descending
; order, and displaying arrows for sorting in the header.
; The library can also be used to remove accents from text for proper sorting.
;
;
; The main function of this library is MakeListIconSortable() which can accept
; four possible values as second parameter:
; #CSLI_NotSortable ; Reset the gadget to normal (not sortable).
; #CSLI_NoArrow ; Make the gadget sortable but don't show arrows.
; #CSLI_LeftArrows ; Show arrows on left side.
; #CSLI_TopArrows ; Show arrows above the column title.
;
; Many thanks for the forum members (ChrisR, Mesa, dcr3, Mindphazer, Lord,
; firace, ebs, Kwai chang caine, Quin) for their testing, help and suggestions.
;
;*****************************************************************************
;
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
;
;
; You can decide how you want the alphabetical sorts to be done:
;
Global CSLI_RemoveAccentsWhenSorting = #True
Global CSLI_NoCaseSorting = #True
;
;
; ****************************************************************************************
;
;- 1--- FIRST PART: MISCELLANEOUS FUNCTIONS (possibly reusable for other needs) ---
;
CompilerIf Not(Defined(RemoveAccents, #PB_Procedure))
Procedure.s RemoveAccents(Text$)
; Function to remove accents from a string. By Zapman.
If Text$
Protected length = Len(Text$) * 2
Protected OPos, NPos, DoubleLength
Protected NormalizedText$ = Space(Length)
;
; FoldString_() will replace each accentuated character by a pair of characteres
; as this: (NonAccentuatedCharactere) + (diacritic)
Length = FoldString_(#MAP_COMPOSITE, @Text$, - 1, @NormalizedText$, Length) - 1
;
; Examine the result:
If Length > 0 And Length <> Len(Text$)
DoubleLength = (Length - 1) * 2
For NPos = 0 To DoubleLength Step 2
If PeekC(@Text$ + OPos) <> PeekC(@NormalizedText$ + NPos)
; If the character has been replaced, replace it into the original text:
PokeC(@Text$ + OPos, PeekC(@NormalizedText$ + NPos))
; The following character contains the diacritic. Jump over it:
NPos + 2
EndIf
OPos + 2
Next
EndIf
;
ProcedureReturn Text$
EndIf
EndProcedure
CompilerEndIf
;
CompilerIf Not(Defined(GetLocalDateFormat, #PB_Procedure))
Procedure.s GetLocalDateFormat()
;
; Date format can change depending on the country when the program is running.
; The following attempts to prepare 'DateFormat$' reflecting the format locally used.
;
Protected DateFormat$ = Space(255) ; Create a buffer to get the local date format:
GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_SSHORTDATE, @DateFormat$, Len(DateFormat$))
; Depending on the country where your computer is runing, this API function will
; return something like "dd/MM/yyyy" (France and England) or "yyyy-MM-dd" (Canada) or "M/d/yyyy" (USA), etc.
;
Protected DateSeparator$ = Space(4) ; Create a buffer to get the local separator:
GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_SDATE, @DateSeparator$, Len(DateSeparator$))
; Depending on the country where your computer is runing, this API function will
; return something like "/" or "." or perhaps "-",...
;
; The date format now needs to be prepared to be used by PureBasic to correctly
; format the date:
;
; 1- Add the "%" caractere before days, month and years, conforming to the PureBasic needs:
DateFormat$ = "%" + LCase(ReplaceString(DateFormat$, DateSeparator$, DateSeparator$ + "%"))
; 2- If the format returned by the API function only uses one caractere for day and month,
; -> double it:
DateFormat$ = ReplaceString(DateFormat$, "%d" + DateSeparator$, "%dd" + DateSeparator$)
DateFormat$ = ReplaceString(DateFormat$, "%m" + DateSeparator$, "%mm" + DateSeparator$)
;
ProcedureReturn DateFormat$
;
EndProcedure
CompilerEndIf
;
CompilerIf Not(Defined(GetLocalDecimalSeparator, #PB_Procedure))
Procedure.s GetLocalDecimalSeparator()
; The decimal separator can change from one country to another.
; Get the local one:
Protected DecimalSeparator$ = Space(2) ; Create a buffer to get the local decimal separator
GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_SDECIMAL, @DecimalSeparator$, Len(DecimalSeparator$))
;
ProcedureReturn DecimalSeparator$
;
EndProcedure
CompilerEndIf
;
CompilerIf Not(Defined(ConvertHourFormats, #PB_Procedure))
Procedure.q ConvertHourFormats(Hour$)
;
; From an hour string formated as:
; 9:35
; 09:35
; 9:35:00
; 9h35
; 9 h 35 mn
; 9 Hr 35 Mn 12 sec.
; 9:35 AM
; 9h35PM
; -> returns the number of seconds from midnight.
;
; From an hour string formated as Sporty time (i.e. 3'40''80'''),
; -> value will be returned in hundredths of a second:
;
Protected APM, DH.q
;
If Right(UCase(Hour$),2) = "AM" Or Right(UCase(Hour$),2) = "PM"
If Right(UCase(Hour$),2) = "PM"
APM = 1
EndIf
Hour$ = Trim(Left(Hour$, Len(Hour$) - 2))
EndIf
;
Hour$ = ReplaceString(Hour$, " ", "")
Hour$ = ReplaceString(Hour$, ".", "")
;
Hour$ = ReplaceString(LCase(Hour$), "hr", ":")
Hour$ = ReplaceString(Hour$, "h", ":")
Hour$ = ReplaceString(Hour$, "mn", ":")
Hour$ = ReplaceString(Hour$, "m", ":")
Hour$ = ReplaceString(Hour$, "sec", "")
Hour$ = ReplaceString(Hour$, "s", "")
If Right(Hour$, 1) = ":"
Hour$ + "00"
EndIf
If CountString(Hour$, ":") = 1
Hour$ + ":00"
EndIf
DH = ParseDate("%hh:%ii:%ss", Hour$)
If DH <> -1
If APM
DH + ParseDate("%hh", "12")
EndIf
ElseIf FindString(Hour$, "'") And Val(ReplaceString(Hour$, "'", ""))
; Sporty time notation. Value will be returned in hundredths of a second
DH = 0
Protected posMin = FindString(Hour$, "'")
Protected posSec = FindString(Hour$, "''")
Protected posCent = FindString(Hour$, "'''")
Protected posDep = 0
If posMin = posSec : posMin = 0 : EndIf
If posSec = posCent : posSec = 0 : EndIf
;
If posCent = 0 : posCent = Len(Hour$) + 1 : EndIf
If posMin : posDep = posMin : EndIf
If posSec : posDep = posSec : EndIf
DH = Val(ReplaceString(Mid(Hour$, posDep), "'", ""))
Hour$ = Left(Hour$, posDep - 1)
;
If posSec = 0 : posSec = Len(Hour$) + 1 : EndIf
posDep = 0
If posMin : posDep = posMin : EndIf
DH + Val(ReplaceString(Mid(Hour$, posDep), "'", "")) * 100
Hour$ = Left(Hour$, posDep - 1)
;
DH + Val(ReplaceString(Hour$, "'", "")) * 6000
If DH = 0 : DH = -1 : EndIf
EndIf
ProcedureReturn DH
EndProcedure
CompilerEndIf
;
;
; ****************************************************************************************
;
;- 2--- SECOND PART: SPECIALIZED FUNCTIONS FOR THIS LIBRARY ---
;
; To sort items by dates, it is necessory to know how date's data is formatted.
; Date format can change depending on the country when the program is running.
; The following attempts to prepare a 'CSLI_DateFormat$' global variable reflecting
; the format locally used.
; But, eventually, you can run the program in France with data coming from US.
; So, you'll need to use a US date format even if you program is running in France.
; In that case, you'll have to use another manner to define CSLI_DateFormat$.
; i.e., you can do CSLI_DateFormat$ = "%mm/%dd/%yyyy" to force using US date format.
;
Global CSLI_DateFormat$ = GetLocalDateFormat()
Define Test = 5
Select Test
Case 1
CSLI_DateFormat$="%dd.%mm.%yyyy"
Case 2
CSLI_DateFormat$="%dd-%mm-%yyyy"
Case 3
CSLI_DateFormat$="%dd/%mm/%yyyy"
Case 4
CSLI_DateFormat$="%yyyy.%mm.%dd"
Case 5
CSLI_DateFormat$="%yyyy/%mm/%dd"
EndSelect
Global CSLI_DecimalSeparator$ = GetLocalDecimalSeparator()
;
;
; This library offers two different manners of showing the
; current sorting order for a column: showing a left up-down
; arrow or showing a top up-down arrow (or showing no-arrow,
; even if the data is sorted).
;
;
; Enumeration to define the type of arrows used to show the sorting order.
; You can use one of this value as a parameter when calling
; the 'MakeListIconSortable()' function:
Enumeration CSLI_GadgetSetting
#CSLI_NotSortable ; Reset the gadget to normal.
#CSLI_NoArrow ; Make the gadget sortable but don't show arrows.
#CSLI_LeftArrows ; Show arrows on left side.
#CSLI_TopArrows ; Show arrows above the column title.
EndEnumeration
;
; Enumeration to define the sort of a particular column.
; You can use one of this value as a parameter when calling
; the 'SortListIcon()' function:
Enumeration CSLI_SortType
#CSLI_Descent ; Ascending sort.
#CSLI_Ascent ; Descending sort.
#CSLI_Unsorted ; No sorting (default).
EndEnumeration
;
Procedure CSLI_CreateListIconArrows(ArrowType)
;
; Function to create sorting arrow images (Up, Down, and Up-Down arrows).
; This will be used for #CSLI_LeftArrows sorting.
;
Protected TSize = DesktopScaledX(16)
Protected ASize = TSize / 4
Protected SX = TSize / 2 - ASize
Protected SY = TSize / 2
Protected NewImage = CreateImage(#PB_Any, TSize, TSize, 32, #PB_Image_Transparent)
Protected VASize, Color
;
If NewImage
If ArrowType = #CSLI_Ascent ; UpArrow.
VASize = -ASize
ElseIf ArrowType = #CSLI_Descent ; DownArrow.
VASize = ASize
SY - ASize + 1
ElseIf ArrowType = #CSLI_Unsorted ; UpDownArrow.
VASize = ASize
SY = TSize / 2 + 1
EndIf
If StartDrawing(ImageOutput(NewImage))
;
DrawingMode(#PB_2DDrawing_AlphaBlend)
Box(0, 0, TSize, TSize, 0) ; Transparent background.
;
If ArrowType = #CSLI_Unsorted
Color = RGBA(192, 192, 192, 255) ; Gray for unsorted.
Else
Color = RGBA(1, 1, 1, 255) ; Quasi-Black for sorted arrows.
; A 'Full-Black' (0, 0, 0, 255) is not used because the FillArea()
; function doesn't work with full-black.
EndIf
;
Line(SX, SY, ASize * 2 + 1, 1, Color) ; Draw the arrow shape.
Line(SX, SY, ASize, VASize, Color)
Line(SX + ASize, SY + VASize, ASize, - VASize, Color)
FillArea(SX + ASize, SY + VASize / 2, Color, Color)
If ArrowType = #CSLI_Unsorted
; A double arrow (UpDown) is drawn for #CSLI_Unsorted.
SY - ASize + 1
VASize = -ASize
Line(SX, SY, ASize * 2 + 1, 1, Color)
Line(SX, SY, ASize, VASize, Color)
Line(SX + ASize, SY + VASize, ASize, - VASize, Color)
FillArea(SX + ASize, SY + VASize / 2, Color, Color)
EndIf
StopDrawing()
EndIf
ProcedureReturn NewImage
EndIf
EndProcedure
;
Procedure CSLI_CreateListIconImgList(LIHandle)
;
; Function to create an image list for the ListIcon header.
; This will be used for #CSLI_LeftArrows sorting.
;
Protected hHeader, hImgL, ct, Img
;
If IsGadget(LIHandle)
LIHandle = GadgetID(LIHandle) ; Get the control handle from the gadget's num.
EndIf
;
hHeader = SendMessage_(LIHandle, #LVM_GETHEADER, 0, 0)
If SendMessage_(hHeader, #HDM_GETIMAGELIST, 0, 0) = 0
hImgL = ImageList_Create_(16, 16, #ILC_COLOR32 | #ILC_MASK, 0, 0)
For ct = #CSLI_Descent To #CSLI_Unsorted
Img = CSLI_CreateListIconArrows(ct)
ImageList_Add_(hImgL, ImageID(Img), 0)
; Microsoft doc says to free the original image after adding it to the image list.
FreeImage(Img)
Next
SendMessage_(hHeader, #HDM_SETIMAGELIST, 0, hImgL)
EndIf
EndProcedure
;
Procedure CSLI_FreeImageListFromGadget(LIHandle)
;
; Destroy both image lists of a ListIconGadget.
;
; Retrieve and destroy the ImageList for list items (row icons)
Protected hImageList, hHeader, hHeaderImageList
;
hImageList = SendMessage_(LIHandle, #LVM_GETIMAGELIST, #LVSIL_NORMAL, 0)
If hImageList
ImageList_Destroy_(hImageList)
SendMessage_(LIHandle, #LVM_SETIMAGELIST, #LVSIL_NORMAL, 0)
EndIf
;
; Retrieve the handle of the header control
hHeader = SendMessage_(LIHandle, #LVM_GETHEADER, 0, 0)
If hHeader
; Retrieve and destroy the ImageList for the header (column icons)
hHeaderImageList = SendMessage_(hHeader, #HDM_GETIMAGELIST, 0, 0)
If hHeaderImageList
ImageList_Destroy_(hHeaderImageList)
SendMessage_(hHeader, #HDM_SETIMAGELIST, 0, 0)
EndIf
EndIf
EndProcedure
; Define structure for sorting information.
Structure SortInfoStruct
GadgetHandle.i
Column.l
AscentDescent.l
EndStructure
;
Procedure CSLI_ListIconSortCallback(item1, item2, *SortInfo.SortInfoStruct)
;
; Sorting callback function used by the ListIcon to compare items.
; (You can eventually complete or adapt this procedure to sort exotic data values
; using a particular manner).
;
Protected A$ = Space(200), B$ = Space(200), A2$, B2$, lvi.LV_ITEM
Protected A.q = 0, B.q = 0, DA.q = 0, DB.q = 0
Protected result = 0, AscentDescent
;
lvi\iSubItem = *SortInfo\Column
lvi\pszText = @A$
lvi\cchTextMax = 200
SendMessage_(*SortInfo\GadgetHandle, #LVM_GETITEMTEXT, item1, @lvi)
lvi\pszText = @B$
SendMessage_(*SortInfo\GadgetHandle, #LVM_GETITEMTEXT, item2, @lvi)
;
If A$ = B$
ProcedureReturn 0 ; Items are equal.
EndIf
;
; Determine if sorting is ascending or descending.
If *SortInfo\AscentDescent = #CSLI_Descent : AscentDescent = -1 : Else : AscentDescent = 1 : EndIf
;
; Analysis of the string:
; For non-english countries, the decimal separator is not necessary
; a point. If it is not, replace the used one by a point:
A$ = ReplaceString(A$, CSLI_DecimalSeparator$, ".")
B$ = ReplaceString(B$, CSLI_DecimalSeparator$, ".")
;
; Decide if the string represents a numeric value,
; even if it is equal to "0"
If FindString(A$, "0")
A2$ = ReplaceString(A$, "0", "")
If A2$ = "" Or A2$ = "." Or A2$ = "$" ; <- $ is used for hexadecimal values.
A$ = "0"
EndIf
EndIf
;
If FindString(B$, "0")
B2$ = ReplaceString(B$, "0", "")
If B2$ = "" Or B2$ = "." Or B2$ = "$" ; <- $ is used for hexadecimal values.
B$ = "0"
EndIf
EndIf
;
If A$ = "0" Or B$ = "0" Or Abs(Val(A$)) > 0 Or Abs(Val(B$)) > 0
A = Val(A$)
B = Val(B$)
EndIf
;
If Abs(ValF(A$)) > Abs(A) Or Abs(ValF(B$)) > Abs(B)
A = ValF(A$)
B = ValF(B$)
EndIf
;
If Abs(ValD(A$)) > Abs(A) Or Abs(ValD(B$)) > Abs(B)
A = ValD(A$)
B = ValD(B$)
EndIf
;
DA = ParseDate(CSLI_DateFormat$, A$)
DB = ParseDate(CSLI_DateFormat$, B$)
If DA <> -1 Or DB <> -1
; Date sorting:
If DA > DB
Result = AscentDescent
Else
Result = -AscentDescent
EndIf
ProcedureReturn result
EndIf
;
DA = ConvertHourFormats(A$)
DB = ConvertHourFormats(B$)
;
If DA <> -1 Or DB <> -1
; Hour sorting:
If DA > DB
Result = AscentDescent
Else
Result = -AscentDescent
EndIf
ProcedureReturn result
EndIf
;
If (Abs(A) > 0 Or A$ = "0") And (Abs(B) > 0 Or B$ = "0")
; Numerical sorting:
If A > B Or ValF(A$) > ValF(B$)
Result = AscentDescent
Else
Result = -AscentDescent
EndIf
;
Else
; Alphabetical sorting:
If CSLI_RemoveAccentsWhenSorting
A$ = RemoveAccents(A$)
B$ = RemoveAccents(B$)
EndIf
If CSLI_NoCaseSorting
A$ = LCase(A$)
B$ = LCase(B$)
EndIf
If A$ > B$
Result = AscentDescent
Else
Result = -AscentDescent
EndIf
EndIf
;
ProcedureReturn result
EndProcedure
;
Procedure CLSI_GetSortOrderFromTopIcon(LIHandle, Column.i)
; https://www.purebasic.fr/english/viewtopic.php?t=55085
;
; This library offers two different manners of showing the
; current sorting order for a column: showing a left up-down
; arrow or showing a top up-down arrow (or showing no-arrow,
; even if the data is sorted).
;
; When a top up-down arrow is used, this procedure will
; retreive if it is actually the top arrow or the down arrow
; which is used.
;
Protected ColumnHeader.i
Protected hditem.HD_ITEM
Protected RetVal
;
ColumnHeader = SendMessage_(LIHandle, #LVM_GETHEADER, 0, 0)
hditem\mask = #HDI_FORMAT
If SendMessage_(ColumnHeader, #HDM_GETITEM, Column, @hditem)
If (hditem\fmt & #HDF_SORTUP) = #HDF_SORTUP
RetVal = #CSLI_Ascent
ElseIf (hditem\fmt & #HDF_SORTDOWN) = #HDF_SORTDOWN
RetVal = #CSLI_Descent
Else
RetVal = #CSLI_Unsorted
EndIf
EndIf
;
ProcedureReturn RetVal
;
EndProcedure
;
Procedure CLSI_SetTopSortingIcon(LIHandle, 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
;
; This library offers two different manners of showing the
; current sorting order for a column: showing a left up-down
; arrow or showing a top up-down arrow (or showing no-arrow,
; even if the data is sorted).
;
; When a top up-down arrow is used, this procedure will
; set the up arrow or the down arrow depending of the value
; of the 'SortOrder' parameter.
;
Protected ColumnHeader.i
Protected ColumnCount.i
Protected hditem.HD_ITEM
Protected Cnt.i
;
ColumnHeader = SendMessage_(LIHandle, #LVM_GETHEADER, 0, 0)
ColumnCount = SendMessage_(ColumnHeader, #HDM_GETITEMCOUNT, 0, 0)
;
For Cnt = 0 To ColumnCount - 1
hditem\mask = #HDI_FORMAT
SendMessage_(ColumnHeader, #HDM_GETITEM, Cnt, @hditem)
;
If (Cnt = Column And SortOrder <> #CSLI_UnSorted)
Select SortOrder
Case #CSLI_Ascent
hditem\fmt & ~#HDF_SORTDOWN
hditem\fmt | #HDF_SORTUP
Case #CSLI_Descent
hditem\fmt & ~#HDF_SORTUP
hditem\fmt | #HDF_SORTDOWN
EndSelect
Else
hditem\fmt & ~#HDF_SORTUP
hditem\fmt & ~#HDF_SORTDOWN
EndIf
;
SendMessage_(ColumnHeader, #HDM_SETITEM, Cnt, @hditem)
;
Next
EndProcedure
;
Procedure CSLI_ListIconHideHeaderImages(LIHandle, NColumn = -1)
;
; Hide images in the ListIcon header (useful when arrows are hidden).
; It will keep all other values stored in the column's header by #LVM_SETCOLUMN
; (inclusing index of the current image for each column), but no image will be shown.
;
; If NColumn <> -1, only the specified column is set. Else, all columns
; of the gadget are set.
;
Protected LVC.LVCOLUMN, Column, Res
;
If IsGadget(LIHandle)
LIHandle = GadgetID(LIHandle) ; Get the control handle from the gadget's num.
EndIf
;
If NColumn = -1
Column = 0
Else
Column = NColumn
EndIf
;
Repeat
; Hide images
LVC\mask = #LVCF_FMT
Res = SendMessage_(LIHandle, #LVM_GETCOLUMN, Column, @LVC)
If Res
LVC\fmt & ~#LVCFMT_IMAGE | #LVCFMT_COL_HAS_IMAGES
LVC\iImage = 0
SendMessage_(LIHandle, #LVM_SETCOLUMN, Column, @LVC)
EndIf
;
CLSI_SetTopSortingIcon(LIHandle, Column, #CSLI_UnSorted)
;
Column + 1
Until Res = 0 Or NColumn <> -1
;
EndProcedure
;
; Declare SortListIcon procedure:
Declare SortListIcon(LIHandle, column, AscentDescent)
;
Procedure CSLI_WinLIProc(hWnd, uMsg, wParam, lParam)
;
; Window callback procedure to handle ListIcon sorting interaction.
;
Protected NColumn, LVC.LVCOLUMN, LIHandle, AscentDescent
Protected *NMHDR.NMHDR, *NMLV.NMLISTVIEW
;
Select uMsg
Case #WM_NOTIFY
*NMHDR = lParam
If GetProp_(*NMHDR\hWndFrom, "CSLI_Sort")
; Handle sort operations on column click:
If *NMHDR\code = #LVN_COLUMNCLICK
*NMLV = lParam
LIHandle = *NMHDR\hWndFrom
;
If GetProp_(LIHandle, "CSLI_ShowArrow") = #CSLI_TopArrows
; Retrieve the actual sorting order from the top up-down arrow
; actually shown:
AscentDescent = CLSI_GetSortOrderFromTopIcon(LIHandle, *NMLV\iSubItem)
Else
; Retrieve the actual sorting order from the actual image-index
; used to show the left arrow:
LVC\mask = #LVCF_IMAGE
SendMessage_(LIHandle, #LVM_GETCOLUMN, *NMLV\iSubItem, @LVC)
AscentDescent = LVC\iImage
;
; Set image-index to UpDown for all columns:
While SendMessage_(LIHandle, #LVM_GETCOLUMN, NColumn, @LVC)
LVC\iImage = #CSLI_Unsorted
SendMessage_(LIHandle, #LVM_SETCOLUMN, NColumn, @LVC)
NColumn + 1
Wend
;
If GetProp_(LIHandle, "CSLI_ShowArrow") <> #CSLI_LeftArrows
; If CSLI_ShowArrow is not set, hide the images:
CSLI_ListIconHideHeaderImages(LIHandle)
EndIf
EndIf
;
; Switch the index:
If AscentDescent = #CSLI_Ascent
AscentDescent = #CSLI_Descent
Else
AscentDescent = #CSLI_Ascent
EndIf
;
; Sort and update the icon for the clicked column.
SortListIcon(LIHandle, *NMLV\iSubItem, AscentDescent)
;
ElseIf *NMHDR\code = #LVN_DELETEALLITEMS
; The ListIcon gadget is being destroyed.
; Clean the memory from images:
CSLI_FreeImageListFromGadget(*NMHDR\hWndFrom)
EndIf
EndIf
EndSelect
;
Protected CSLI_OldCallBack = GetProp_(hWnd, "CSLI_OldCallBack")
ProcedureReturn CallWindowProc_(CSLI_OldCallBack, hWnd, uMsg, wParam, lParam)
EndProcedure
;
Procedure CSLI_InitializeSortableListIcon(LIHandle, Sortable = #True)
;
; Initialyze all the needed values of 'LIHandle' to allow it
; to be sortable.
;
Protected LVC.LVCOLUMN, NColumn
;
If Sortable ; Check if sorting should be enabled.
SetProp_(LIHandle, "CSLI_Sort", 1) ; Store the sorting state in the ListIcon handle property.
; This will allow to know that this gadget had been made sortable.
If GetProp_(LIHandle, "CSLI_ShowArrow") < #CSLI_TopArrows
; The left sorting arrows will be used.
CSLI_CreateListIconImgList(LIHandle); Create the image list for left sorting arrows icons.
If GetProp_(LIHandle, "CSLI_ShowArrow") = #CSLI_NoArrow ; If CSLI_ShowArrow is not set, hide the header images.
CSLI_ListIconHideHeaderImages(LIHandle)
ElseIf GetProp_(LIHandle, "CSLI_ShowArrow") = #CSLI_LeftArrows ; If the left sorting ShowArrows flag is enabled..
NColumn = 0
LVC\mask = #LVCF_IMAGE
While SendMessage_(LIHandle, #LVM_GETCOLUMN, NColumn, @LVC)
LVC\mask = #LVCF_IMAGE ; Set the column to use image (for sorting arrows).
LVC\iImage = #CSLI_Unsorted ; Set the initial sorting state as unsorted.
SendMessage_(LIHandle, #LVM_SETCOLUMN, NColumn, @LVC) ; Set the column information.
NColumn + 1
Wend
EndIf
EndIf
;
Protected hWnd = GetAncestor_(LIHandle, #GA_ROOT) ; Get the root window handle for the ListIcon.
Protected CSLI_OldCallBack = GetProp_(hWnd, "CSLI_OldCallBack") ; Retrieve the CSLI_OldCallBack procedure if any.
If CSLI_OldCallBack = 0 ; If there's no existing CSLI_OldCallBack, set it:
CSLI_OldCallBack = SetWindowLongPtr_(hWnd, #GWL_WNDPROC, @CSLI_WinLIProc()) ; Set a custom window procedure.
SetProp_(hWnd, "CSLI_OldCallBack", CSLI_OldCallBack) ; Store the Oldcallback procedure address.
EndIf
Else ; If sorting is disabled
CSLI_ListIconHideHeaderImages(LIHandle) ; Hide any header images.
CSLI_FreeImageListFromGadget(LIHandle) ; Free the image list from the gadget.
hWnd = GetAncestor_(LIHandle, #GA_ROOT) ; Get the root window handle for the ListIcon.
CSLI_OldCallBack = GetProp_(hWnd, "CSLI_OldCallBack") ; Retrieve the old callback procedure.
If CSLI_OldCallBack And GetWindowLongPtr_(hWnd, #GWL_WNDPROC) = @CSLI_WinLIProc()
; If there was a custom callback set earlier,
; reset to standard management:
SetWindowLongPtr_(hWnd, #GWL_WNDPROC, CSLI_OldCallBack) ; Restore the original window procedure.
RemoveProp_(hWnd, "CSLI_OldCallBack") ; Remove the stored callback address.
EndIf
RemoveProp_(LIHandle, "CSLI_Sort") ; Signal that the gadget is no longer sortable.
EndIf
EndProcedure
;
;
; ****************************************************************************************
;
;- 3--- THIRD PART: MAIN FUNCTIONS OF THIS LIBRARY ---
;
; ****************************************************************************************
;
Procedure MakeListIconSortable(GadgetNum, Setting = #CSLI_LeftArrows)
;
; Hide or show the sorting arrows in the header of 'LIHandle' gadget.
;
; The 'Setting' parameter can be:
; #CSLI_NotSortable ; Reset the gadget to normal (not sortable).
; #CSLI_NoArrow ; Make the gadget sortable but don't show arrows.
; #CSLI_LeftArrows ; Show arrows on left side.
; #CSLI_TopArrows ; Show arrows above the column title.
;
If IsGadget(GadgetNum)
Protected LIHandle = GadgetID(GadgetNum) ; Get the control handle from the gadget's num.
Else
LIHandle = GadgetNum
GadgetNum = GetProp_(LIHandle, "PB_ID") ; Get the gadget's num from its handle.
EndIf
;
If IsGadget(GadgetNum) And GadgetType(GadgetNum) = #PB_GadgetType_ListIcon ; Ensure it's a valid ListIcon gadget.
;
CSLI_InitializeSortableListIcon(LIHandle, #False) ; Reset the ListIcon with no arrows setting.
;
If Setting <> #CSLI_NotSortable
SetProp_(LIHandle, "CSLI_ShowArrow", Setting) ; Store whether the sorting arrows should be shown at left, at top, or hidden.
CSLI_InitializeSortableListIcon(LIHandle, #True); Initialize the ListIcon with the updated sorting arrows setting.
EndIf
EndIf
;
EndProcedure
;
Procedure GetLastSortingColumn(GadgetNum)
ProcedureReturn GetProp_(GadgetID(GadgetNum), "CSLI_LastSortingColumn")
EndProcedure
;
Procedure GetLastSortingAscentDescent(GadgetNum)
ProcedureReturn GetProp_(GadgetID(GadgetNum), "CSLI_LastSortingAscentDescent")
EndProcedure
;
Procedure SortListIcon(GadgetNum, column, AscentDescent)
;
; Sort the whole content of a ListIconGadget from one column values.
;
; column : from 0 to the last column number.
; AscentDescent : #CSLI_Descent for descending, #CSLI_Ascent for ascending
;,,
Protected SortInfo.SortInfoStruct, LVC.LVCOLUMN
;
If IsGadget(GadgetNum)
Protected LIHandle = GadgetID(GadgetNum) ; Get the control handle from the gadget's num.
Else
LIHandle = GadgetNum
GadgetNum = GetProp_(LIHandle, "PB_ID") ; Get the gadget's num from its handle.
EndIf
;
If IsGadget(GadgetNum) And GadgetType(GadgetNum) = #PB_GadgetType_ListIcon ; Ensure it's a ListIcon gadget
;
; Memorize the used parameter:
SetProp_(LIHandle, "CSLI_LastSortingColumn", column)
SetProp_(LIHandle, "CSLI_LastSortingAscentDescent", AscentDescent)
;
; Initialize the ListIcon gadget with sorting enabled:
CSLI_InitializeSortableListIcon(GadgetNum)
;
SortInfo\GadgetHandle = LIHandle ; Store the gadget handle in the sorting structure.
SortInfo\Column = column ; Store the column to be sorted in the sorting structure.
SortInfo\AscentDescent = AscentDescent ; Store the sorting order (ascending or descending).
SendMessage_(LIHandle, #LVM_SORTITEMSEX, @SortInfo, @CSLI_ListIconSortCallback()) ; Perform the sorting using the callback function.
;
If GetProp_(LIHandle, "CSLI_ShowArrow") = #CSLI_TopArrows ; The top arrows will be shown:
CLSI_SetTopSortingIcon(LIHandle, column, AscentDescent)
Else ; The image-index will be uddated:
; Update the image index for the column to reflect the sorting order:
LVC\mask = #LVCF_IMAGE ; Set the column to use an image (for the sorting left arrow).
LVC\iImage = AscentDescent ; Set the image index based on the sorting order.
SendMessage_(LIHandle, #LVM_SETCOLUMN, column, @LVC) ; Set the updated column information.
EndIf
;
If GetProp_(LIHandle, "CSLI_ShowArrow") = #CSLI_NoArrow ; If the image must be hidden...
; The following will keep the value stored in the column by the preceeding #LVM_SETCOLUMN message
; (index of the current image for the column), but no image will be shown.
CSLI_ListIconHideHeaderImages(LIHandle, column)
;
EndIf
;
ProcedureReturn #True ; Return True to indicate success.
EndIf
;
EndProcedure
;
; ****************************************************************************************
;
;- 4--- FORTH PART: DEMO PROCEDURE ---
;
; ****************************************************************************************
;
CompilerIf #PB_Compiler_IsMainFile
; The following won't run when this file is used as 'Included'.
Define HWindow = OpenWindow(#PB_Any, 0, 0, 550, 280, "Sortable ListIconGadget demo", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;
Define ListIconGagdet = ListIconGadget(#PB_Any, 0, 0, WindowWidth(HWindow), 225, "", 0, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
;
AddGadgetColumn(ListIconGagdet, 0, "Alpha", 70)
SetGadgetItemAttribute(ListIconGagdet, 0, #PB_ListIcon_ColumnAlignment, #PB_ListIcon_Center, 0)
AddGadgetColumn(ListIconGagdet, 1, "Integer", 70)
AddGadgetColumn(ListIconGagdet, 2, "Decimal", 80)
AddGadgetColumn(ListIconGagdet, 3, "Hexa", 80)
AddGadgetColumn(ListIconGagdet, 4, "Dates", 80)
AddGadgetColumn(ListIconGagdet, 5, "Hours", 80)
AddGadgetColumn(ListIconGagdet, 6, "Sporty", 80)
SetGadgetItemAttribute(ListIconGagdet, 0, #PB_ListIcon_ColumnAlignment, #PB_ListIcon_Center, 6)
;
Define ct
For ct = 1 To 5
SetGadgetItemAttribute(ListIconGagdet, 0, #PB_ListIcon_ColumnAlignment, #PB_ListIcon_Right, ct)
Next
;
Define mDate.q = Date()
Define Line$
Define AlphaList$ = "élève,devant,front,Absent,Column,Final,tirant,global,$,"
Define HourList$ = "12:30:20,12:30:00,12:30,18:10,6:00 PM,11:00 AM,9:45:15,8:45,16h30mn,"
Define SportyTimeList$ = "30'',5'20'',1'14''80''',1'14,5'80''',20'',10'50'',4'40''30''',90'''"
For ct = 1 To 9
Line$ = StringField(AlphaList$, ct, ",") + Chr(10)
Line$ + Str(Random($FFFF)) + Chr(10)
Line$ + StrF(Random($FFFFFF)/10000, 3) + Chr(10)
Line$ + "$" + RSet(Hex(Random($7FFFFFFF)), 8, "0") + Chr(10)
Line$ + FormatDate(CSLI_DateFormat$, mDate) + Chr(10)
mDate + 100000
Line$ + StringField(HourList$, ct, ",") + Chr(10)
Line$ + StringField(SportyTimeList$, ct, ",") + Chr(10)
AddGadgetItem(ListIconGagdet, - 1, Line$)
Next
;
Define NotSortableOption = OptionGadget(#PB_Any, 15, WindowHeight(HWindow) - 50, 140, 22, "Reset to not sortable")
Define DontShowArrowsOption = OptionGadget(#PB_Any, 190, WindowHeight(HWindow) - 50, 150, 22, "Sortable with no arrows")
Define ShowLeftArrowsOption = OptionGadget(#PB_Any, 375, WindowHeight(HWindow) - 50, 150, 22, "Sortable with left arrows")
Define ShowTopArrowsOption = OptionGadget(#PB_Any, 15, WindowHeight(HWindow) - 30, 400, 22, "Sortable with top arrows (when clicked) - (XP compatible)")
SetGadgetState(ShowLeftArrowsOption, 1)
:
;
MakeListIconSortable(ListIconGagdet, #CSLI_LeftArrows) ; <-- This is the only line you need to make the gadget sortable.
;
; But you can also decide to sort the gadget by default from one column content:
SortListIcon(ListIconGagdet, 0, #CSLI_Ascent)
;
Repeat
Define Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case NotSortableOption
MakeListIconSortable(ListIconGagdet, #CSLI_NotSortable)
Case DontShowArrowsOption
MakeListIconSortable(ListIconGagdet, #CSLI_NoArrow)
Case ShowLeftArrowsOption
MakeListIconSortable(ListIconGagdet, #CSLI_LeftArrows)
Case ShowTopArrowsOption
MakeListIconSortable(ListIconGagdet, #CSLI_TopArrows)
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
CompilerEndIf
