Listbox nach Datum sortieren

[Popov]

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 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 von toms:

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