|
Registriert seit: 26. Nov 2004 Ort: Dresden 277 Beiträge Delphi 10.3 Rio |
#1
Hallo,
Hier habe ich eine Dynamic-Array Klasse erstellt, inspiriert durch meine Veröffentlichung vor längerer Zeit hier in der DP unter dem Titel "Dynamische Arrays auch unter Delphi 3" Damals hatte ich für jeden Arraytyp eine separate Klasse erstellt. Heute ist nur noch eine einzige Klasse davon übrig geblieben als eindimensionales Array. Alle anderen Klassentypen habe ich entfernt. Die vorliegende Klasse TGenericDynArray kann Integer-Typen und Pointer speichern. Mit dem Pointer sollte es möglich sein, auch kompliziertere Datenstrukturen in einem solchen Array zu speichern. Leider finde ich den damaligen Thread nicht mehr, weshalb ich nun einen neuen eröffne. Außerdem weiß ich von Lazarus, das dort dynamische Arrays auch als Klasse(n) definiert sind. Ich hatte zuerst auch an mehrdimensionale Arrays gedacht, daher auch die auf mehrdimensionale Arrays ausgelegte SetLength() Methode. Da jedoch in heutigen Delphi- und Lazarus Versionen dynamische Arrays beliebiger Dimensionalität eh Standard sind, belasse ich es nun bei dem eindimensionalen Array. Hier nun die Unit:
Delphi-Quellcode:
Ihr dürft diese Unit per copy & paste in Eure Projekte zu jedem beliebigen Zweck übernehmen.
unit DynArray;
interface uses Sysutils, Classes; type PByte = ^Byte; PShortInt = ^ShortInt; PSmallInt = ^SmallInt; PWord = ^Word; PInteger = ^Integer; PLongint = ^Longint; //Workaround für 1 Dimensionales Array TElementsType = ( etByte, etShortInt, etSmallInt, etWord, etInteger, etLongint, etPointer ); TGenericDynArray = class(TObject) private FCount: Longint; FDims: Longint; FSize: Longint; //FItem: Longint; FType: TElementsType; FArray: TList; FVector: TStringList; function GetItems(Index: Integer): Longint; function GetItemP(Index: Integer): Pointer; function GetItemType: TElementsType; procedure SetItems(Index: Integer; value: Longint); procedure SetItemP(Index: Integer; value: Pointer); protected constructor Create; //Für spätere Verwendung public //Dieser Constructor instantiiert das Array Objekt constructor CreateArray(Elements: Integer; ElType: TElementsType); destructor Destroy; override; property Count: Longint read FCount; //Anzahl Elemente -> gesamtes Array property Dims: Longint read FDims; //Anzahl Dimensionen property Size: Longint read FSize; //Größe eines Elementes //die Array Elemente property Items[Index: Integer]: Longint read GetItems write SetItems; default; //passt dann auf alle Typen //Wenn Pointer, dann passt dieser Item besser //Aber der LOngint Item wandelt Longint intern in Pointer property ItemP[Index: Integer]: Pointer read GetItemP write SetItemP; //Hier kann der Datentyp der Elemente gelesen werden //Festgelegt wird er im Konstruktor mit dem 2. Parameter property ItemType: TElementsType read GetItemType; procedure SetLength(ElCount: Longint); end; T1DimArray = TGenericDynArray; //Fügt sich besser in die Namenskonvention ein function NewByte(b: Byte): PByte; function NewShortint(si: ShortInt): PShortInt; function NewSmallInt(si: SmallInt): PSmallInt; function NewWord(w: Word): PWord; function NewInteger(i: Integer): PInteger; function NewLongint(i: Longint): PLongint; procedure DisposeShortint(var P: PShortint); procedure DisposeByte(var P: PByte); procedure DisposeSmallint(var P: PSmallint); procedure DisposeWord(var P: PWord); procedure DisposeInteger(var P: PInteger); procedure DisposeLongint(var P: PLongint); procedure InitArray(var A: TList; n: Integer; eltype: TElementsType); procedure CutArray(var A: TList; n: Integer); implementation { für Dimensionsänderungen während der Laufzeit konzipiert } { kann natürlich überall benutzt werden, wo man diese Funktionalität braucht } { Das Array selber ist mit TList realisiert und behält deshalb die Daten, die } procedure InitArray(var A: TList; n: Integer; eltype: TElementsType); begin while A.Count < n do case eltype of etByte : A.Add(NewByte(0)); etShortint : A.Add(NewShortint(0)); etSmallint : A.Add(NewSmallint(0)); etWord : A.Add(NewWord(0)); etInteger : A.Add(NewInteger(0)); etLongint : A.Add(NewLongint(0)); etPointer : A.Add(nil); end; end; { für Dimensionsänderungen während der Laufzeit konzipiert } { Das Array selber ist mit TList realisiert und behält deshalb die Daten, die } { nicht abgeschnitten werden, automatisch } procedure CutArray(var A: TList; n: Integer); begin while n < A.Count do A.Delete(A.Count-1); end; function NewByte(b: Byte): PByte; var P: PByte; begin GetMem(P, Sizeof(b)); P^ := b; Result := P; end; function NewShortint(si: ShortInt): PShortInt; var P: PShortint; begin GetMem(P, Sizeof(si)); P^ := si; Result := P; end; function NewSmallInt(si: SmallInt): PSmallInt; var P: PSmallint; begin GetMem(P, Sizeof(si)); P^:= si; Result := P; end; function NewWord(w: Word): PWord; var P: PWord; begin GetMem(P, Sizeof(w)); P^:= w; Result := P; end; function NewInteger(i: Integer): PInteger; var P: PInteger; begin GetMem(P , Sizeof(i)); P^:= i; Result := P; end; function NewLongint(i: Longint): PLongint; var P: PLongint; begin GetMem(P , Sizeof(i)); P^:= i; Result := P; end; procedure DisposeShortint(var P: PShortint); begin freemem(P, Sizeof(Shortint)); end; procedure DisposeByte(var P: PByte); begin freemem(P, Sizeof(Byte)); end; procedure DisposeSmallint(var P: PSmallint); begin freemem(P, Sizeof(SmallInt)); end; procedure DisposeWord(var P: PWord); begin freemem(P, Sizeof(Word)); end; procedure DisposeInteger(var P: PInteger); begin freemem(P, Sizeof(Integer)); end; procedure DisposeLongint(var P: PLongint); begin freemem(P, Sizeof(Longint)); end; { TGenericDynArray } function TGenericDynArray.GetItems(Index: Integer): Longint; begin Result:=0; case FType of etByte : Result := Byte(FArray.Items[Index]^) and $ff; etShortInt : Result := Shortint(FArray.Items[Index]^) and $ff; etSmallInt : Result := Smallint(FArray.Items[Index]^) and $ffff; etWord : Result := Word(FArray.Items[Index]^) and $ffff; etInteger : Result := Integer(FArray.Items[Index]^); etLongint : Result := LongInt(FArray.Items[Index]^); etPointer : Result := Longint(FArray.Items[Index]); end; end; function TGenericDynArray.GetItemP(Index: Integer): Pointer; begin result:=nil; if FType = etPointer then Result := FArray.Items[Index]; end; function TGenericDynArray.GetItemType: TElementsType; begin Result := FType; end; procedure TGenericDynArray.SetItems(Index: Integer; value: Longint); var b: Byte; begin case FType of etByte: begin b := value and $ff; FArray.Items[Index] := NewByte(b); end; etShortInt: begin FArray.Items[Index] := NewShortint(value and $ff); end; etSmallInt: begin FArray.Items[Index] := NewSmallInt(value and $ffff); end; etWord: begin FArray.Items[Index] := NewWord(value and $ffff); end; etInteger: FArray.Items[Index] := NewInteger(value); etLongint: FArray.Items[Index] := NewLongint(value); etPointer: FArray.Items[Index] := Pointer(value); end; end; procedure TGenericDynArray.SetItemP(Index: Integer; value: Pointer); begin SetItems(Index, Longint(value)); end; constructor TGenericDynArray.Create; //für zukünftige Verwendung begin //nicht zum Instanziieren inherited Create; FArray := TList.Create; end; constructor TGenericDynArray.CreateArray(Elements: Integer; ElType: TElementsType); var i: Integer; P: Pointer; begin p:=nil; inherited Create; FArray := TList.Create; for i := 0 to Elements-1 do case ElType of etByte : begin FArray.Add(NewByte(0)); FSize := Sizeof(Byte); end; etShortInt: begin FArray.Add(NewShortint(0)); FSize := Sizeof(Shortint); end; etSmallInt: begin FArray.Add(NewSmallInt(0)); FSize := Sizeof(Smallint); end; etWord : begin FArray.Add(NewWord(0)); FSize := Sizeof(Word); end; etInteger : begin FArray.Add(NewInteger(0)); FSize := Sizeof(Integer); end; etLongint : begin FArray.Add(NewLongint(0)); FSize := Sizeof(Longint); end; etPointer : begin FArray.Add(P); FSize := Sizeof(Pointer); end; end; FCount := FArray.Count; FDims := 1; end; destructor TGenericDynArray.Destroy; begin FArray.Free; inherited Destroy; end; procedure TGenericDynArray.SetLength(ElCount: Longint); var delta,ix,switch: Integer; Dims: array[0..1] of Longint; begin Dims[0] := ElCount; //weil vorher Dims: array of Longint, statt ElCount if High(Dims)<2 then //Hier wurde die Anzahl aktueller Dimensionen geprüft begin //wer mag, kann auf mehrdimensionale Arrays erweitern ix := 0; //wie ursprünglich vorgesehen, doch aus technischen delta := Dims[0]-FArray.Count; //Gründen nicht weiter verfolgt. if delta < 0 then switch := -1 else //Differenz zwichen neuer und alter Anzahl Array-Elemente if delta > 0 then switch := +1 else switch := 0; //um übersichtlicheren Code zu erhalten case switch of -1: if Dims[0]>=0 then while ix > delta do { oder while FArray.Count > delta } begin //oder CutArray(FArray, Dims[0]); FArray.Delete(FArray.Count-1); dec(ix); end; 0: ; //Keine Aktion +1: while FArray.Count < Dims[0] do //oder InitArray(FArray, Dims[0], FType); begin case FType of //wenn neue Länge (Elementanzahl) größer als vorherige etByte: FArray.Add(NewByte(0));//dann neue Elemente dazu und mit NULL initialisieren etShortint: FArray.Add(NewShortint(0)); etSmallint: FArray.Add(NewSmallint(0)); etInteger : FArray.Add(NewInteger (0)); etLongint : FArray.Add(NewLongint (0)); etPointer : FArray.Add(nil); end; { von case Ftype } end; { von case +1 -> while do begin } end; { von case } end; { von if High(Dims) } FCount := FArray.Count; end; end. Soeben hat mir der User "Delphi Laie" den Link zu jenem Thread wieder beschafft. Leider kann ich dort nichts mehr korrigieren. Ich will jedoch den Link zu jenem Thread wenigstens hier setzen, damit die anderen Überlegungen von eventuellen Interessenten auch gefunden werden. ![]() Schließlich sind dynamische Arrays unter Lazarus auch als Klassen(n) implementiert. Geändert von delphifan2004 (22. Jan 2014 um 11:00 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |