Listbox nach Datum sortieren

[Codix32]

Hi Leute,

ich raffs nicht. Habe ein Programm, das in einer Listbox Text mit vorgestelltem Datum ausgibt.

Meine Funktionen können die Listbox auch sortieren und das Ganze als Text Datei abspeichern.
Das Problem ist, daß ich das Programm jedesmal schliesen und neustarten muß, damit das Sortieren funktioniert. Wird nach dem Start in die Listbox mehr als ein Eintrag gemacht und mehr als einmal sortiert, steht der neue Item am Anfang der Liste.

Das Proggi sortiert das Datum ausgehend nach den vergangenen Tagen seit 1.01.1900 bis zum eingegebenen Datum. Die Tage stehen kurzfristig am Anfang des Items werden dann mit 'Listbox.sorted' sortiert, danach werden die Tage sofort entfernt, so daß das Datum am Anfang des Items steht:

Beispiel:

07334 31.01.1920 Blalbalbla...
14014 16.05.1938 Tusnelda Geburtstag

danach steht in der Liste:

31.01.1920 Blabalbla
16.05.1928 Tusnelda Geburtstag

Bei Übergabe der aktuellen Jahreszahl in die Funktion sortiert diese nach Monaten und Tagen.

Wo liegt der Fehler? Warum muß ich das Proggi vor dem Sortieren neu starten?

In 'onCreate' wird die Datei geladen:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
BorderIcons := [biSystemmenu];
Form1.caption:='Zeitereignisse um den heutigen -->  '+DatetoStr(Date);
Statusbar1.panels[0].text:='Datum: '+ DatetoStr(Date);
Statusbar1.panels[1].text:='Woche: '+ InttoStr(WeekOfYear(Date));
Statusbar1.panels[2].text:='Jahrestag: '+ TagdesJahres;
Listbox1.itemIndex:=0;
LADE;                   // <-Lade die Datei in Liste
aktuell;
end;

Hier wird ein neuer Item eingetragen, eigentlich schon sortiert und gespeichert:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var InputString:String;
    temp:String;
begin
  InputString:= InputBox('Eingabedialogfenster', 'Datum eingeben, dann 3 Leerzeichen, dann Text', '');
if (IstString_einDatum(DatetoStr(StrtoDate(copy(Inputstring,1,10))))) then
 begin
    temp:= DatetoStr(StrtoDate(copy(Inputstring,1,10)));
    Inputstring:=temp+copy(Inputstring,11,length(Inputstring));
    Listbox1.items.add(Inputstring);
//    Listbox1:=(sortiereListe(Listbox1));
aktuell;
    Listbox1.items.SaveToFile('Uebersicht.txt');
 end;
end;

Hier das Sortieren über einen Button:

Delphi-Quellcode:

procedure TForm1.Button3Click(Sender: TObject);
begin
    Listbox1:=(sortiereListe(Listbox1));
end;

Listbox.sorted wird in der 'function TForm1.sortiereListe(L:TListbox):TListbox;' auf 'True' gesetzt.

[sx2008]

Wenn du das Datum in der Form yyyy-mm-dd ausgibst, dann werden die Datumswerte richtig sortiert.

Delphi-Quellcode:

// hier die notwändige Änderung
temp:= FormatDateTime('yyyy-mm-dd', StrtoDate(copy(Inputstring,1,10)));

Wenn dir das Datumsformat nicht gefällt, musst du "schwerere Geschütze" auffahren.

[Satty67]

Du sortierst anhand der Tage seit 1.1.1990... ich nehme an, die Liste wird auch mit den Tagen am Anfang gespeichert oder in "Lade" davor eingefügt.

Wenn alles geladen und sortiert ist, entfernst Du die Tage, weil es doof aussieht. Wahrscheinlich in der Funktion "Lade" oder "aktuell", je nachdem... den Code hast Du nicht gezeigt.

Sooo.. die Liste ist geladen, sortiert und die Tage davor sind entfernt.

***

Jetzt kommt ein neuer Eintrag in die Liste, ohne die Tage davor. Die ganze Liste hat ja inzwischen keine Tage davor, weil Du die beim Laden entfernt hast, weil es doof aussieht.

Jetzt kommt Deine Sortier Routine, um wegen dem neuen Eintrag zu sortieren. Die Sortier-Routine funktioniert aber nur mit den Tagen davor, das weist Du.

***

Vor jedem Sortieren wieder die Tage vor die Einträge setzten oder anders sortieren (durch Auswerten des Datums), wäre jetzt eine Möglichkeit. Datumsanzeige ändern, wie sx2008 es vorgeschlagen hat, auch eine Möglichkeit (dann kannst Du Dir die Tage davor ganz sparen).

Ein "schwereres Geschütz" wäre, die Anzahl Tage im Object des Listeneintrages zu speichern und mit einer eigenen kleinen Routine nach Object sortieren.

;)

[Codix32]

Hallo Satty67

erstmal Danke für Deine Antwort :-)

Du schreibst:

Zitat:

Zitat von Satty67

Du sortierst anhand der Tage seit 1.1.1990... ich nehme an, die Liste wird auch mit den Tagen am Anfang gespeichert oder in "Lade" davor eingefügt.

Die Liste wird ohne Tage gespeichert, die Tage sind werden in der 'sortieren Funktion eingefügt und entfernt. Sie dienen nur dem Sortiervorgang und müssen danach entfernt werden, weil sonst das weitere Proggi nicht funktioniert - es muß für weitere Funktionen das Datum an erster Stelle stehen.

Zitat:

Zitat von Satty67

Wenn alles geladen und sortiert ist, entfernst Du die Tage, weil es doof aussieht. Wahrscheinlich in der Funktion "Lade" oder "aktuell", je nachdem... den Code hast Du nicht gezeigt.

Wie gesagt wird alles in der Func 'Sortiere' erledigt. Hier mal die Func:

Delphi-Quellcode:

function TForm1.sortiereListe(L:TListbox):TListbox;
var i: integer;
    Tage : string;
    Zeilendatum:String;
    Zeilenrest:string;
begin
for i := 0 to L.items.count-1 do
begin
ZeilenDatum:= copy(L.Items[i],1,10);
Zeilenrest:= copy(L.Items[i],11,length(L.Items[i]));
if IstString_einDatum(Zeilendatum) then
      {sortiert nach Monaten, Jahreszahl(2xxx muß aktuell sein}
//  Tage:= Datumsdiff_inTagen(strtodate('01.01.2009'),setEreignisDatuminZukunft(strtodate(Zeilendatum),strtodate('01.01.2009')));
      {sortiert nach Jahr und Tag, ab 1900}
Tage:= Datumsdiff_inTagen(strtodate('01.01.1900'),setEreignisDatuminZukunft(strtodate(Zeilendatum),strtodate('01.01.1900')));
if copy(Tage,1,1)='-' then Tage:=copy(Tage,2,length(Tage));
L.Items[i]:='';
if length(Tage)=1 then Tage:='0000'+Tage;
if length(Tage)=2 then Tage:='000'+Tage;
if length(Tage)=3 then Tage:='00'+Tage;
if length(Tage)=4 then Tage:='0'+Tage;
L.Items[i]:=Tage+' '+Zeilendatum +''+ Zeilenrest;
end;
L.Sorted := True;
for i := 0 to L.items.count-1 do L.Items[i]:=copy(L.Items[i],7,length(L.items[i]));   //Entfernt die Tage
Result:=L;
end;

Zitat:

Zitat von Satty67

Sooo.. die Liste ist geladen, sortiert und die Tage davor sind entfernt.

***

Jetzt kommt ein neuer Eintrag in die Liste, ohne die Tage davor. Die ganze Liste hat ja inzwischen keine Tage davor, weil Du die beim Laden entfernt hast, weil es doof aussieht.

Genau, hier die Proc:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var InputString:String;
    temp:String;
begin
  InputString:= InputBox('Eingabedialogfenster', 'Datum eingeben, dann 3 Leerzeichen, dann Text', '');
if (IstString_einDatum(DatetoStr(StrtoDate(copy(Inputstring,1,10))))) then
 begin
    temp:= DatetoStr(StrtoDate(copy(Inputstring,1,10)));
    Inputstring:=temp+copy(Inputstring,11,length(Inputstring));
    Listbox1.items.add(Inputstring);
    Listbox1:=(sortiereListe(Listbox1));
aktuell;
    Listbox1.items.SaveToFile('Uebersicht.txt');
 end;
end;

hier das Bild dazu:
http://www.siteupload.de/t961463-ProggiEingabe60jpg.jpg

Zitat:

Zitat von Satty67

Jetzt kommt Deine Sortier Routine, um wegen dem neuen Eintrag zu sortieren. Die Sortier-Routine funktioniert aber nur mit den Tagen davor, das weist Du.

***

Vor jedem Sortieren wieder die Tage vor die Einträge setzten oder anders sortieren (durch Auswerten des Datums), wäre jetzt eine Möglichkeit. Datumsanzeige ändern, wie sx2008 es vorgeschlagen hat, auch eine Möglichkeit (dann kannst Du Dir die Tage davor ganz sparen).

Ein "schwereres Geschütz" wäre, die Anzahl Tage im Object des Listeneintrages zu speichern und mit einer eigenen kleinen Routine nach Object sortieren.

;)

Siehe oben die Func 'sortieren' :-)

Also, woran könnte es liegen, daß ich nach dem Programmstart nur einmal sortieren kann?
Was ist da los mit der Komponente TListbox?

[Luckie]

Also, so sehen die Daten aus, die du bekommst:

Code:

31.01.1920 Blabalbla 
16.05.1928 Tusnelda Geburtstag

Lass das Gefrickel mit den Tagen:

Delphi-Quellcode:

function ExtractDateFromString(s: String): TDateTime;
var
  DateStr: String;
  FormatSetting: TFormatSettings;
begin
  FormatSetting.DateSeparator := '.';
  FormatSetting.ShortDateFormat := 'dd.MM.yyyy';
  DateStr := Copy(s, 1, 10);
  Result := StrToDateTime(DateStr, FormatSetting);
end;

procedure BubbleSort(sl: TStrings);
var
  i, j: Integer;
  TempStr: String;
begin
  for i := sl.Count - 1 downto 1 do
  begin
    for j := 1 to i do
    begin
      if ExtractDateFromString(sl[j-1]) > ExtractDateFromString(sl[j]) then
      begin
        TempStr := sl[j];
        sl[j] := sl[j-1];
        sl[j-1] := TempStr;
      end;
    end;
  end;
end;


procedure TForm2.Button1Click(Sender: TObject);
begin
  BubbleSort(Listbox1.Items);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Listbox1.Items.Add('31.01.1920 Blabalbla');
  Listbox1.Items.Add('16.05.1928 Tusnelda Geburtstag');
  Listbox1.Items.Add('31.08.1974 Michael');
  Listbox1.Items.Add('29.06.1949 Helmut');
  Listbox1.Items.Add('28.09.1948 Gitta');
  Listbox1.Items.Add('20.06.1972 Micky');
  Listbox1.Items.Add('29.06.1810 Bismarck');
  Listbox1.Items.Add('10.05.1905 Heinz');
end;

[Codix32]

Zitat:

Zitat von sx2008

Wenn du das Datum in der Form yyyy-mm-dd ausgibst, dann werden die Datumswerte richtig sortiert.

Delphi-Quellcode:

// hier die notwändige Änderung
temp:= FormatDateTime('yyyy-mm-dd', StrtoDate(copy(Inputstring,1,10)));

Wenn dir das Datumsformat nicht gefällt, musst du "schwerere Geschütze" auffahren.

Hallo sx2008,

das ist eine sehr einfache Lösung, aber:

Die Liste läßt sich nur einmal sortieren und dann kriege ich einen eConvert Error:

'1920-01-31' ist kein gültiges Datum.

Hier die Func:

Delphi-Quellcode:

function TForm1.sortListe2(L:TListbox):TListbox;
var i: integer;
    Zeilendatum:String;
    Zeilenrest:string;
    temp:string;
begin
for i := 0 to L.items.count-1 do
begin
temp:= FormatDateTime('yyyy-mm-dd', StrtoDate(copy(L.Items[i],1,10)));
ZeilenDatum:= temp;
Zeilenrest:= copy(L.Items[i],11,length(L.Items[i]));
L.Items[i]:='';
L.Items[i]:=Zeilendatum +'     '+ Zeilenrest;
end;
 L.sorted:=true;
end;

[Luckie]

Was ist mit miner Lösung?

[Satty67]

Okok... war gestern auch spät und ich war heiterer Stimmung (wie man an meinem Text sieht).

Probier mal, sortieren aus/ein...

Delphi-Quellcode:

L.Sorted := False;
L.Sorted := True;
for i := 0 to L.items.count-1 do L.Items[i]:=copy(L.Items[i],7,length(L.items[i]));   //Entfernt die Tage

Scheinbar wird nicht nochmal sortiert, wenn Sorted bereits True ist. Die Hilfe spricht zwar von sortiertem Einordnen, aber das war wohl anders gemeint.

Wobei Luckie's Code natürlich besser aussieht, zumindest anschauen solltest Du Dir den...

[Codix32]

Zitat:

Zitat von Luckie

Was ist mit miner Lösung?

Hallo Luckie .-)

Wenn Deine Lösung funzt, bin ich happy.

Ich habe früher schon mal versucht, mit Quick- und Bubble Sort was anzufangen und bin
gescheitert.

Ich danke Dir herzlich und werde die Routine gleich mal ausprobieren :thumb:

[Codix32]

Zitat:

Zitat von Satty67

Okok... war gestern auch spät und ich war heiterer Stimmung (wie man an meinem Text sieht).

Probier mal, sortieren aus/ein...

Delphi-Quellcode:

L.Sorted := False;
L.Sorted := True;
for i := 0 to L.items.count-1 do L.Items[i]:=copy(L.Items[i],7,length(L.items[i]));   //Entfernt die Tage

Scheinbar wird nicht nochmal sortiert, wenn Sorted bereits True ist. Die Hilfe spricht zwar von sortiertem Einordnen, aber das war wohl anders gemeint.

Wobei Luckie's Code natürlich besser aussieht, zumindest anschauen solltest Du Dir den...

Ok, das funzt nicht, Satty67. Wenn ich Sorted vorher auf False setze, ist alles durcheinander.

Ich versuchs mal mit Luckies Code.

[Codix32]

Zitat:

Zitat von Luckie

Was ist mit miner Lösung?

DANKE LUCKIE!

Dein Code funzt einwandfrei, ich bin begeistert.

Du bist wohl auch beruflich Programmierer. :-)

[Codix32]

Zitat:

Zitat von Codix32

Zitat:

Zitat von Luckie

Was ist mit miner Lösung?

DANKE LUCKIE!

Dein Code funzt einwandfrei, ich bin begeistert.

Du bist wohl auch beruflich Programmierer. :-)

Hier bin ich wieder. Nichts für ungut, aber die Routine mit Bubblesort ist sehr sehr langsam.


Ich greife also hier wieder auf 'Listbox.sorted' zurück:

Delphi-Quellcode:

procedure TForm1.sortListe3(L:TListbox);
var i: integer;
    Zeilendatum:String;
    Zeilenrest:string;
    temp:string;
    doubleTmp:double;
begin
for i := 0 to L.items.count-1 do
begin
doubleTmp:= strtodate(copy(L.Items[i],1,10));
   temp:=floattostr(doubleTmp);
   if length(temp)=1 then temp:='000000'+temp;
   if length(temp)=2 then temp:='00000'+temp;
   if length(temp)=3 then temp:='0000'+temp;
   if length(temp)=4 then temp:='000'+temp;
   if length(temp)=5 then temp:='00'+temp;
   if length(temp)=6 then temp:='0'+temp;
ZeilenDatum:= temp;
Zeilenrest:= copy(L.Items[i],11,length(L.Items[i]));
L.Items[i]:=Zeilendatum +'     '+ Zeilenrest;
end;
 
L.sorted:=true;

 for i := 0 to L.items.count-1 do
 begin
   doubleTmp:= strtofloat(Trim(copy(L.Items[i],1,10)));
   ZeilenDatum:= datetostr(doubleTmp);//+'    '+floattostr(doubleTmp);
   Zeilenrest:= copy(L.Items[i],11,length(L.Items[i]));
   L.Items[i]:= Zeilendatum +'     '+ Zeilenrest;
 end;
end;

Obwohl die Items durch 2 Schleifen laufen, ist damit ruckizucki sortiert. Es wird das Datum als Double-Zahlenwert an den Anfang jedes Items geschrieben, danach sortiert und in der 2. Schleife der Zahlenwert wieder entfernt.

Obwohl das 'Werk' funzt, gefällt es mir nicht. Gibts noch einen anderen Ansatz?

Ist die Delphi interne Function 'Sorted' eigentlich in Assembler geschrieben und wenn ja, wer hat den Quelltext? Die Funktion ist sehr schnell und daher interessant.

Was meint ihr?

[Luckie]

Wie veiele Einträge hast du denn in der Liste, dass Bubblesort so langsam ist? Du kannst natürlcih auch jeden anderen Sortieralgorithmus nehmen. Bubblesort habe ich nur genommen, weil er relativ einfach und schnell zu implementieren ist.

[Codix32]

Zitat:

Zitat von Luckie

Wie veiele Einträge hast du denn in der Liste, dass Bubblesort so langsam ist? Du kannst natürlcih auch jeden anderen Sortieralgorithmus nehmen. Bubblesort habe ich nur genommen, weil er relativ einfach und schnell zu implementieren ist.

Bei 400 Einträgen braucht die Sortierung ~20 Sekunden. Das ist zu lange. Meine Routine braucht nur etwas unter 1 Sekunde. Ich suche eine saubere Möglichkeit des Sortierens.

[Luckie]

Folgendes: Setzmal den BubbleSort Aufruf in eine TListbox.BeginUpdate und TListbox.EndUpdate. Und dannkannst du noch einen besseren Sortieralgorithmus benutzen, wie zum Beispiel Quicksort oder so.

[Fridolin Walther]

Bubble Sort ist für 400 Einträge völlig ausreichend. Das Problem, wieso es mit einer ListBox so langsam erscheint ist, daß die Operationen um die Position einzelner Strings innerhalb der Listbox zu verändern recht langsam ist, da die UI bei jeder Operation upgedated wird. Entsprechend benutz BeginUpdate und EndUpdate.

Ansonsten benutzt Delphi in so ziemlich allen VCL Komponenten, die sortieren können, QuickSort.

[Luckie]

Listbox, es geht um eine Listbox. Ändert natürlich nichts an deiner Aussage bezüglich des Neuzeichnes beim Verschieben der Einträge.

[Codix32]

Zitat:

Zitat von Luckie

Folgendes: Setzmal den BubbleSort Aufruf in eine TListbox.BeginUpdate und TListbox.EndUpdate. Und dannkannst du noch einen besseren Sortieralgorithmus benutzen, wie zum Beispiel Quicksort oder so.

Danke Dir luckie,

werde das morgen mal probieren. Würde mich interessieren, was 'Listbox.sorted' für ein Algorithmus ist. Mal sehen. .-)

[Luckie]

Zitat:

Zitat von 0xF30FC7

Ansonsten benutzt Delphi in so ziemlich allen VCL Komponenten, die sortieren können, QuickSort.

;)

[Fridolin Walther]

Zitat:

Zitat von Luckie

Listbox, es gerht um eine Listbox. Ändert natürlcih nichts an deiner Aussage bezüglich des Neuzeichnes beim Verschieben der Einträge.

Au ja ... grad gesehen. Danke für den Hinweis. Werds korrigieren :).

Zitat:

Zitat von Codix32

werde das morgen mal probieren. Würde mich interessieren, was 'Listbox.sorted' für ein Algorithmus ist. Mal sehen. .-)

Sagte ich bereits ... QuickSort ;).

[Luckie]

@ 0xF30FC7: Ich fühle mich verfolgt. Bist du das, der in dem schwarzen Lieferwagen bei mir vor dem Haus mit seinem Laptop hockt?

[Fridolin Walther]

Als ob ich meinen heimischen Keller je verlassen würde! :mrgreen:

[Popov]

@Codix32

Ich hab hier noch einen weiteren Ansatz (Code ist ungeprüft, sollte aber funktionieren):

Delphi-Quellcode:

type
  TData = class
    Datum: TDateTime;
    DatumStr: String;
  end;

procedure LBItemHinzufuegen(LB: TListBox; Datum: TDateTime; Str: String);
var
  Data: TData;
begin
  Data := TData.Create;
  Data.Datum := Datum;
  Data.DatumStr := FormatDateTime('yyyy.mm.dd hh:mm:ss', Datum);
  LB.Items.AddObject(Str, Data);
end;

procedure LBItemLoeschen(LB: TListBox; Index: Integer);
var
  Data: TData;
begin
  Data := TData(LB.Items.Objects[Index]);
  Data.Free;
  LB.Items.Delete(Index); 
end;

procedure LBAllesLoeschen(LB: TListBox);
var
  Data: TData;
  i: Integer;
begin
  for i := LB.Items.Count - 1 downto 0 do
  begin
    Data := TData(LB.Items.Objects[i]);
    Data.Free;
    LB.Items.Delete(i);
  end;
end;

procedure LBSortieren(LB: TListBox);
var
  Data: TData;
  i: Integer;
  s: String;
begin
  for i := 0 to LB.Items.Count - 1 do
  begin
    Data := TData(LB.Items.Objects[i]);

    s := Data.DatumStr; // s enthält den String zum sortieren


    // im Data.DatumStr und Data.Datum befinden sich jetzt das Datum als Sting
    // und als Datum. Diese Werte sind unabhängig von dem Text-Inhalt in Items[i],
    // können also eine beliebige Formatierung haben, also auch eine die eine
    // alphabetische Sortierung erleichtet.

    // ... hier die eigene Sortier-Routine
  end;
end;

Der Unterschied hier ist, daß du hier die Daten noch zusätzlich als Objekt an die Items heftest. Bei der Sortierung beachtest du dann die Texte in den Items nicht und sortierst anhand der Daten im Objekt. Der Vorteil ist, da0 du das Datum im Item String so schreiben kannst wie du willst. Warum? Weil es nicht bei der Sortierung beachtet wird.

EDIT:

In Prozedur LBItemLoeschen eine vergessene Zeile hinzugefügt.

[Luckie]

Das wäre natürlich die beste Lösung. Oder man Mißbraucht die Listbox nicht als Datenablage, sondern benutzt sie nur, um die daten darzustellen. Die Daten werden dann in einer Conteainer-Klasse mit einer Liste gehalten und sortiert.

[Starstruck]

Ich habe in einem Delphi Buch eine Shell Sort Sortier Routine gefunden und auf Luckies Beispiel angepasst. Das Ganze sieht dann so aus:

Delphi-Quellcode:

procedure ShellSort(sl: TStrings);
var
  bis, i, j, k: LongInt;
  h: String;

begin
  bis := sl.Count -1;
  k := bis shr 1;
  while k > 0 do begin
    for i := 0 to bis -k do begin
      j := i;
      while (j >= 0 ) AND (ExtractDateFromString(sl[j]) > ExtractDateFromString(sl[j + k])) do begin
        h         := sl[j];
        sl[j]     := sl[j + k];
        sl[j + k] := h;
        if j > k then dec(j, k) else j:=0;
      end; // ENDE While (j >= 0 ..
    end; // for i := 0
    k := k shr 1;
  end; // ENDE While
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellSort(Listbox1.Items);
end;

Habs probiert geht um einiges schneller als BubbleSort (< 1 Sec)!

[hoika]

Hallo,

wer Quicksort benutzen will,
nimmt den eingebauten Algorithmus.

CustomSort


Heiko

[Codix32]

Uff, soviel Hilfe und Unterstützung...Danke Euch :-D

Ich habe grad Zeit und versuche mal die Listbox mit einer im Forum gefundenen QuickSort Routine zu
sortieren. Die gefundene Routine sortiert aber ein Integer - Array. Mein Versuch eine Stringlist zu sortieren endet erstmal hier:

"...EStringlisterror-Exception...Listenindex überschreitet das Maximum(400)". Liegts am '-1' Item der Listbox?

Also, 400 mit Random erstellte Datums sollen mit Quicksort sortiert werden:

Hier mal meine Quicksort für TStrings:

Delphi-Quellcode:

procedure TForm1.QuickSort(sl:TStrings;LoIndex,HiIndex:Integer);

  procedure QSort(LoIndex, HiIndex: Integer);
  var
    Lo, Hi: Integer;
    Pivot: string;//Integer;
    Swap: string;//Integer;
  begin
    // Wähle stets das mittlere Element als Pivotelement.
    Pivot := sl[(LoIndex + HiIndex) div 2];

    // Stelle die Ordnung bzgl. des Pivotelements her.
    Lo := LoIndex;
    Hi := HiIndex;
    repeat
      while sl[Lo] < Pivot do sl[Lo+1];
      while sl[Hi] > Pivot do sl[Hi-1];
      if sl[Lo] <= sl[Hi] then
      begin
        Swap := sl[Lo];
        sl[Lo] := sl[Hi];
        sl[Hi] := Swap;
        sl[Lo + 1];
        sl[Hi - 1];
      end;
    until sl[Lo] > sl[Hi];

    // Gegebenenfalls linke Teilliste sortieren. 
    if LoIndex < Hi then QSort(LoIndex, Hi);

    // Gegebenenfalls rechte Teilliste sortieren.
    if Lo < HiIndex then QSort(Lo, HiIndex); 
  end;

begin
  QSort(0, sl.count);
end;



AUFRUF:

procedure TForm1.Button3Click(Sender: TObject);
begin
QuickSort(Listbox3.items,0,Listbox3.count-1);
end;

[Popov]

Was ist aber mit all den ganzen Beispielen hier? Doch nichts?

Noch ein mal, auch wenn alle hier mit Beispielen kommen wie man ein StringList sortiert, in deinem Fall ist es Quatsch. So kann man Namen sortieren, aber nicht Daten. Natürlich kann man die Schreibweise der Daten dem Problem anpassen, aber das sollte man nicht. Füge der StringList Objekte mit Klar-Daten und sortiere diese anhand dieser Daten. Dann kannst du in dein StringList schreiben was du willst und wie du es willst.

Hier noch mal die komplette Sortierfunktion zu meinem Beispiel oben. Ich hab Luckies Sortierfunktion etwas angepaßt, sortiere aber nach Daten aus den Objekten. Die Strings der Items interessieren mich dabei nicht:

Delphi-Quellcode:

procedure LBSortieren(LB: TListBox);
var
  Data1, Data2, DataTemp: TData;
  Str1, Str2, StrTemp: String;
  i, j: Integer;
begin
  LB.Items.BeginUpdate;

  for i := LB.Items.Count - 1 downto 1 do
  begin
    for j := 1 to i do
    begin
      Data1 := TData(LB.Items.Objects[j-1]);
      Data2 := TData(LB.Items.Objects[j]);

      if Data1.Datum > Data2.Datum then
      begin
        StrTemp := LB.Items[j];
        DataTemp := TData(LB.Items.Objects[j]);

        LB.Items[j] := LB.Items[j-1];
        LB.Items.Objects[j] := LB.Items.Objects[j-1];

        LB.Items[j-1] := StrTemp;
        LB.Items.Objects[j-1] := DataTemp;
      end;
    end;
  end;

  LB.Items.EndUpdate;
end;

Sieht ähnlich aus wie eine normale Sortierung, hier werden aber die Daten aus dem Objekt verglichen.

Hier ein Beispile mit dem du es testen kannst. Prozedur 1 erzeugt 400 Einträge mit Daten und Texten, Prozedur 2 sortiert sie:

Delphi-Quellcode:

//Zufallsdaten generieren
procedure TForm1.Button1Click(Sender: TObject);

  function ZufallsDatum: TDateTime;
  begin
    Result := EncodeDateTime(Random(109) + 1900, Random(12) + 1, Random(28) + 1,
      Random(23) + 1, Random(59) + 1, Random(59) + 1, Random(100) + 1);
  end;

const
  x = 'Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed di';
var
  i: Integer;
  DT: TDateTime;
  ZT: String;
begin
  for i := 0 to 400 - 1 do
  begin
    DT := ZufallsDatum;
    ZT := Copy(x, Random(40) + 1, Random(20) + 4); //ZufallsText
    LBItemHinzufuegen(ListBox1, DT, DateTimeToStr(DT) + ' ' + ZT);

    //hier eine etwas verschärfte Version
    //LBItemHinzufuegen(ListBox1, DT, ZT + ' ' + DateTimeToStr(DT));
  end;
end;

//Alles sortieren
procedure TForm1.Button2Click(Sender: TObject);
begin
  LBSortieren(ListBox1);
end;

[DeddyH]

Und wieso wird Heikos Vorschlag mit CustomSort ignoriert? Das ist doch genau für solche Fälle vorgesehen und verwendet intern einen Quicksort.

[Codix32]

Ich danke euch. Nein nein, ich ignoriere nichts. Ich nehme alle Vorschläge dankend an.

Habe nur gerade die wahnwitzige Idee, ein kleines Proggi mit mehreren Listboxen zu machen, die gleichzeitig die Daten mit verschiedenen Routinen sortiert. Ich hatte vor Tagen nur begonnen, die Quicksort-Routine ins Programm zu schreiben und zu verändern. Deshalb wollte ich diese erst vollenden.

Popov, die Listbox soll ja nach Datums sortiert werden. Einmal absteigend nach Jahren und ein andermal nach Monaten, wobei im letzteren Fall die Jahre keine Rolle spielen.

Die 'ShellSort' von Starstruck habe ich schon drin.
Die 'CustomSort'(Link von hoika), hab ich mir schon angeschaut und gefällt mir von allen bisher am besten. :-)

Was mir fehlt ist mehr Zeit zu haben. Ich möchte ja nicht nur abschreiben, sondern auch was lernen.

:-D

[Popov]

Zitat:

Zitat von Codix32

Popov, die Listbox soll ja nach Datums sortiert werden. Einmal absteigend nach Jahren und ein andermal nach Monaten, wobei im letzteren Fall die Jahre keine Rolle spielen.

Hä? Entweder du beschreibst das falsch oder ich verstehe es nicht. Entweder es wird sortiert oder es wird nicht sortiert. Es ist doch egal ob im letzten Fall die Jahre keine Rolle spielen. Gerade dann solltest du nicht mit Strings arbeiten, sondern mit Daten. Denn bei Daten kannst du viel einfacher Monate und Jahre ermitteln.

Ich gehe mal davon aus, daß du meinst, daß du zwei ListBoxen hast, und bei dem einem wird nach Jahren, bei den anderen nur nach Monaten (unabhängig von Jahren) sortiert. Aber auch da sollte alles in der Reihenfolge der Jahre sortiert sein.

Ich hab mir die QuickSort Routine noch mal angesehen, nachdem ich bemerkt habe, daß BubbleSort durchaus 400 Werte innerhalb einer Sekunde sortiert, bei 4000 Werten aber paar Minuten braucht.

Tatsächlich ist die QuickSort schneller und schaft 4000 Werte in zwei Sekunden. Hier also meine Prozedur von oben, nur mit QuickSort.

Delphi-Quellcode:

procedure LBSortieren(LB: TListBox); // QuickSort

  procedure QuickSort(LB: TListBox; iLo, iHi: Integer);
  var
    Lo, Hi: Integer;
    DataM, DataT: TData;
    StrT: String;
  begin
    Lo := iLo;
    Hi := iHi;
    DataM := TData(LB.Items.Objects[(Lo + Hi) div 2]);

    repeat
      while TData(LB.Items.Objects[Lo]).Datum < DataM.Datum do Inc(Lo);
      while TData(LB.Items.Objects[Hi]).Datum > DataM.Datum do Dec(Hi);

      if Lo <= Hi then
      begin
        StrT := LB.Items[Lo];
        DataT := TData(LB.Items.Objects[Lo]);

        LB.Items[Lo] := LB.Items[Hi];
        LB.Items.Objects[Lo] := LB.Items.Objects[Hi];

        LB.Items[Hi] := StrT;
        LB.Items.Objects[Hi] := DataT;

        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;

    if Hi > iLo then QuickSort(LB, iLo, Hi);
    if Lo < iHi then QuickSort(LB, Lo, iHi);
  end;

begin
  QuickSort(LB, 0, LB.Count - 1);
end;

[DeddyH]

Und wieso nicht per CustomSort?

Delphi-Quellcode:

uses math;

function ListCompare(List: TStringList; Item1,Item2: integer): integer;
begin
  Result := Sign(integer(List.Objects[Item1]) - integer(List.Objects[Item2]));
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var List: TStringlist;
begin
  //Listbox.Items ist vom Typ TStrings und kennt deshalb kein CustomSort
  //Daher wird temporär eine TStringlist erzeugt, kopiert, sortiert und wieder zurückgeschrieben
  List := TStringlist.Create;
  try
    try
      ListBox1.Items.BeginUpdate;
      List.Assign(ListBox1.Items);
      List.CustomSort(@ListCompare);
      ListBox1.Items.Assign(List);
    finally
      ListBox1.Items.EndUpdate;
    end;
  finally
    List.Free;
  end;
end;

[Popov]

:Codix32

Ich hab paar Punkte an deinem Beispiel geändert, hab es aber nicht ausprobiert, sondern direkt hier im Edit Fenster getippt. Es kann also sein, daß es nicht funktioniert. Teste es aber mal und sag bescheid.

Delphi-Quellcode:

    repeat
      while sl[Lo] < Pivot do Inc(Lo);
      while sl[Hi] > Pivot do Dec(Hi);
      if Lo <= Hi then
      begin
        Swap := sl[Lo];
        sl[Lo] := sl[Hi];
        sl[Hi] := Swap;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;

[Codix32]

Ein 'Hallo' an Popov und alle Delphianer hier.

Da bin ich wieder. Ich habe mal einige Vorschläge versucht umzusetzen und bin gescheitert.

Popov, Deine 'Listboxsortieren' Routine hängt an folgendem Problem:

EStringlistError:"Listenindex überschreitet das Maximum 199'".

Also von 400 Einträgen ist das ungefähr die Hälfte und das Problem hängt hier:

Delphi-Quellcode:

procedure TForm1.LBSortieren(LB: TListBox); // QuickSort

type
  TData = class
    Datum: TDateTime;
    DatumStr: String;
  end;

...

 procedure QuickSort(LB: TListBox; iLo, iHi: Integer); 
  var 
    Lo, Hi: Integer; 
    DataM, DataT: TData; 
    StrT: String;
  begin
   ....
   .... 
    DataM := TData(LB.Items.Objects[(Lo + Hi) div 2]);  <- gibt 199 und den Fehler!
   ....

Ich komme da nicht dahinter warum hier ein StringListFehler sein soll !?!?

[toms]

Zitat:

Zitat von Codix32

Ich habe grad Zeit und versuche mal die Listbox mit einer im Forum gefundenen QuickSort Routine zu
sortieren.

Warum das Rad neu erfinden (resp. Quicksort neu implementieren)?
TStringList.CustomSort sortiert ja schon mit QuickSort.

[Codix32]

Zitat:

Zitat von toms

Zitat:

Zitat von Codix32

Ich habe grad Zeit und versuche mal die Listbox mit einer im Forum gefundenen QuickSort Routine zu
sortieren.

Warum das Rad neu erfinden (resp. Quicksort neu implementieren)?
TStringList.CustomSort sortiert ja schon mit QuickSort.

Weils nicht funzt, Toms.

Schau mal hier:
http://www.siteupload.de/t975238-Cus...rtierenJPG.JPG

Diesen Fehler kriege ich selbst, wenn ich z. B. diesen hier mache:

Delphi-Quellcode:

var

MStr:TStrings;

begin
Mstr:=TStrings(LB.Items.Objects[(Lo + Hi)div 2]);
end;

oder auch:

MStr:=TStrings(LB.Items.Objects[(0);

Mit dem "Objects" geht nix. Hat mein Delphi 'nen Fehler?

[mschaefer]

Da fehlt das Create und Destroy...

[Codix32]

Zitat:

Zitat von mschaefer

Da fehlt das Create und Destroy...

Nö, geht nicht:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
MStr:TStrings;
Lo,Hi:integer;
begin
MStr:=TStrings.Create;
Lo:=0;
Hi:=Listbox1.items.count-1;
Mstr:=TStrings(Listbox1.Items.Objects[(Lo + Hi)div 2]);
MStr.Destroy;
end;

Es bleibt bei der Fehlermeldung.

Und auch das geht nicht:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
MStr:TStringlist;
Lo,Hi:integer;
begin
MStr:=TStringlist.Create;
Lo:=0;
Hi:=Listbox1.items.count-1;
Mstr:=TStringlist(Listbox1.Items.Objects[(Lo + Hi)div 2]);
MStr.Destroy;
end;

Das hier geht:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
MStr:string;
Lo,Hi:integer;
begin
Lo:=0;
Hi:=Listbox1.items.count-1;
Mstr:=(Listbox1.Items[(Lo + Hi)div 2]);
Label2.caption:=MStr;
end;

[toms]

Bei mir funktioniert's so:

Delphi-Quellcode:

procedure ZufallsDatumHinzufuegen;
var
  i: Word;
begin
  for i := 0 to 1000 do
    Form1.Listbox1.Items.Add(DateToStr(EncodeDate(Random(109) + 1900, Random(12) + 1, Random(28) + 1)));
end;

function CompareDates(List: TStringList; Index1, Index2: Integer): Integer;
var
  d1, d2: TDateTime;
begin
  d1 := StrToDate(List[Index1]);
  d2 := StrToDate(List[Index2]);
  if d1 < d2 then
    Result := -1
  else if d1 > d2 then Result := 1
  else
    Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TStringlist;
begin
  ZufallsDatumHinzufuegen;
  List := TStringlist.Create;
  try
    ListBox1.Items.BeginUpdate;
    try
      List.Assign(ListBox1.Items);
      List.CustomSort(@CompareDates);
      ListBox1.Items.Assign(List);
    finally
      ListBox1.Items.EndUpdate;
    end;
  finally
    List.Free;
  end;
end;

[Codix32]

Zitat:

Zitat von toms

Bei mir funktioniert's so:

Delphi-Quellcode:

procedure ZufallsDatumHinzufuegen;
var
  i: Word;
begin
  for i := 0 to 1000 do
    Form1.Listbox1.Items.Add(DateToStr(EncodeDate(Random(109) + 1900, Random(12) + 1, Random(28) + 1)));
end;

function CompareDates(List: TStringList; Index1, Index2: Integer): Integer;
var
  d1, d2: TDateTime;
begin
  d1 := StrToDate(List[Index1]);
  d2 := StrToDate(List[Index2]);
  if d1 < d2 then
    Result := -1
  else if d1 > d2 then Result := 1
  else
    Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TStringlist;
begin
  ZufallsDatumHinzufuegen;
  List := TStringlist.Create;
  try
    ListBox1.Items.BeginUpdate;
    try
      List.Assign(ListBox1.Items);
      List.CustomSort(@CompareDates);
      ListBox1.Items.Assign(List);
    finally
      ListBox1.Items.EndUpdate;
    end;
  finally
    List.Free;
  end;
end;

Ich werd' nicht mehr. Habe Dein hiesiges Beispiel mit dem Zeiger auf CompareDates probiert und kriege schon wieder diese Fehlermeldung, daß ich das Maximum überschreite. Das ist doch nicht normal?!?