English
Forum

Teilstrings sort

 

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.
CompileMarkSeparation
' (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
KompilierenMarkierenSeparieren
/*
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


Greeting
Michael Wodrich
 
XProfan X2
Windows (TM) Vista Ultimate, Core(TM) i7 920 @ 2.67GHz, 9206,26 MB

Programmieren, das spannendste Detektivspiel der Welt.
03/11/14  
 




p.specht

Vielen Thanks, works well!
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
03/17/14  
 



Why postest You The not under Includes? then would tappt im dunkeln too rather found and your Profil properly automatically extended.
 
07/09/14  
 



Answer


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

4.746 Views

Untitledvor 0 min.
H.Brill12/03/22
RudiB.04/26/22
kustg03/02/20
Walter06/07/19
More...

Themeninformationen

this Topic has 3 subscriber:

iF (1x)
p.specht (1x)
Michael Wodrich (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie