Seite 1 von 1

ListIconGadget sortieren

Verfasst: 16.09.2013 16:11
von hjbremer
Hier mal eine Demo, Erklärungen im Code

Code: Alles auswählen

; by HJBremer Purebasic 5.20 - Windows x86 - September 2013

; Basis dieses Moduls sind Codes von nalor und bisonte aus dem englischen Forum
; Beide Vorbilder gefallen mir aber nicht. Sie basieren auf einem Beispielcode
; von http://msdn.microsoft.com/de-de/library/bb979183.aspx
; Positiv an den Beispielen sind Idee und die Verwendung von #LVM_SORTITEMSEX. 

; Ganz besonders die verwendete Autodetect Funktion ist mir nicht flexibel genug. 
; Ich habe darum Autodetect durch ein globales Feld und ListIconSetColumnTyp() ersetzt.
; Vorteil: einfach, sicher und flexibel bzw. erweiterbar.
; Nachteil: Wer verschieben von Spalten erlaubt, muß den Code erweitern und ev. den lParam 
; Wert von #HDM_GETITEM/#HDM_SETITEM benutzen um TypDaten (falls vorhanden) einer Spalte mit 
; zuverschieben und diesen Wert vorm Sortieren dann auswerten. Meistens wohl nicht der Fall.


DeclareModule ListIconSort
   
   Enumeration Sorttyp
      #ListIconSort_Char
      #ListIconSort_Date
      #ListIconSort_Float
      #ListIconSort_Numeric
   EndEnumeration
   
   Structure LvSortInfo
      lvnr.i         ; PB Gadgednr
      lvid.i         ; GadgedId 
      column.i       ; Spalte
      sorttyp.i      ; Datentyp
      direction.i    ; Sortierrichtung
      datemask.s     ; Mask für ParseDate()
   EndStructure
   
   Declare ListIconSortcolumn(lvnr, column, direction)
   Declare ListIconSetColumnTyp(lvnr, column, typ, datemask.s = "")
   
EndDeclareModule

Module ListIconSort
   
   EnableExplicit
   
   Global sortinfoidx
   Global Dim sortinfo.LvSortInfo(0)
   
   Global cursor_original = GetClassLong_(GetDesktopWindow_(), #GCL_HCURSOR) 
   Global cursor_sanduhr  = LoadCursor_(0, #IDC_WAIT) 
   
   Procedure.i ListIconSetColumnTyp(lvnr, column, sorttyp, datemask.s = "")
      
      ;Procedure dient dazu, der SortierVergleichsfunktion Zugriff auf Eigenschaften
      ; einer Spalte zu ermöglichen. z.B. Datentyp wie Zahlen oder Datum etc.
      ; Die Structur kann fast beliebig erweitert werden.
      
      ;column ab null gezählt !
      ;sortinfoidx = 0 wird für Spalten genutzt, welche keinen Typ haben
      
      sortinfoidx + 1               ;Global in diesem Modul
      ReDim sortinfo(sortinfoidx)   ;Global in diesem Modul
      
      sortinfo(sortinfoidx)\lvnr = lvnr
      sortinfo(sortinfoidx)\lvid = GadgetID(lvnr)
      
      sortinfo(sortinfoidx)\column = column
      sortinfo(sortinfoidx)\sorttyp = sorttyp
      sortinfo(sortinfoidx)\datemask = datemask
      
   EndProcedure
   
   Procedure.i ListIconCompareFunc(lParam1, lParam2, lParamSort)
      ; dies ist die Vergleichsfunktion von #LVM_SORTITEMSEX

      ; lParam1 und lParam2 sind die Itemnummern welche verglichen werden
      ; der Rückgabewert des Vergleichs ist -1, +1 oder 0
      
      ; lParamSort ist der Pointer der bei Aufruf von #LVM_SORTITEMSEX übergeben wurde
      
      Static subitem1.s    ;Static beschleunigt das Vergleichen minimal
      Static subitem2.s    
      Static result
      
      Protected *lvs.LvSortInfo = lParamSort
      
      With *lvs
         
         subitem1 = GetGadgetItemText(\lvnr, lParam1, \column)
         subitem2 = GetGadgetItemText(\lvnr, lParam2, \column)
         
         ;beide Subitems gleich
         If subitem1 = subitem2
            result = 0
            ProcedureReturn result
         EndIf
         
         Select \sorttyp
               
            Case #ListIconSort_Numeric
               result = 1
               If \direction = #PB_Sort_Ascending
                  If Val(subitem1) < Val(subitem2)
                     result = -1
                  EndIf
               Else 
                  If Val(subitem2) < Val(subitem1)
                     result = -1
                  EndIf
               EndIf
               
            Case #ListIconSort_Float
               ReplaceString(subitem1, ",", ".", #PB_String_InPlace) ;Zeitverlust durch Replace 
               ReplaceString(subitem2, ",", ".", #PB_String_InPlace) ;beträgt ca 3-5%
               result = 1
               If \direction = #PB_Sort_Ascending
                  If ValF(subitem1) < ValF(subitem2)
                     result = -1
                  EndIf
               Else 
                  If ValF(subitem2) < ValF(subitem1)
                     result = -1
                  EndIf
               EndIf                 
               
            Case #ListIconSort_Date
               result = 1
               If \direction = #PB_Sort_Ascending
                  If ParseDate(\datemask, subitem1) < ParseDate(\datemask, subitem2)
                     result = -1
                  EndIf
               Else
                  If ParseDate(\datemask, subitem2) < ParseDate(\datemask, subitem1)
                     result = -1
                  EndIf
               EndIf 
               
            Default  ;Character
               ;result ist 1 oder -1
               If \direction = #PB_Sort_Ascending  ;Aufsteigende Sortierung
                  result = CompareMemoryString(@subitem1, @subitem2, #PB_String_CaseSensitive)
               Else
                  result = CompareMemoryString(@subitem2, @subitem1, #PB_String_CaseSensitive)
               EndIf             
               
         EndSelect

      EndWith
      
      ProcedureReturn result
   EndProcedure
   
   Procedure.i ListIconSortcolumn(lvnr, column, direction)
      
      Protected j, sortinfopointer = 0
      
      ;durchsucht das globale Sortinfofeld nach lvnr und column
      ;um die zugehörige DatenStructur dem InfoPointer zuzuweisen.
      ;diese Daten wurden mit ListIconSetColumnTyp() definiert.
      For j = 1 To sortinfoidx
         If sortinfo(j)\lvnr = lvnr
            If sortinfo(j)\column = column
               sortinfo(j)\direction = direction
               sortinfopointer = @sortinfo(j)
               Break
            EndIf
         EndIf
      Next
      
      If sortinfopointer = 0          
         ;Spalte nicht definiert mit ListIconSetColumnTyp()
         sortinfo(0)\lvnr = lvnr
         sortinfo(0)\lvid = GadgetID(lvnr)
         sortinfo(0)\direction = direction
         sortinfo(0)\column = column
         sortinfo(0)\sorttyp = #ListIconSort_Char
         sortinfo(0)\datemask = ""
         sortinfopointer = @sortinfo(0)
      EndIf
      
      DisableGadget(lvnr, 1)
      SetCursor_(cursor_sanduhr): ShowCursor_(#True)   

      SendMessage_(GadgetID(lvnr), #LVM_SORTITEMSEX, sortinfopointer, @ListIconCompareFunc())
      
      DisableGadget(lvnr, 0)     
      SetCursor_(cursor_original): ShowCursor_(#True)
   
      SetGadgetState(lvnr, GetGadgetState(lvnr))
      
   EndProcedure
   
EndModule

UseModule ListIconSort



;--- Example

CompilerIf #PB_Compiler_IsMainFile
   
   Enumeration 
      #window
      #liste
      #info
   EndEnumeration
   
   Procedure.i WindowCallback(hWnd, uMsg, wParam, lParam)
      
      ;dient hier im Beispiel nur dazu den Click auf den Header abzufangen
      
      Protected *nml.NM_LISTVIEW
      
      If uMsg = #WM_NOTIFY
         *nml = lParam
         If *nml\hdr\code = #LVN_COLUMNCLICK
            
            Protected timeend, timestart = ElapsedMilliseconds()
      
            Protected lvnr = *nml\hdr\idFrom    ;PB Gadgetnr
            Protected column = *nml\iSubItem
            Protected header = SendMessage_(*nml\hdr\hwndFrom, #LVM_GETHEADER, 0, 0)
            Protected colscount = SendMessage_(header, #HDM_GETITEMCOUNT, 0, 0) - 1
            
            Protected hditem.HD_ITEM
            Protected j, sortdirection
            
            ;alle Pfeile löschen, außer gewählte Spalte
            hditem\mask = #HDI_FORMAT
            For j = 0 To colscount
               If j <> column    
                  SendMessage_(header, #HDM_GETITEM, j, hditem)
                  hditem\fmt & ~ (#HDF_SORTDOWN | #HDF_SORTUP)
                  SendMessage_(header, #HDM_SETITEM, j, hditem)
               EndIf
            Next
            ;gewählte Spalte Pfeil setzen
            SendMessage_(header, #HDM_GETITEM, column, hditem)
            If hditem\fmt & #HDF_SORTDOWN                              
               hditem\fmt & ~ #HDF_SORTDOWN        ;löschen
               hditem\fmt | #HDF_SORTUP            ;setzen 
               sortdirection = #PB_Sort_Ascending 
            Else
               hditem\fmt & ~ #HDF_SORTUP
               hditem\fmt | #HDF_SORTDOWN 
               sortdirection = #PB_Sort_Descending
            EndIf
            SendMessage_(header, #HDM_SETITEM, column, hditem)
            ;Sortieren
            ListIconSortcolumn(lvnr, column, sortdirection)
            
            timeend = ElapsedMilliseconds()
            SetGadgetText(#info, "Sorttime: " + StrF(timeend - timestart, 2))
            
         EndIf
      EndIf
      
      ProcedureReturn #PB_ProcessPureBasicEvents
      
   EndProcedure
   
   OpenWindow(#window, 0, 0, 850, 550, "ListIconGadget Sortieren", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   TextGadget(#info, 10, 525, 100, 25, "")
   
   ListIconGadget(#liste, 10, 10, 830, 490, "COL 0", 150, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
   AddGadgetColumn(#liste, 1, "COL 1", 100)
   AddGadgetColumn(#liste, 2, "COL 2", 100)
   AddGadgetColumn(#liste, 3, "COL 3 (NUM)", 100)
   AddGadgetColumn(#liste, 4, "COL 4 (FLOAT)", 100)
   AddGadgetColumn(#liste, 5, "COL 5 (DATE)", 100)
   AddGadgetColumn(#liste, 6, "COL 6 (DATETIME)", 150)
   
   ListIconSetColumnTyp(#liste, 3, #ListIconSort_Numeric)
   ListIconSetColumnTyp(#liste, 4, #ListIconSort_Float)
   ListIconSetColumnTyp(#liste, 5, #ListIconSort_Date, "%dd.%mm.%yyyy")
   ListIconSetColumnTyp(#liste, 6, #ListIconSort_Date, "%mm-%dd-%yyyy %hh:%mm:%ss")
   
   SetWindowCallback(@WindowCallback())   ;für Headerclick
   
   
   ;Test Values:
   
   Define event
   Define j, A$, B$, C$, D$, E$, F$, G$
   
   HideGadget(#liste,1)
   
   For j = 0 To 10000
      
      A$ = "Row "+RSet(Str(j),6,"0") + #LF$      
      B$ = Str(Random(9999)) + #LF$      
      C$ = "$"+RSet(Hex(Random($7FFFFFFF)),8,"0") + #LF$      
      D$ = Str(Random(99999)) + #LF$
      E$ = Str(Random(99999))+"."+Str(Random(99)) + #LF$
      F$ = FormatDate("%dd.%mm.%yyyy", Random(Date(), 0))+Chr(10)
      G$ = FormatDate("%mm-%dd-%yyyy %hh:%mm:%ss", Random(Date(), 0))
      
      AddGadgetItem(#liste, j, A$+B$+C$+D$+E$+F$+G$)
      
   Next
   
   HideGadget(#liste,0)
   
   Repeat      
      event = WaitWindowEvent()      
   Until event = #PB_Event_CloseWindow 
   
CompilerEndIf


Re: ListIconGadget sortieren

Verfasst: 05.01.2014 10:43
von hjbremer
hier mal ein Update
hat einen eigenen Callback und ist flexibler

https://www.dropbox.com/s/ltk7jzqsb9avh4q/LvSort.chm

Beispiele und Modul in der Hilfedatei

eventuell Häkchen bei Sicherheitswarnung entfernen beim Start der Hilfedatei
sonst wird nix angezeigt.

Re: ListIconGadget sortieren

Verfasst: 03.02.2014 22:10
von hjbremer
Hier mal ganz simpel nur für eine Spalte

Code: Alles auswählen

; HJBremer 02.02.2014 PB 5.21 x86 Windows Vista

DeclareModule ListIconGadget_Sort
   ; Alle Elemente in diesem Abschnitt sind für den Zugriff von außerhalb verfügbar
   
   Enumeration 
      ;Datentypen 
      #ListIcon_Typ_Char      
      #ListIcon_Typ_Date
      #ListIcon_Typ_Float
      #ListIcon_Typ_Number
   EndEnumeration
   
   Declare ListIconSort(pbnr, col, typ = #ListIcon_Typ_Char, mask$ = "", direction = #PB_Sort_Ascending)
   
   ;ListIconSort(#liste1, 1)
   ;ListIconSort(#liste1, 2, #ListIcon_Typ_Float, "3")
   ;ListIconSort(#liste1, 4, #ListIcon_Typ_Date, #datemask)
   ;ListIconSort(#liste1, 5, #ListIcon_Typ_Char, "", #PB_Sort_Descending) 

   ;pbnr = Purebasic Gadgetnr
   ;col  = zu sortierende Column, ab 0 gezählt
   ;typ  = Datentyp der Column, siehe Enumeration
   
   ;mask$ ist für #ListIcon_Typ_Date und #ListIcon_Typ_Float
   
   ;  #ListIcon_Typ_Date: Datumsmaske, siehe PB Hilfe ParseDate()
   ;     mask$ = "" dann Vorgabe = "%dd.%mm.%yyyy"
   
   ;  #ListIcon_Typ_Float: Angabe der Dezimalstellen
   ;     mask$ = "" dann Vorgabe = 3 Dezimalstellen
   ;     mask$ = "2" dann 2 Dezimalstellen
   
   ;direction = #PB_Sort_Ascending oder #PB_Sort_Descending
   
   ;Beim Sortieren ist #PB_Sort_NoCase Standard, bei Bedarf Angabe im Callback ändern
   
EndDeclareModule

Module ListIconGadget_Sort
   
   EnableExplicit
   
   Structure ListIconSortInfo 
      pbnr.i         
      column.i
      columntyp.i     
      direction.i
      decimals.i
      datemask.s
   EndStructure    
   
   ;Cursor für Sort, 
   Global original = GetClassLongPtr_(GetDesktopWindow_(), #GCL_HCURSOR) 
   Global idc_wait = LoadCursor_(0, #IDC_WAIT)  
   
   Procedure.i ListIconSortCallBack(lParam1, lParam2, lParamSort)
      ; dies ist die Vergleichsfunktion von #LVM_SORTITEMSEX
      
      ; lParam1 und lParam2 sind die Itemnummern welche verglichen werden
      ; der Rückgabewert des Vergleichs ist -1, +1 oder 0 für gleich
      
      ; lParamSort ist der Pointer der bei Aufruf von #LVM_SORTITEMSEX übergeben wurde
      
      Static substrg1.s    ;Static beschleunigt das Vergleichen minimal
      Static substrg2.s 
      Static sortitem1.s 
      Static sortitem2.s 
      Static result 
      
      Static umlaute1$ = "ÄÖÜäöüßàâéèêùû"
      Static umlaute2$ = "AeOeUeaeoeuessayazexeyezuyuz"
      Static umlautelg, um1$, um2$
      
      Protected j, sortlg, lg1, lg2     
      Protected *lisi.ListIconSortInfo = lParamSort
      
      With *lisi         
         
         substrg1 = GetGadgetItemText(\pbnr, lParam1, \column)
         substrg2 = GetGadgetItemText(\pbnr, lParam2, \column)
         
         Select \columntyp
            Case #ListIcon_Typ_Number
               substrg1 = Str(Val(substrg1)): lg1 = Len(substrg1)
               substrg2 = Str(Val(substrg2)): lg2 = Len(substrg2)
               sortlg = lg1
               If lg2 > lg1: sortlg = lg2: EndIf
               sortitem1 = RSet(substrg1, sortlg)
               sortitem2 = RSet(substrg2, sortlg)
               
            Case #ListIcon_Typ_Float
               ReplaceString(substrg1, ",", ".", #PB_String_InPlace)
               ReplaceString(substrg2, ",", ".", #PB_String_InPlace)                     
               substrg1 = StrF(ValF(substrg1), \decimals): lg1 = Len(substrg1)
               substrg2 = StrF(ValF(substrg2), \decimals): lg2 = Len(substrg2)                     
               sortlg = lg1
               If lg2 > lg1: sortlg = lg2: EndIf
               sortitem1 = RSet(substrg1, sortlg)
               sortitem2 = RSet(substrg2, sortlg)
               
            Case #ListIcon_Typ_Date
               sortlg = Len(\datemask)
               substrg1 = Str(ParseDate(\datemask, substrg1))
               substrg2 = Str(ParseDate(\datemask, substrg2))                     
               sortitem1 = RSet(substrg1, sortlg)
               sortitem2 = RSet(substrg2, sortlg)
               
            Case #ListIcon_Typ_Char                     
               sortitem1 = substrg1
               sortitem2 = substrg2
               ;Umlaute etc ersetzen
               umlautelg = Len(umlaute1$)                     
               For j = 1 To umlautelg
                  um1$ = Mid(umlaute1$, j, 1)
                  If FindString(sortitem1, um1$)   
                     um2$ = Mid(umlaute2$, (j * 2) - 1, 2)
                     sortitem1 = ReplaceString(sortitem1, um1$, um2$)
                  EndIf
                  If FindString(sortitem2, um1$)   
                     um2$ = Mid(umlaute2$, (j * 2) - 1, 2)
                     sortitem2 = ReplaceString(sortitem2, um1$, um2$)
                  EndIf
               Next
               
         EndSelect
         
         ;Vergleich
         If \direction = #PB_Sort_Ascending
            result = CompareMemoryString(@sortitem1, @sortitem2, #PB_String_CaseSensitive)
         Else
            result = CompareMemoryString(@sortitem2, @sortitem1, #PB_String_CaseSensitive)
         EndIf
         
      EndWith
      
      ProcedureReturn result
   EndProcedure
      
   Procedure.i ListIconSort(pbnr, col, typ = #ListIcon_Typ_Char, mask$ = "", direction = #PB_Sort_Ascending)
      ;Parameter auswerten und ruft SortierCallback auf 
      
      Protected lisi.ListIconSortInfo
      
      With lisi
         \pbnr = pbnr
         \column = col
         \columntyp = typ
         \direction = direction
         
         Select typ            
            Case #ListIcon_Typ_Date
               \datemask = mask$
               If \datemask = ""
                  \datemask = "%dd.%mm.%yyyy"
               EndIf
               
            Case #ListIcon_Typ_Float
               \decimals = Val(mask$)
               If \decimals = 0
                  \decimals = 3
               EndIf
               
            Case #ListIcon_Typ_Char
            Case #ListIcon_Typ_Number
               
            Default
               \columntyp = #ListIcon_Typ_Char
               
         EndSelect
         
      EndWith
      
      DisableGadget(pbnr, 1)
      SetCursor_(idc_wait): ShowCursor_(#True)   
      
      SendMessage_(GadgetID(pbnr), #LVM_SORTITEMSEX, lisi, @ListIconSortCallBack())
      
      DisableGadget(pbnr, 0)     
      SetCursor_(original): ShowCursor_(#True)      
      SetGadgetState(pbnr, GetGadgetState(pbnr))
      
   EndProcedure
   
EndModule

UseModule ListIconGadget_Sort

Re: ListIconGadget sortieren

Verfasst: 03.02.2014 23:01
von Thorsten1867
DANKE!
Nach dem Sortierrichtungswechsel und den Pfeilen im Header suche ich heute schon ewig und plötzlich kriege ich den Code von dir auf dem "Silbertablett serviert". :)

Mein Module beschäftigt sich mehr mit der deutschen Sortierung und einigen Extras:
ListIcon Plus - Edit & Sort (deu.)

Re: ListIconGadget sortieren

Verfasst: 04.02.2014 11:17
von Goold
Auch von mir vielen Dank.

Darf der Code frei verwendet werden?

Re: ListIconGadget sortieren

Verfasst: 04.02.2014 19:44
von hjbremer
Natürlich, dafür steht er im Forum

Re: ListIconGadget sortieren

Verfasst: 04.02.2014 20:03
von Goold
Super! :allright:

Werde ich gleich mal versuchen, in mein Projekt einzubasteln.

Edit: Funktioniert fantastisch :D
Ich habe am Ende eine Summenzeile, die ich vorm Sortieren auslese, lösche und nach dem Sortieren wieder anfüge. Des Weiteren habe ich beim Float-Format die Punkte für die Tausender-Trennzeichen noch rausgelöscht.

Lässt es sich eigentlich unterdrücken, dass bei gleichem Inhalt die Nachbarspalte/n für die Sortierung herangezogen werden?