Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Suchen und Sortieren

Beliebige Typen sortieren mit QSort

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Redakteurytwinky 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 Redakteurytwinky angelegt.
  • Die aktuellste Version wurde am 31.08.2010 von Redakteurytwinky gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen