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;