'AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”öüáߎę֚Üñ±¸©ø° 'program QSort; '(c)vor ganz langer Zeit von jemand, der in pascal programmieren konnte.. 'program QSort.Pas wurde erfolgreich nach FB QSort.Bas portiert, auch FB0.17f 'qsort sortiert ein Array von SortTypes aufwärts und abwärts und benutzt jetzt Pointer Type SortType As Integer 'Alle FB-Tpen erlaubt, bei Strings muß nur die Erzeugung geändert werden 'UDTs sind allerdings nicht erlaubt.. Declare Sub QSort(Feld() As SortType Ptr, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0) Declare Sub PrMat(byVal Msg As String="", a() As SortType Ptr) Const Max=10 Var j=0 Dim a(Max) As SortType Ptr Randomize Timer For j=0 To Max-1 a(j)=CAllocate(1, Len(SortType)) *a(j)=Rnd*30000 Next PrMat("Unsortiert", a()) QSort(a(), 0, Max-1, 1) PrMat("Abw„rts", a()) QSort(a(), 0, Max-1, 0) PrMat("Aufw„rts", a()) GetKey For j=0 To Max-1 'und jetzt den zugewiesenen Speicher noch freigeben.. DeAllocate(a(j)) a(j)=0 Next End Sub PrMat(byVal Msg As String="", a() As SortType Ptr) Var i As Integer=0 If Msg<>"" Then Print Msg For i=0 To Max-1 Print Using"####:";i; Print *a(i) Next End Sub Sub QSort(Feld() As SortType Ptr, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0) Var i=l, j=r 'Variablen für die Schleifensteuerung festlegen Dim As SortType Ptr x=CAllocate(1, Len(SortType)) 'Speicher für Referenz-Element reservieren *x=*Feld((l+r)\2) 'Referenz-Element ermitteln, das 'Mittelste' im Feld Do While IIF(Downwards, *Feld(i)>*x, *Feld(i)<*x) 'Einpassendes Vergleichselement finden i+=1 'Zähler erhöhen Wend While IIF(Downwards, *x>*Feld(j), *x<*Feld(j)) 'Noch ein passendes Element finden j-=1 Wend If i<=j Then 'ggfs. Swap *Feld(i), *Feld(j) '..tauschen i+=1 'Zähler erhöhen.. j-=1 '..diesen erniedrigen.. End If Loop Until i>j If l