TList einmal erweitert

[Opa]

Delphi-Quellcode:

unit DhTList;
{$X+}
interface
uses
  Classes,RTLConsts;
type
  {Type-TList}
  TLSortNach = (cslNone,cslAlphaNum,cslNumeric,cslDateTime,cslNumericIn64);
  TList = class(Classes.TList)
  private
    FTag        : integer;
    FSorted     : boolean;
    FDuplicates : TDuplicates;
    FSortNach   : TLSortNach;
  protected
  public
    constructor Create;virtual;
    destructor  Destroy;override;
    function    Add(Item: Pointer):integer;virtual;
    function    Find(Item: pointer; var Index: integer): boolean;virtual;

    property Duplicates : TDuplicates read FDuplicates write FDuplicates default dupIgnore;//dupAccept
    property SortNach   : TLSortNach read FSortNach    write FSortNach   default cslNone;
  published
    property Tag    : integer read FTag    write FTag    default 0;
    property Sorted : boolean read FSorted write FSorted default false;
  end;

implementation
uses
 SysUtils,Windows;

function Dh_CompareAlphaNum(Item1, Item2: pointer):integer;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(Item1^),
            Length(string(Item1^)), PChar(Item2^), Length(string(Item2^))) - 2;
end;
//--------------------------------------------------------------------------------------------------
function Dh_CompareNumeric(const I1,I2: integer): integer;overload;
begin
  if I1 > I2
  then Result := 1
  else if I1 = I2
       then Result := 0
       else Result := -1;
end;
//--------------------------------------------------------------------------------------------------
function Dh_CompareNumeric(Item1,Item2: pointer):integer;overload;
begin
  Result := Dh_CompareNumeric(integer(Item1^),integer(Item2^));
end;
//--------------------------------------------------------------------------------------------------
function Dh_CompareDate(D1, D2: TDateTime):integer;overload;
begin
  if (D1 > D2)
  then Result := 1
  else if (D1 = D2) then Result := 0
                    else Result := -1;
end;
//--------------------------------------------------------------------------------------------------
function Dh_CompareDate(Item1, Item2: pointer):integer;overload;
begin
  Result := Dh_CompareDate(TDateTime(Item1^),TDateTime(Item2^));
end;
//--------------------------------------------------------------------------------------------------
function Dh_CompareNumericInt64(const I1,I2: int64): integer;overload;
begin
  if I1 > I2
  then Result := 1
  else if I1 = I2
       then Result := 0
       else Result := -1;
end;
//--------------------------------------------------------------------------------------------------
function Dh_CompareNumericInt64(Item1, Item2: pointer):integer;overload;
begin
  Result := Dh_CompareNumericInt64(int64(Item1^),int64(Item2^));
end;

{Public-Anfang=====================================================================================}
constructor TList.Create;
begin
  inherited;
  FTag        := 0;
  FSorted     := false;
  FDuplicates := dupIgnore;
end;
//--------------------------------------------------------------------------------------------------
destructor TList.Destroy;
begin
  inherited Destroy;
end;
//--------------------------------------------------------------------------------------------------
{Änderung von Dirk}
function TList.Add(Item: Pointer): Integer;
begin
  if FSorted then
  begin
    if Find(Item, Result) then
    begin
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateItem, Integer(Item));
        dupAccept: Insert(Result, Item);
      end;
    end else Insert(Result, Item);
  end else Result := inherited Add(Item);
end;
//--------------------------------------------------------------------------------------------------
function TList.Find(Item: pointer; var Index: integer): boolean;
var
  L, H, I, C: integer;
begin
  Result := false;
  if FSortNach = cslNone then Exit;
  L := 0;
  H := Self.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    case FSortNach of
     cslAlphaNum     : C := Dh_CompareAlphaNum(PChar(Items[I]),PChar(Item));
     cslNumeric      : C := Dh_CompareNumeric(integer(Items[I]^),integer(Item^));
     cslDateTime     : C := Dh_CompareDate(TDateTime(Items[I]^),TDateTime(Item^));
     cslNumericIn64  : C := Dh_CompareNumericInt64(int64(Items[I]^),int64(Item^));
    end;
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := true;
        if Duplicates <> dupAccept then L := I;
      end;
    end;
  end;
  Index := L;
end;
{Public-Ende=======================================================================================}

end.

Dazu ein kleines Beispiel
Das TList kann eine sortierte Liste ohne doppelte Zeichen ausgeben. Ähnlich wie bei TStringList
Nur es werden auch noch Zahlen verarbeitet TdateTime; Int64; integer und nartürlich ein String
Weiß nicht ob es das schon hier gibt, ist einfach ein Abfallprodukt meines Schaffens. *g
Wer es Gebrauchen kann.
Tlist hat jetzt auch noch ein Tag-Feld

Delphi-Quellcode:

{
  TList = class (DhTList.TList);

  TMain = class(TForm)
  ...
  end
}
procedure TMain.Button1Click(Sender: TObject);
const
  S : array[0..4] of string  =('A','B','A','a','C');
  X : array[0..4] of integer =(1,2,3,3,4);
var
  TL : DhTList.TList;
  I : Integer;
begin
  TL := TList.Create;
  try
    TL.SortNach := cslAlphaNum;
    TL.Sorted   := true;
    Memo1.Lines.Clear;
    for I := 0 to High(S) do
      TL.Add(@S[I]);
    for I := 0 to TL.Count -1  do
      Memo1.Lines.Add(string(TL[I]^));
    TL.SortNach := cslNumeric;
    TL.Clear;
    for I := 0 to High(X) do
      TL.Add(@X[I]);
    for I := 0 to TL.Count -1  do
      Memo1.Lines.Add(IntToStr(integer(TL[I]^)));
  finally
    FreeAndNil(TL);
  end;
end;

[Luckie]

Soll das ein neuer Beitrag für die Code-Library sein?

[Tryer]

Du scheinst deinen eigenen Code nicht wirklich verstanden zu haben:
Wenn Find immer den richtigen Index zurückgibt, warum sortierst Du dann die ganze Liste beim Add()? Insert() führt zum gleichen Ergebnis und ist bedeutend schneller.

Die verschiedenen Sortierungen bringen auch nur selten etwas, da als Folge von OOP auch meistens Objekte in der Liste stehen - und die Sortierroutine dafür muss man eh anpassen.

Grüsse, Dirk

[Opa]

Binär suchen kann man nur mit einer sortierten Liste, deswegen das Sortieren.
Mir ging es in meinen Prg. um doppelte Einträge in einer Liste und TList kann das (Bei Delphi 7) nicht.
Ich habe mein Prg schon verstanden, soll aber nicht heißen das es die Beste aller Möglichkeiten ist. Was ich brauchte habe ich aber nicht gefunden. Deswegen das Teil. Kann ja sein das es einer gebrauchen kann. Wenn nicht, ist es mir auch egal.

Und da du vermutlich alles besser weist, hier eine kleine Anfrage an dich konnte bis jetzt noch keiner lösen.
ListView

TStringList macht das auch, aber nur mit Strings.

************
Mir ist es egal wohin ihr das verschiebt

[Tryer]

Ups, Deine Reaktion zeigt das ich mich wohl etwas im Ton vergriffen habe. Sorry.

Wenn ich das richtig sehe liefert Find schon den richtigen Index an den das Item gehören würde, selbst wenn es nicht gefunden wird. Somit brauchst Du nicht sortieren, da die Liste (wenn man an dieser Stelle einfügt) weiterhin sortiert ist. Das Einfügen geht deutlich schneller da nur der hintere Teil der Liste im Speicher verschoben wird, ohne das noch einmal Elemente miteinander verglichen werden müssen. Das dupError vervollständigt nur die Duplicate - Einstellmöglichkeiten.

Delphi-Quellcode:

..uses RTLConsts,..;

function TList.Add(Item: Pointer): Integer;
begin
  if FSorted then
  begin
    if Find(Item, Result) then
    begin
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateItem, Integer(Item));
        dupAccept: Insert(Result, Item);
      end;
    end else
      Insert(Result, Item);
  end else
    Result := inherited Add(Item);
end;

Grüsse, Dirk

PS: nach 10 Tagen ohne Antwort darfst Du in Deinem anderen Thread ruhig darauf hinweisen das das Problem noch besteht, sonst denkt hier vermutlich jeder das es sich erledigt hat.

[Opa]

Entschuldigung angekommen. :-D

Ich hatte das Ding eigentlich aus TListString abgekupfert und ein bisschen erweitert, durchgeht überprüft habe ich das in der Tat nicht. In meinen Prg. ging es eigentlich nur darum eine Adr aus einem normalen Tlist, da muss ich was markieren und die Markierten wollte ich nicht doppelt haben. Ich wollte auch keine normale TstringList machen, weil ich dann die Strings doppelt im Speicher habe. Mir reichen aber die Adr.

Ich werde das mal in Ruhe überprüfen was du gesagt hast und ggf. die Sache oben ändern.
Es geht dabei um so eine record und daraus einzelen Werte
PDateiListRec = ^TDateiListRec;
TDateiListRec = packed record
SRec : TSearchRec;
Pfad : string;
DateiName : string;
Ext : string;
DestPfad : string;
DestDateiName : string;
DestExt : string;
Attr : string;
CRC64Calc : int64;
Duplikat : boolean;
DatumSuchen : boolean;
Error : boolean;
Change : boolean;
DateTime : TDateTime;
DuplikatIndex : integer;
Select : boolean;
Index : word;
end;

[alzaimar]

Hsllo ihr Zwei,

mir fällt in letzter Zeit immer häufiger auf, das man sich aus Unachtsamkeit oder vermeindlich 'schlechtem' Code im Ton vergreift. Gut, das Selbstkritik noch nicht ausgestorben ist. :thumb:

[Opa]

Dirk hatte insoweit Recht das ich mir das Sort hätte sparen können.
Jetzt müsste der Code aber für das Code-Library geeignet sein.

Gott erschuf die Welt, ich gab ihm den Tipp. Genau so ist sie geworden. :-D