"Steinzeit Listen"

**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.. 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;

"Steinzeit Listen"

"Steinzeit Listen"

Forumregeln