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 |
|