![]() |
"Steinzeit Listen"
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? :gruebel:
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; |
AW: "Steinzeit Listen"
Zitat:
|
AW: "Steinzeit Listen"
Ich kapiers generell nicht, weshalb man so einen Aufwand treibt? Das sind doch nur IntegerListen oder für kleinere Records usw..?
|
AW: "Steinzeit Listen"
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 ;-)
|
AW: "Steinzeit Listen"
Diese Dinger gibt es in Spring4D von Stevie auch:
![]() Dort spielt Generic und anonym. Methoden noch mit rein. Sehr modern! Aber auch erheblich langsamer als normale Listen, die direkt von Delphi kommen. |
AW: "Steinzeit Listen"
Zitat:
|
AW: "Steinzeit Listen"
Zitat:
|
AW: "Steinzeit Listen"
Da hatten wir doch erst neulich einen Thread darüber, "warum Interfaces" oder so ähnlich.
|
AW: "Steinzeit Listen"
|
AW: "Steinzeit Listen"
Japp
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:24 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz