Da ich eben etwas Zeit hatte, habe ich Xaby bei einem Sortier-Problem
geholfen. Dabei kam folgende Procedure heraus.
Sie hat ähnliche Parameter wie die Funktion SortStructuredArray(), allerdings
muss man noch die Größe der Struktur übergeben und Start- und
End-Parameter sind nicht optional, was man theoretisch aber ändern könnte.
Hier also der Code mit Beispiel:
Code: Alles auswählen
Structure Daten
s1.s
a1.l
s2.s
EndStructure
Dim Daten.Daten(5)
;Benutzt den GNOME-Sort
Procedure SortStructuredArrayEx(*Array, Options.l, size_arr.l, offset.l, Type.l, start.l, ende.l)
Protected a.l = start, r.l, *s_arr, *e_arr, *tmp
*tmp = AllocateMemory(size_arr)
If *tmp = 0 : ProcedureReturn #False : EndIf
*s_arr = *Array + a * size_arr + offset
While a <= ende - 1
*e_arr = *s_arr + size_arr
r = #False
Select Options
Case 0
Select Type
Case #PB_Sort_Byte : If PeekB(*s_arr) > PeekB(*e_arr) : r = #True : EndIf
Case #PB_Sort_Character : If PeekC(*s_arr) > PeekC(*e_arr) : r = #True : EndIf
Case #PB_Sort_Double : If PeekD(*s_arr) > PeekD(*e_arr) : r = #True : EndIf
Case #PB_Sort_Float : If PeekF(*s_arr) > PeekF(*e_arr) : r = #True : EndIf
Case #PB_Sort_Long : If PeekL(*s_arr) > PeekL(*e_arr) : r = #True : EndIf
Case #PB_Sort_Quad : If PeekQ(*s_arr) > PeekQ(*e_arr) : r = #True : EndIf
Case #PB_Sort_String : If PeekS(PeekL(*s_arr)) > PeekS(PeekL(*e_arr)) : r = #True : EndIf
Case #PB_Sort_Word : If PeekW(*s_arr) > PeekW(*e_arr) : r = #True : EndIf
EndSelect
Case 1
Select Type
Case #PB_Sort_Byte : If PeekB(*s_arr) < PeekB(*e_arr) : r = #True : EndIf
Case #PB_Sort_Character : If PeekC(*s_arr) < PeekC(*e_arr) : r = #True : EndIf
Case #PB_Sort_Double : If PeekD(*s_arr) < PeekD(*e_arr) : r = #True : EndIf
Case #PB_Sort_Float : If PeekF(*s_arr) < PeekF(*e_arr) : r = #True : EndIf
Case #PB_Sort_Long : If PeekL(*s_arr) < PeekL(*e_arr) : r = #True : EndIf
Case #PB_Sort_Quad : If PeekQ(*s_arr) < PeekQ(*e_arr) : r = #True : EndIf
Case #PB_Sort_String : If PeekS(PeekL(*s_arr)) < PeekS(PeekL(*e_arr)) : r = #True : EndIf
Case #PB_Sort_Word : If PeekW(*s_arr) < PeekW(*e_arr) : r = #True : EndIf
EndSelect
Case 2
If Type = #PB_Sort_String
If LCase(PeekS(PeekL(*s_arr))) > LCase(PeekS(PeekL(*e_arr))) : r = #True : EndIf
EndIf
Case 3
If Type = #PB_Sort_String
If LCase(PeekS(PeekL(*s_arr))) < LCase(PeekS(PeekL(*e_arr))) : r = #True : EndIf
EndIf
EndSelect
If r
CopyMemory(*s_arr - offset, *tmp, size_arr)
CopyMemory(*e_arr - offset, *s_arr - offset, size_arr)
CopyMemory(*tmp, *e_arr - offset, size_arr)
If a > start
a - 2
*s_arr - 2 * size_arr
EndIf
EndIf
a + 1
*s_arr + size_arr
Wend
EndProcedure
Daten(0)\s1 = "AA" : Daten(0)\a1 = 100 : Daten(0)\s2 = "CD"
Daten(1)\s1 = "BC" : Daten(1)\a1 = 50 : Daten(1)\s2 = "CD"
Daten(2)\s1 = "AA" : Daten(2)\a1 = 30 : Daten(2)\s2 = "DF"
Daten(3)\s1 = "BB" : Daten(3)\a1 = 60 : Daten(3)\s2 = "AB"
Daten(4)\s1 = "BB" : Daten(4)\a1 = 20 : Daten(4)\s2 = "CD"
Daten(5)\s1 = "BB" : Daten(5)\a1 = 25 : Daten(5)\s2 = "AD"
SortStructuredArrayEx(Daten(), 0, SizeOf(Daten), OffsetOf(Daten\a1), #PB_Sort_Long, 0, 5)
SortStructuredArrayEx(Daten(), 0, SizeOf(Daten), OffsetOf(Daten\s2), #PB_Sort_String, 0, 5)
SortStructuredArrayEx(Daten(), 0, SizeOf(Daten), OffsetOf(Daten\s1), #PB_Sort_String, 0, 5)
For a = 0 To 5
Debug Daten(a)\s1 + " : " + Str(Daten(a)\a1) + " : " + Daten(a)\s2
Next