XProfan

Deutsch

Michael
Wodrich

Um Teilstrings in einem String zu sortieren nutzte ich bisher immer den Umweg über

MoveStrToList (ab in die Listbox-Liste)
von dort rüber in eine sortierte Liste
dann zurück in die Listbox-Liste
und letztendlich mit MoveListToStr

zum gewünschten Ergebnis.

Das es auch ein wenig kürzer geht, zeigt die zweite Version, die SortArray.inc benötigt. Die lege ich auch bei.
Kompilieren Markieren Separieren

' Teilstrings sortieren
' (in dieser Version ungeeignet für Zahlen; na ja, fast)

Proc Sort_StrPart

    Parameters StrPart$, Trenner$
    Declare Erg$, hListe&

    If (Len(StrPart$) = 0) or (Len(Trenner$) = 0)

        Erg$ = StrPart$

    Else

        hListe& = Create("List",1)'sortierte Liste
        ClearList 0'lösche Listbox-Liste (LBL)
        MoveStrToList(StrPart$, Trenner$)'Teilstrings in LBL
        MoveListToHandle(hListe&)'in sortierte Liste
        ClearList 0
        MoveHandleToList(hListe&)'zurück in LBL
        Erg$ = MoveListToStr$(Trenner$)
        ClearList 0' LBL sauber hinterlassen
        DestroyWindow(hListe&)
        Case Right$(Erg$,Len(Trenner$)) = Trenner$ : Erg$ = Left$(Erg$,Len(Erg$)-Len(Trenner$))

    EndIf

    Return Erg$

EndProc

 $I SortArray.inc

Proc Sort_StrPart2

    Parameters StrPart$, Trenner$
    Declare Erg$, hListe&

    If (Len(StrPart$) = 0) or (Len(Trenner$) = 0)

        Erg$ = StrPart$

    Else

        ClearList 0'lösche Listbox-Liste (LBL)
        MoveStrToList(StrPart$, Trenner$)'Teilstrings in LBL
        QuickSort_List 0, 0, (GetCount(0) - 1), 1, 0
        Erg$ = MoveListToStr$(Trenner$)
        ClearList 0' LBL sauber hinterlassen
        Case Right$(Erg$,Len(Trenner$)) = Trenner$ : Erg$ = Left$(Erg$,Len(Erg$)-Len(Trenner$))

    EndIf

    Return Erg$

EndProc

cls
Print "Version:",$ProfVer;"\n"
Declare Test$
Test$ = "Delta,Bravo,Echo,Charlie,Fuchstritt,Alfa"
Print "alt:", Test$
Print "neu:", Sort_StrPart(Test$, ",");"\n"
Test$ = "037;081;019;007;012;024;080"
Print "alt:", Test$
Print "neu:", Sort_StrPart(Test$, ";");"\n"
Test$ = "Delta,Bravo,Echo,Charlie,Fuchstritt,Alfa"
Print "(hier wurde der Umweg ausgelassen und die LBL direkt sortiert)"
Print "alt:", Test$
Print "neu:", Sort_StrPart2(Test$, ",");"\n"
Print "TASTE=Ende"
WaitKey
End

Hier die SortArray.inc
Kompilieren Markieren Separieren

/*
Array oder Liste (teil-)sortieren
Nicht vergessen: Arrays und Listen haben die Basis Null.
QuickSort_List ist nicht für sortierte Listen gedacht.
Da ich aber häufiger die Listbox-Liste in eine (sortierte)
Liste umgepackt habe und dann das Ganze wieder in die
Gegenrichtung bewegen mußte...
- das A u O um die Listbox-Liste zu sortieren.
- auch sinnvoll, wenn in unsortierten Listen
nur ein Teil der Einträge sortiert werden soll.
*/
' (Teil-)Sortieren von Arrays
' ---------------------------
' QuickSort_Long Long_Array&[], min&, max&
' QuickSort_Str String_Array&[], min&, max&, CaseSense%
'    Wenn CaseSense ungleich Null ist, dann werden
'    die Strings als Lower$()-Werte verglichen.
' Teil-Sortieren von Listen
' -------------------------
' QuickSort_List ListHandle&, min&, max&, CaseSense%, IsNum%
'    Wenn ListHandle& = 0, dann Listbox-Liste.
'    Wenn IsNum ungleich Null ist, dann werden
'    die Werte mittels Val() verglichen -- sonst... --
'       Wenn CaseSense ungleich Null ist, dann werden
'       die Strings als Lower$()-Werte verglichen.
'=================================================
' (Teil-)Sortieren von Arrays
' ---------------------------
' QuickSort_Long Long_Array&[], min&, max&

Proc QuickSort_Long

    Parameters Arr&[], Low&, High&
    Declare i&, j&, hilf&, mitte&
    i& = Low&
    j& = High&
    mitte& = Arr&[@Int((Low& + High&) / 2)]

    While i& <= j&

        While Arr&[i&] < mitte&

            Inc i&

        EndWhile

        While Arr&[j&] > mitte&

            Dec j&

        EndWhile

        If i& <= j&

            hilf& = Arr&[i&]
            Arr&[i&] = Arr&[j&]
            Arr&[j&] = hilf&
            Inc i&
            Dec j&

        EndIf

    EndWhile

    If Low& < j&

        QuickSort_Long Arr&[], Low&, j&

    EndIf

    If i& < High&

        QuickSort_Long Arr&[], i&, High&

    EndIf

EndProc

' (Teil-)Sortieren von Arrays
' ---------------------------
' QuickSort_Str String_Array&[], min&, max&, CaseSense%
'    Wenn CaseSense ungleich Null ist, dann werden
'    die Strings als Lower$()-Werte verglichen.

Proc QuickSort_Str

    Parameters Arr$[], Low&, High&, CaseSense%
    Declare i&, j&, hilf$, mitte$

    Proc QS_GetStr$

        Parameters Wert$
        Return If( CaseSense% <> 0, Lower$(Wert$), Wert$ )

    EndProc

    i& = Low&
    j& = High&
    mitte$ = QS_GetStr$(Arr$[@Int((Low& + High&) / 2)])

    While i& <= j&

        While QS_GetStr$(Arr$[i&]) < mitte$

            Inc i&

        EndWhile

        While QS_GetStr$(Arr$[j&]) > mitte$

            Dec j&

        EndWhile

        If i& <= j&

            hilf$ = Arr$[i&]
            Arr$[i&] = Arr$[j&]
            Arr$[j&] = hilf$
            Inc i&
            Dec j&

        EndIf

    EndWhile

    If Low& < j&

        QuickSort_Str Arr$[], Low&, j&, CaseSense%

    EndIf

    If i& < High&

        QuickSort_Str Arr$[], i&, High&, CaseSense%

    EndIf

EndProc

' Teil-Sortieren von Listen
' -------------------------
' QuickSort_List ListHandle&, min&, max&, CaseSense%, IsNum%
'    Wenn ListHandle& = 0, dann Listbox-Liste.
'    Wenn IsNum ungleich Null ist, dann werden
'    die Werte mittels Val() verglichen -- sonst... --
'       Wenn CaseSense ungleich Null ist, dann werden
'       die Strings als Lower$()-Werte verglichen.

Proc QuickSort_List

    Parameters ListHandle&, Low&, High&, CaseSense%, IsNum%
    Declare i&, j&, hilfS$, mitteS$, hilfL&, mitteL&, tmp$

    Proc QS_Get

        Parameters Idx&, Ori%

        If Ori%

            Return GetString$(ListHandle&, Idx&)

        Else

            If IsNum%

                Return Val(GetString$(ListHandle&, Idx&))

            Else

                ' noch ein Sortiertrick - die Umlaute umsetzen
                tmp$ = GetString$(ListHandle&, Idx&)
                tmp$ = Translate$(tmp$,"Ä","Ae")
                tmp$ = Translate$(tmp$,"Ö","Oe")
                tmp$ = Translate$(tmp$,"Ü","Ue")
                tmp$ = Translate$(tmp$,"ä","ae")
                tmp$ = Translate$(tmp$,"ö","oe")
                tmp$ = Translate$(tmp$,"ü","ue")
                tmp$ = Translate$(tmp$,"ß","ss")
                Return If( CaseSense% <> 0, Lower$(tmp$), tmp$ )

            EndIf

        EndIf

    EndProc

    Proc QS_Put

        Parameters Idx&, Wert$
        ReplaceString(ListHandle&, Idx&, Wert$)

    EndProc

    i& = Low&
    j& = High&

    If IsNum%

        mitteL& = QS_Get(@Int((Low& + High&) / 2), 0)

    Else

        mitteS$ = QS_Get(@Int((Low& + High&) / 2), 0)

    EndIf

    While i& <= j&

        If IsNum%

            While QS_Get(i&,0) < mitteL&

                Inc i&

            EndWhile

            While QS_Get(j&,0) > mitteL&

                Dec j&

            EndWhile

        Else

            While QS_Get(i&,0) < mitteS$

                Inc i&

            EndWhile

            While QS_Get(j&,0) > mitteS$

                Dec j&

            EndWhile

        EndIf

        If i& <= j&

            hilfS$ = QS_Get(i&,1)
            QS_Put(i&, QS_Get(j&,1))
            QS_Put(j&, hilfS$)
            Inc i&
            Dec j&

        EndIf

    EndWhile

    If Low& < j&

        QuickSort_List ListHandle&, Low&, j&, CaseSense%, IsNum%

    EndIf

    If i& < High&

        QuickSort_List ListHandle&, i&, High&, CaseSense%, IsNum%

    EndIf

EndProc