XProfan

English

Michael
Wodrich

circa Teilstrings in a String To sort nutzte I yet always whom detour over

MoveStrToList (ex into Listbox-list)
of there rüber in a sortierte list
then back into Listbox-list
and letztendlich with MoveListToStr

to that desired Result.

the it a little kürzer goes, shows the second Version, The SortArray.inc needed. The lay so did i with.
Compile Mark Separation

' (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" Waia> 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%
'    If CaseSense mismatched zero is, then go
'    The Strings as Lower$()-values compared.
' part-to testing. lists
' -------------------------
' QuickSort_List ListHandle&, min&, max&, CaseSense%, IsNum%
'    If ListHandle& = 0, then Listbox-list.
'    If IsNum mismatched zero is, then go
'    The values through Val() compared -- otherwise... --
'       If CaseSense mismatched zero is, then go
'       The Strings as Lower$()-values compared.
'=================================================
' (part-)to testing. 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

' (part-)to testing. Arrays
' ---------------------------
' QuickSort_Str String_Array&[], min&, max&, CaseSense%
'    If CaseSense mismatched zero is, then go
'    The Strings as Lower$()-values compared.

Proc QuickSort_Str

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

    Proc QS_GetStr$

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

    ENDPROC

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

    While i& <= j&

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

            Inc i&

        EndWhile

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

            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

' part-to testing. lists
' -------------------------
' QuickSort_List ListHandle&, min&, max&, CaseSense%, IsNum%
'    If ListHandle& = 0, then Listbox-list.
'    If IsNum mismatched zero is, then go
'    The values through Val() compared -- otherwise... --
'       If CaseSense mismatched zero is, then go
'       The Strings as Lower$()-values compared.

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

                ' another Sortiertrick - The 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&, worth$
        ReplaceString(ListHandle&, Idx&, worth$)

    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