Automatische Sortierung Gridbox & Co.

H.Brill · 3. Dezember 2022

Was nicht jeder weiß :

Die automatische Sortierung bei den List - Controls geschieht ja

nach ASCII, d. h. nach 1 kommt 10, 11, 12 usw. und nicht 2, 3, 4 usw.

Wenn die Zahlen aber gleich lang gemacht werden (z.B.001 statt 1)

so geht auch die Sortierung richtig. Das geht am besten mit Format$().

Code

Declare Handle grid, liste
Window 500, 200
grid = Create("Gridbox", %HWnd, "spalte 1;0;60;spalte 2;0;80;spalte 3;0;60", 1, 10, 10, 220, 100)
liste = Create("Listbox", %HWnd, 1, 250, 10, 220, 100)
WhileLoop 100, 1, -1
AddString(grid, Format$("000", &LOOP) + "|" + "AAA" + "|" + "BBB")
AddString(liste, Format$("000", &LOOP))
EndWhile

While 1
   Waitinput
EndWhile

Alles anzeigen

Jens-Arne · 14. Dezember 2022

Die Variante von Heinz ist natürlich schonmal sehr brauchbar.

Noch besser wird sie (nur für Gridboxen), wenn man die erste Spalte (=Spalte 0) der Gridbox versteckt (also 0 Pixel breit macht) und dort die formatierte Version der Zahlen reinschreibt. In die 2. Spalte der Gridbox, welche die erste sichtbare ist, schreibt man dann die unformatierten. Diese sehen dann ebenfalls korrekt sortiert aus, weil immer nach der nun unsichtbaren Spalte 0 sortiert wird.

Und man kann das ganze noch weiter auf die Spitze treiben. Mit der Message ~LVM_SORTITEMSEX und einer Callback-Funktion kann man fast beliebig sortieren. Hier ein Beispiel, das ohne versteckte 1. Spalte auskommt und trotzdem richtig sortiert:

Code

PROC SortGridCallbackProc
  Parameters Integer lParam1, lParam2, lParamSort
  Declare Integer erg
  erg=0
  If @Val(@GetText$(grid, lParam1, 0)) > @Val(@GetText$(grid, lParam2, 0))
    erg=1
  ElseIf @Val(@GetText$(grid, lParam1, 0)) < @Val(@GetText$(grid, lParam2, 0))
    erg=-1
  EndIf
  Return erg
ENDPROC

Declare Handle grid
Declare Pointer hSortGridCallbackProc
Window 500, 400
grid = Create("Gridbox", %HWnd, "spalte 1;0;60;spalte 2;0;80;spalte 3;0;60", 0, 10, 10, 220, 300) 'zunächst UNsortierte Gridbox
hSortGridCallbackProc = @ProcAddr("SortGridCallbackProc",3)
WhileLoop 100, 1, -1
  AddString(grid, @Str$(&LOOP) + "|" + "AAA" + "|" + "BBB")
  @SendMessage(grid, 4177, 0, hSortGridCallbackProc) '4177=~LVM_SORTITEMSEX; hierhin, wenn schon beim Füllen der Gridbox sortiert werden soll (ist natürlich langsamer)
EndWhile
'@SendMessage(grid, 4177, 0, hSortGridCallbackProc) '4177=~LVM_SORTITEMSEX; hierhin, wenn erst nach dem Füllen der Gridbox sortiert werden soll (ist natürlich schneller)

While 1
  Waitinput
EndWhile

@ProcAddr("SortGridCallbackProc",-3)
End

Alles anzeigen

Siehe Microsoft-Hilfe: https://learn.microsoft.com/en…/controls/lvm-sortitemsex

Gruß, Jens-Arne

Und wenn wir den Geschwindigkeitsturbo zünden wollen, schreiben wir die Callback-Funktion in FreeBasic (benötigt JRPC3):

Code

{$PushFbDllGlobalLine TYPE S_LVITEMA}
{$PushFbDllGlobalLine   mask As Integer}
{$PushFbDllGlobalLine   iItem As Integer}
{$PushFbDllGlobalLine   iSubItem As Integer}
{$PushFbDllGlobalLine   state As Integer}
{$PushFbDllGlobalLine   stateMask As Integer}
{$PushFbDllGlobalLine   pszText As Any Pointer}
{$PushFbDllGlobalLine   cchTextMax As Integer}
{$PushFbDllGlobalLine   iImage As Integer}
{$PushFbDllGlobalLine   lParam As Integer}
{$PushFbDllGlobalLine   iIndent As Integer}
{$PushFbDllGlobalLine   iGroupId As Integer}
{$PushFbDllGlobalLine   cColumns As Integer}
{$PushFbDllGlobalLine   puColumns As Integer}
{$PushFbDllGlobalLine   piColFmt As Integer}
{$PushFbDllGlobalLine   iGroup As Integer}
{$PushFbDllGlobalLine END TYPE}

fbPROC GetLVText(ByVal hLV As Integer, ByVal Zeile As Integer, ByVal Spalte As Integer) As String
  Dim As S_LVITEMA LVITEM
  Dim As String ret
  Dim As Byte Pointer pLVItemText
  pLVItemText = Allocate(2000)
  LVITEM.iItem = Zeile
  LVITEM.iSubItem = Spalte
  LVITEM.mask = 1 '1=LVIF_TEXT
  LVITEM.pszText = pLVItemText
  LVITEM.cchTextMax = 2000
  SendMessage(Cast(Any Pointer, hLV), 4141, Zeile, Cast(Integer, @LVITEM)) '4141=LVM_GETITEMTEXT
  ret=Peek(ZString, pLVItemText)
  Deallocate(pLVItemText)
  Return ret
ENDPROC 'GetLVText

fbPROC SortGridCallbackProc(ByVal lParam1 As LPARAM, ByVal lParam2 As LPARAM, ByVal lParamSort As LPARAM) As Integer Export
  Dim As Integer erg
  erg = 0
  If Val(GetLVText(grid, lParam1, 0)) > Val(GetLVText(grid, lParam2, 0))
    erg = 1
  ElseIf Val(GetLVText(grid, lParam1, 0)) < Val(GetLVText(grid, lParam2, 0))
    erg = -1
  EndIf
  Return erg
ENDPROC 'SortGridCallbackProc

Declare Handle grid SharedInfbProcs
Declare Handle hDll
Declare Pointer hSortGridCallbackProc
Window 500, 400
grid = Create("Gridbox", %HWnd, "spalte 1;0;60;spalte 2;0;80;spalte 3;0;60", 0, 10, 10, 220, 300) 'zunächst UNsortierte Gridbox
hDll = @UseDll("test_fbprocs.dll")
hSortGridCallbackProc = @External("Kernel32.dll", "GetProcAddress", @External("Kernel32.dll", "GetModuleHandleA", "test_fbprocs.dll"), "SORTGRIDCALLBACKPROC@12")
WhileLoop 100, 1, -1
  AddString(grid, @Str$(&LOOP) + "|" + "AAA" + "|" + "BBB")
  @SendMessage(grid, 4177, 0, hSortGridCallbackProc) '4177=~LVM_SORTITEMSEX; hierhin, wenn schon beim Füllen der Gridbox sortiert werden soll (ist natürlich langsamer)
EndWhile
'@SendMessage(grid, 4177, 0, hSortGridCallbackProc) '4177=~LVM_SORTITEMSEX; hierhin, wenn erst nach dem Füllen der Gridbox sortiert werden soll (ist natürlich schneller)
FreeDll hDll

While 1
   Waitinput
EndWhile

End

Alles anzeigen

Jens-Arne · 14. Dezember 2022

Das Profan-Programm muss im 2. Beispiel übrigens "test.prf" heißen, damit die FreeBasic-Dll bei UseDll und beim Ermitteln der Einsprungadresse der Callback-Funtion richtig benannt ist. Hier heißt sie entsprechend "test_fbprocs.dll". Wenn das Profan-Programm anders heißt, muss das entsprechend angepasst werden.

Automatische Sortierung Gridbox & Co.

Jetzt mitmachen!

Teilen