
Als ich gestern im Changelog von PB 4.0 gelesen habe:
Support for Global, Protected, Static and Shared arrays and linkedlist: "Global NewList MyList.l()". NewList alone does not make the list global anymore
und heute dann auch auf :
gestoßen bin, habe ich mal ein kleines Programm zum Sortieren von LinkedLists geschrieben.LinkedList and Arrays can now be passed as procedure parameters
Der Algorithmus ist an sich nicht auf meinen Mist gewachsen, den kenn ich aus der Schule von Delphi. Ich wollte nur mal eben zeigen, was mit den neuen Features so alles schönes möglich ist.
Code: Alles auswählen
Global NewList Werte.l()
Procedure MySort(List.l())
Protected NewList leftList.l()
Protected NewList rightList.l()
FirstElement(List())
If CountList(list())>1
mittwert.l=list()
DeleteElement(list(),1)
While CountList(list())<>0
If list()<mittwert
AddElement(LeftList.l())
leftlist()=list()
Else
AddElement(rightList.l())
rightlist()=list()
EndIf
DeleteElement(list(),1)
Wend
If CountList(leftlist())>1
FirstElement(leftList())
mysort(leftList())
ResetList(leftlist())
FirstElement(leftlist())
While CountList(leftlist())>0
AddElement(List())
list()=leftlist()
DeleteElement(leftlist(),1)
Wend
EndIf
AddElement(List())
list()=mittwert
If CountList(rightlist())>1
FirstElement(rightlist())
mysort(rightlist())
FirstElement(rightlist())
While CountList(rightlist())>0
AddElement(List())
list()=rightlist()
DeleteElement(rightlist(),1)
Wend
EndIf
EndIf
EndProcedure
If OpenWindow(1,200,200,400,500,#PB_Window_SystemMenu,"Sortierer")
CreateGadgetList(WindowID(1))
ListViewGadget(1,0,0,400,440)
ButtonGadget(2,0,450,500,50,"Sort")
For a=0 To 500
AddGadgetItem(1,-1,Str(Random(600)))
Next
Repeat
event=WaitWindowEvent()
If event=#PB_Event_Gadget
Select EventGadget()
Case 2
ClearList(Werte())
For a=0 To 500
AddElement(Werte())
Werte()=Val(GetGadgetItemText(1,a,0))
Next
ClearGadgetItemList(1)
FirstElement(Werte())
NextElement(werte())
PreviousElement(werte())
mysort(Werte())
ForEach Werte()
AddGadgetItem(1,-1,Str(werte()))
DeleteElement(Werte())
Next
EndSelect
EndIf
Until event=#WM_CLOSE
EndIf