Code-Beispiel

Beliebige Typen sortieren mit QSort

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	ytwinky	31.08.2010

Hier ist ein QSort, der fast alles sortieren kann(bis auf UDTs)

'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



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

Dim j As Integer

Dim a(Max) As SortType Ptr

Randomize Timer

For j=0 To Max-1

  a(j)=Allocate(1, Len(SortType))

  *a(j)=Rnd*30000

Next j

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 j

End



Sub PrMat(byVal Msg As String="", a() As SortType Ptr)

  Dim i As Integer

  If Msg<>"" Then Print Msg

  For i=0 To Max-1

    Print Using"####:";i;

    Print *a(i)

  Next i

End Sub



Sub QSort(Feld() As SortType Ptr, byVal l As Integer, byVal r As Integer, byVal Downwards As Integer=0)

  Dim As Integer i=l, j=r 'Variablen für die Schleifensteuerung festlegen

  Dim As SortType Ptr x=Allocate(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) 'Ein passendes 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<j Then QSort(Feld(), l, j, Downwards) 'ggfs mit den neuen Grenzen sortieren

  If i<r Then QSort(Feld(), i, r, Downwards) 'anderenfalls mit den neuen Grenzen sortieren

  DeAllocate(x) 'Speicher von x freigeben..

  x=0

End Sub

[Edit]Auf Anregung von MisterD habe ich die Variablen von Long auf Integer gesetzt..

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 14.06.2007 von ytwinky angelegt.
Die aktuellste Version wurde am 31.08.2010 von ytwinky gespeichert.

Bearbeiten

Versionen

Impressum • Nutzungsbedingungen • Datenschutz

Microsoft, Windows, Windows NT, XBOX und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.