Ich habe eine Drittkomponete, die verwendet folgende Listen. Könnte mit jemand erklären, wie man um Gottes Willen auf so was kommt oder ist das ggf. genial?. Ich kapiers eh nicht.. Und, wie würde man denn sowas heutzutage machen? Ich weiß nur, daß die ihr Zeugs auch für C Builder usw. anbieten, könnte das evtl. der Grund sein?

zusammenfalten · markieren

Delphi-Quellcode:

const
  cnstGUID_CollectionBase = '{ .. }';
  cnstGUID_CollectionBaseSort = '{ .. }';
  cnstDefaultCapacity = 4;
  DefaultCountToUseSimpleSort = 13;

type
  TsgInterfacedObject = class(TObject, IInterface)
  protected
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  end;

  TsgThreadContainerList = class
  private
    FList: {$IFDEF SG_OPENING_IN_THEADS} TThreadList {$ELSE} TList {$ENDIF};
  public
    constructor Create;
    destructor Destroy; override;
    function LockList: TList;
    procedure UnlockList;
  end;

  IsgCollectionBase = interface(IInterface)
    [cnstGUID_CollectionBase]
    function GetCount: Integer;
    procedure Delete(const AIndex: Integer);
    property Count: Integer read GetCount;
  end;

  TsgObjProcCompare = function(const A, B: Pointer): Integer of object;

   IsgCollectionBaseSort = interface(IsgCollectionBase)
     [cnstGUID_CollectionBaseSort]
     function GetDuplicates: TDuplicates;
     function GetSorted: Boolean;
     procedure SetDuplicates(const AValue: TDuplicates);
     procedure SetSorted(const AValue: Boolean);
     procedure SetProcCompare(const AValue: TsgObjProcCompare);
     property Sorted: Boolean read GetSorted write SetSorted;
     property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
   end;

  TsgListType = (ltNil, ltList, ltFPoint, ltF2DPoint, ltDouble, ltSingle,
    ltFloat, ltInt64, ltInteger, ltPointer, ltHashItem);

  TsgCopyMode = (cmCopy, cmAppend);

  TsgBaseList = class(TsgInterfacedObject, IsgCollectionBase, IsgCollectionBaseSort)
  private
    FSortSmallerFunc: TsgObjProcCompare;
    FSorted: Boolean;
    FDuplicates: TDuplicates;
    FCount: Integer;
    FCapacity: Integer;
    FItemSize: Integer;
    FRawData: Pointer;
    procedure ChangeCount(CountChange: Integer);
    procedure IncCount;
    procedure SetCapacity(const Value: Integer);
  protected
    function AddBase(const AItem: Pointer): Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
    procedure AppendArrayBase(NewItems: Pointer; NewItemsAddCount: Integer);
    function ComparePointers(const A, B: Pointer): Integer; virtual;
    function FindBase(const AItem: Pointer; var AIndex: Integer): Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
    procedure FixOldVersion; virtual;
    function GetCount: Integer;
    function GetDuplicates: TDuplicates;
    function GetItemBase(const AIndex: Integer): Pointer;{$IFDEF USE_INLINE}inline;{$ENDIF}
    function GetItemSize: Integer;
    function GetListType: TsgListType; virtual;
    function GetProcCompare: TsgObjProcCompare;
    function GetSorted: Boolean;
    function IndexOfBase(const AItem: Pointer): Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
    procedure InsertBase(const AIndex:Integer; const AItem: Pointer);{$IFDEF USE_INLINE}inline;{$ENDIF}
    function RemoveBase(const AItem: Pointer): Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
    procedure SetCount(NewCount: Integer); virtual;
    procedure SetCountNoInitFini(NewCount: Integer);
    procedure SetDefaultCompareProc(var AProc: TsgObjProcCompare); virtual;
    procedure SetDuplicates(const Value: TDuplicates);
    procedure SetProcCompare(const AValue: TsgObjProcCompare);
    procedure SetSorted(const Value: Boolean); virtual;
    function ToStr: string;
    function FromStr(const AValue: string): Integer;
  public
    constructor Create; overload; virtual;
    constructor Create(const Source: TsgBaseList); overload;
    constructor Create(const InitialCount: Integer;
      const Capacity: Integer = cnstDefaultCapacity); overload;
    destructor Destroy; override;
    procedure AppendDynArray(Arr: TsgBaseList); overload;
    procedure AppendDynArray(Arr: TsgBaseList; Index, ACount: Integer); overload;
    procedure Assign(Source: TsgBaseList); virtual;
    procedure Clear(ClearCapacity: Boolean = False); virtual;
    function CopyFrom(const AList: TList;
      const AMode: TsgCopyMode = cmCopy): Boolean; virtual;
    function CopyTo(const AList: TList;
      const AMode: TsgCopyMode = cmCopy): Boolean; virtual;
    procedure Delete(const AIndex: Integer); overload;
    procedure Delete(const Index: Integer; DelCount: Integer); overload;
    procedure FillChar(FillValue: byte);
    procedure Flip;
    procedure CyclicShiftLeft(const AValue: Integer);
    procedure CyclicShiftRight(const AValue: Integer);
    function High: Integer;
    function IsEqual(const AList: TsgBaseList; Compare: TsgObjProcCompare = nil): Boolean;
    function IsItemsUnique: Boolean;
    procedure Sort(CountToUseSimpleSort: Integer = DefaultCountToUseSimpleSort); overload;
    procedure Sort(FirstIndex, LastIndex: Integer;
      CountToUseSimpleSort: Integer = DefaultCountToUseSimpleSort); overload; virtual;
    procedure SwapItems(Index1, Index2: Integer; const ASwapItemsBuf: Pointer = nil);
    function FromXML(const ANode: TObject): Boolean;
    function ToXML(const ANode: TObject; AItemName: string = ''): Boolean;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount write SetCount;
    property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
    property ListType: TsgListType read GetListType;
    property ProcCompare: TsgObjProcCompare read GetProcCompare write
      SetProcCompare;
    property Sorted: Boolean read GetSorted write SetSorted;
  end;

  TsgDoubleArray = array[0..MaxInt div SizeOf(Double) - 1] of Double;
  PsgDoubleArray = ^TsgDoubleArray;

  IsgCollectionDouble = interface(IsgCollectionBaseSort)
    function GetItem(const AIndex: Integer): Double;
    procedure SetItem(const AIndex: Integer; const AValue: Double);
    property Items[const AIndex: Integer]: Double read GetItem
      write SetItem; default;
  end;

  TsgDoubleList = class(TsgBaseList, IsgCollectionDouble)
  private
    function GetFirst: Double;
    function GetLast: Double;
    function GetList: PsgDoubleArray;
    function GetItem(const AIndex: Integer): Double;{$IFDEF USE_INLINE}inline;{$ENDIF}
    procedure SetFirst(const Value: Double);
    procedure SetLast(const Value: Double);
    procedure SetItem(const AIndex: Integer; const Item: Double);{$IFDEF USE_INLINE}inline;{$ENDIF}
  protected
    function GetListType: TsgListType; override;
    procedure SetDefaultCompareProc(var AProc: TsgObjProcCompare); override;
  public
    function Add(const Item: Double): Integer;
    procedure AppendArray(const NewItems: array of Double); overload;
    procedure AppendArray(const NewItems: array of Double; NewItemsAddCount: Integer); overload;
    procedure AssignArray(const NewItems: array of Double);
    procedure Insert(Index: Integer; const Item: Double);
    property First: Double read GetFirst write SetFirst;
    property Items[const AIndex: Integer]: Double
      read GetItem write SetItem; default;
    property Last : Double read GetLast write SetLast;
    property List: PsgDoubleArray read GetList;
  end;

Zitat von Bjoerk:

Ich habe eine Drittkomponete, die verwendet folgende Listen. Könnte mit jemand erklären, wie man um Gottes Willen auf so was kommt oder ist das ggf. genial?. Ich kapiers eh nicht..

wenn du jetzt noch erklärst was Du nicht kapierst, dann könnte dir vielleicht auch jemand helfen...

Ich kapiers generell nicht, weshalb man so einen Aufwand treibt? Das sind doch nur IntegerListen oder für kleinere Records usw..?

und die Integerlisten werden halt über Interfaces definiert. Damit kannst Du deine "Steinzeitlisten" unter Verwendung der Interfaces neu implementieren und der Drittkomponente unter jubeln und alles läuft weiter. Also keine Steinzeit, eher Modern Art

Diese Dinger gibt es in Spring4D von Stevie auch:
https://github.com/Spring4D/Spring4D...ions.Lists.pas

Dort spielt Generic und anonym. Methoden noch mit rein. Sehr modern!
Aber auch erheblich langsamer als normale Listen, die direkt von Delphi kommen.

Zitat von Bjoerk:

Ich kapiers generell nicht, weshalb man so einen Aufwand treibt? Das sind doch nur IntegerListen oder für kleinere Records usw..?

Wahrscheinlich weil der Code zu einer Zeit geschrieben wurde, als es in Delphi noch keine Generics gab? Das war halt alles etwas mühsam.

Zitat von Lemmy:

und die Integerlisten werden halt über Interfaces definiert. Damit kannst Du deine "Steinzeitlisten" unter Verwendung der Interfaces neu implementieren und der Drittkomponente unter jubeln und alles läuft weiter. Also keine Steinzeit, eher Modern Art

Seh' ich nicht so. Wenn schon, dann für Listen eher eine Basisklasse mit virtual; abtract Methoden und gut is?

Da hatten wir doch erst neulich einen Thread darüber, "warum Interfaces" oder so ähnlich.

Du meinst http://www.delphipraxis.net/190600-s...nterfaces.html

Japp