Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Telefonbuchsortierung für String-Arrays
| Uploader: |  Sebastian |
| Datum/Zeit: | 09.01.2010 20:02:23 |
' Telefonbuch-Vergleich/-Sortierung von Strings bzw. Stringfeldern
' Nicht optimiert (langsam!), aber einfach
' Getestet mit FreeBASIC 0.20.0
' Permission is hereby granted, free of charge, to any person obtaining a
' copy of this software and associated documentation files (the "Software"),
' to deal in the Software without restriction, including without limitation
' the rights to use, copy, modify, merge, publish, distribute, sublicense,
' and/or sell copies of the Software, and to permit persons to whom the
' Software is furnished to do so, subject to the following conditions:
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
' OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
' THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
' FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
' DEALINGS IN THE SOFTWARE.
' ******** Funktionen fuer den Telefonbuch-Stringvergleich/sortierung ********
Function TBMin (ByVal ZahlA As Integer, ByVal ZahlB As Integer) As Integer
If (ZahlA < ZahlB) Then
Return ZahlA
Else
Return ZahlB
End If
End Function
Function TBUmlauteErsetzen(ByVal TextEing As String) As String
Dim UmlCodes(1 to 7) As UByte = {142, 132, 153, 148, 154, 129, 225 }
Dim UmlErsetz(1 to 7) As String = {"AE","ae","OE","oe","UE","ue","ss"}
Dim As String Text = TextEing, Neu
Dim As UByte z
For i As Integer = 0 To Len(Text)-1
z = Text[i]
For j As Integer = 1 To 7
If (z = UmlCodes(j)) Then
Neu += UmlErsetz(j)
Continue For
End If
Next j
If ((z >= 65) and (z <= 90)) or ((z >= 97) and (z <= 122)) Then
Neu += CHR(z)
End If
Next i
Return Neu
End Function
Function TBGewichtung (ByVal z As Integer) As Integer
If ((z >= 65) and (z <= 90)) Then
Return ((z-64)*2-1) 'A=1, B=3, C=5, ...
Else
Return ((z-96)*2) 'a=2, b=4, c=6, ...
End If
End Function
Function TBVergleich_AKleinerB (ByVal Ax As String, ByVal Bx As String) As Integer
'Wenn A < B, liefert die Function 1, ansonsten 0 zurueck. Durch Auswertung
'der Rueckgabe koennen die beiden Zeichenketten dann bzgl. ihrer Ordnung
'bei Telefonbuchsortierung verglichen werden.
'Beispiele:
' TBVergleich_AKleinerB ("Aaron","Albert") == 1
' TBVergleich_AKleinerB ("Müller","Meier") == 0
Dim As String A, B
'Im Folgenden werden die Umlaute ersetzt und Sonderzeichen entfernt.
A = TBUmlauteErsetzen(Ax)
B = TBUmlauteErsetzen(Bx)
For i As Integer = 0 To TBMin(Len(A), Len(B))-1
If (TBGewichtung(A[i]) < TBGewichtung(B[i])) Then
Return 1
ElseIf (TBGewichtung(A[i]) > TBGewichtung(B[i])) Then
Return 0
End If
Next i
'Die Function wurde in der For-Schleife nicht mit Return verlassen, d.h.
'beide Strings sind beim verglichenen Teil gleich.
'
' Beispiel: MUELL
' MUELLER
' \___/
' verglichen
'
'Die Zeichenkette, die laenger ist als die andere, soll als "groesser"
'gewertet werden.
If Len(A) < Len(B) Then
Return 1
Else
Return 0
End If
End Function
'Telefonbuchsortierung fuer String-Arrays (basiert auf BubbleSort)
Sub TBSortieren (Array() As String)
Dim As Integer i, n, vertauscht
n = UBound(Array)
Do
vertauscht=0
For i = LBound(Array) To n-1
If (TBVergleich_AKleinerB(Array(i+1),Array(i))) Then
SWAP Array(i), Array(i+1)
vertauscht=1
End If
Next i
n -= 1
Loop While (vertauscht And (n >= 1))
End Sub
' ************** Funktionen fuer die Demo-Oberflaeche **************
Sub TabelleLeerzeile (ByVal Spalten As Integer)
Print String(8,196); Chr(197);
For i As Integer = 1 To Spalten
Print String(9, 196);
if i < Spalten Then Print Chr(197);
Next i
Print ""
End Sub
' ************** Hauptprogramm **************
' Testnamen
Dim Namen(1 To 11) As String = _
{ "Mller", "mueller", "Meier", "Mllhas", "Máig", "Mosel", _
"Mubach", "Mykron", "Mussman", "Mkel", "Makler" }
'Vergleichstabelle darstellen: Jeden Namen mit jedem vergleichen
Width 120,28
Cls
Print " "; chr(179); " ";
For i As Integer = LBound(Namen) To UBound(Namen)
Color 14
Print Using "\ \"; Namen(i);
Color 7
If (i < Ubound(Namen)) Then Print " "; CHR(179); " ";
Next i
Print ""
TabelleLeerzeile (UBound(Namen)-LBound(Namen)+1)
For i As Integer = LBound(Namen) To UBound(Namen)
Color 12
Print Using "\ \ "; Namen(i);
Color 7
For j As Integer = LBound(Namen) To UBound(Namen)
Print chr(179); " ";
Color 14
Print "A";
Color 7
Print "<";
Color 12
Print "B";
Color 7
Print "? "; Str(TBVergleich_AKleinerB(Namen(j), Namen(i))); " ";
Next j
Print ""
If (i < Ubound(Namen)) Then TabelleLeerzeile (UBound(Namen)-LBound(Namen)+1)
Next i
Print
Print "Alle Vergleiche wurden durchgefuehrt."
Print "Druecken Sie eine beliebige Taste, um die Namen jetzt gemaess ";
Print "Telefonbuchsortierung sortieren zu lassen."
Sleep
Width 80, 25
Cls
Print "Unsortiert: Sortiert:"
Print "------------ ------------"
For i As Integer = LBound(Namen) To UBound(Namen)
Locate 2+i, 1: PRINT Namen(i)
Next i
TBSortieren(Namen())
For i As Integer = LBound(Namen) To UBound(Namen)
Locate 2+i, 18: PRINT Namen(i)
Next i
PRINT
PRINT "Druecken Sie eine beliebige Taste, um das Programm zu beenden."
Sleep