PureBoard

Verfasst: **04.12.2006 13:07**

Hallo alle miteinander!

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

PureBoard

SortStructuredArrayEx mit Gnome-Sort (stabil)

SortStructuredArrayEx mit Gnome-Sort (stabil)