class(TList) -> Sortierproblem

sahib · Beiträge: 117 Win 2000 SP4+ Delphi 5 Prof.

Hallo.

Ich habe mir die TList abgeleitet, um ein automatisches Typecasting einzubauen. Das hat auch wunderbar geklappt. Nun habe ich aber Probleme mit der Sortierung der Liste, ich bekomme immer eine EAccessViolation, und der Code stoppt im Quicksort-Algorithmus. Hier mal der betreffende Codeschnipsel, vereinfacht.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

type
  PDataSet = ^TDataSet;
  TDataSet = record
    a, b: Integer;
    s   : String;
  end;

  TData = class(TList)
  private
    function CompareValue(const I1, I2: Integer): Integer;
  public
    property Items[Index: Integer]: PDataSet read GetDataSet write PutDataSet; default;
    procedure SortBy1stValue;
  end;

var
  lstData: TData;

function TData.CompareValue(const I1, I2: Integer): Integer;
begin
  if I1 > I2 then Result := 1 else
  if I2 > I1 then Result := -1
  else Result := 0
end;

function DoSortBy1st(Item1, Item2: Pointer): Integer;
begin
  // Hier steht eigentlich der richtige Vergleichscode,
  // aber nicht einmal diese Light-Version klappt
  Result := 1
end;

procedure TData.SortBy1st;
begin
  Sort(@DoSortBy1st)
end;

Bestimmt sieht einer von Euch sofort den Fehler, der sich mir im Moment nicht erschließt.

Christian

sahib · Beiträge: 117 Win 2000 SP4+ Delphi 5 Prof.

Hat sich erstmal erledigt. Das hat im Moment keine Priorität. Aber falls doch noch jemand eine Lösung hat, würde es mich natürlich interessieren.

Christian

CenBells · Beiträge: 1547 Win 7 Delphi XE5 Pro

hi,

ich bin mir jetzt nicht so sicher, aber bist du dir sicher, daß du das @ brauchst?

markieren

Delphi-Quelltext

1:
2:
3:
4:

procedure TData.SortBy1st;
begin
  Sort(@DoSortBy1st)
end;

Hast du es mal ohne versucht?

Gruß
Ken

_________________
Eine Klasse beschreibt die Struktur und das Verhalten einer Menge gleichartiger Objekte.

sahib · Beiträge: 117 Win 2000 SP4+ Delphi 5 Prof.

Hallo Ken.

Danke für Deine Antwort. Das hilft leider auch nicht, hatte ich nämlich auch schon getestet. Weiterhin habe ich auch schon versucht, statt der Pointer meinen Record als Paramter einzusetzen. Wenn ich mich mal wieder an dieses Problem setze, werde ich wohl erstmal den Debugger zu Rate ziehen. Aber wie gesagt, ist jetzt erstmal temporär aufs Eis gelegt.

Christian

Sprint · Beiträge: 849

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

type
  PDataSet = ^TDataSet;
  TDataSet = record
    ValueA: Integer;
    ValueB: Integer;
    Text: String;
  end;

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

type
  TDataList = class(TList)
  private
    function GetItem(Index: Integer): PDataSet;
    procedure SetItem(Index: Integer; ADataSet: PDataSet);
  public
    function Add(ADataSet: PDataSet): Integer;
    procedure Sort;
    property Items[Index: Integer]: PDataSet read GetItem write SetItem;
  end;

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

{ TDataList }

function Compare(Item1, Item2: Pointer): Integer;
begin
  if PDataSet(Item1)^.ValueA = PDataSet(Item2)^.ValueA then
    Result := 0
  else if PDataSet(Item1)^.ValueA > PDataSet(Item2)^.ValueA then
    Result := 1
  else
    Result := -1;
end;

{--------------------------------------------------------------------------------------------------}

function TDataList.Add(ADataSet: PDataSet): Integer;
begin
  Result := inherited Add(ADataSet);
end;

{--------------------------------------------------------------------------------------------------}

function TDataList.GetItem(Index: Integer): PDataSet;
begin
  Result := inherited Items[Index];
end;

{--------------------------------------------------------------------------------------------------}

procedure TDataList.SetItem(Index: Integer; ADataSet: PDataSet);
begin
  inherited Items[Index] := ADataSet;
end;

{--------------------------------------------------------------------------------------------------}

procedure TDataList.Sort;
begin
  inherited Sort(Compare);
end;

{--------------------------------------------------------------------------------------------------}

_____

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

procedure TForm1.Button1Click(Sender: TObject);
const
  S_TEXT = '%s (%d)' + #13#10;
var
  Data: PDataSet;
  List: TDataList;
  I: Integer;
  S: String;
begin

  S := 'Unsortiert:' + #13#10;
  List := TDataList.Create;

  try

    for I := 1 to 15 do
    begin
      New(Data);
      List.Add(Data);
      Data^.ValueA := Random(100);
      Data^.Text := 'Data ' + IntToStr(I);
      S := S + Format(S_TEXT, [Data^.Text, Data^.ValueA]);
    end;

    S := S + #13#10 + 'Sortiert:' + #13#10;
    List.Sort;

    for I := 0 to List.Count - 1 do
    begin
      S := S + Format(S_TEXT, [List.Items[I].Text, List.Items[I].ValueA]);
      Data := List.Items[I];
      Dispose(Data);
    end;

    ShowMessage(S);

  finally
    List.Free;
  end;

end;

oder

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

procedure TForm1.Button1Click(Sender: TObject);
const
  S_TEXT = '%s (%d)' + #13#10;
var
  Data: array[1..15] of TDataSet;
  List: TDataList;
  I: Integer;
  S: String;
begin

  S := 'Unsortiert:' + #13#10;
  List := TDataList.Create;

  try

    for I := Low(Data) to High(Data) do
    begin
      List.Add(@Data[I]);
      with Data[I] do
      begin
        ValueA := Random(100);
        Text := 'Data ' + IntToStr(I);
        S := S + Format(S_TEXT, [Text, ValueA]);
      end;
    end;

    S := S + #13#10 + 'Sortiert:' + #13#10;
    List.Sort;

    for I := 0 to List.Count - 1 do
      with List.Items[I]^ do
        S := S + Format(S_TEXT, [Text, ValueA]);

    ShowMessage(S);

  finally
    List.Free;
  end;

end;

_________________
Ciao, Sprint.

sahib · Beiträge: 117 Win 2000 SP4+ Delphi 5 Prof.

Hallo Sprint.

Wieder einmal vielen Dank für Deine flotte Hilfe. Deine Code funktioniert gut. Bei uns beiden sieht der Code für den Zugriff auf die TList anders aus, hier meiner:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:

function TData.GetData(Index: Integer): PDataSet;
begin
 Result := PData(inherited Items[Index])
end;

procedure TData.PutData(Index: Integer; Item: PDataSet);
begin
 inherited put(Index, Pointer(Item))
end;

Die TList konnte ich auch sehr gut ausgeben, die Daten waren alle korrekt enthalten, nur das Sortieren klappte nicht. Also, danke nochmals,

Christian

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme