Search the Community

What I would like to achieve is along the lines of: type TAncestor = class FData: TArray<???>; // ... // A lot of methods that load, export, change FData // in a way common to all the descendants (mostly Length // and SetLength are used) // // Differences in managing FData are extracted into // protected virtual methods // ... end; TAncestorClass = class of TAncestor; TDescendant1 = class(TAncestor) type TItem = ... // Some type // ... // Virtual methods that do descendant-specific things // are overriden here // ... end; TDescendant2 = class(TAncestor) type TItem = ... // Another type // ... // Virtual methods that do descendant-specific things // are overriden here // ... end; ... The TItem-specific code is all in descendants, TAncestor just implements general management of how and when to resize FData and provides boilerplate code for loading, exporting and performing container-level changes on the data thatwould otherwise be duplicated in every descendant. This could probably be achieved with generics (descending from TAncestor<T> with particular T for each descendant), but this approach fails to support metaclasses and nested types. Am I missing something or is this not possible?

unit API.Generics; interface uses System.Classes // , System.Generics.Collections , System.Generics.Defaults ; type TSort = (sNone, sAsc, sDes); TDynamicObjectList<T: class> = class(TObjectList<T>) private fComparer: TComparison<T>; fSortField: string; fSort: TSort; function CompareNumbers(const L, R: Integer): Integer; function CompareObjects(const aLeft, aRight: T): Integer; public constructor CreateWithSort(const aSortField: string; aSort: TSort = sAsc); procedure Sort(aSort: TSort = sAsc); function IsSortedCorrectly: Boolean; end; implementation uses System.SysUtils , System.Rtti , System.TypInfo ; { TDynamicObjectList<T> } constructor TDynamicObjectList<T>.CreateWithSort(const aSortField: string; aSort: TSort); begin inherited Create(True); fSortField := aSortField; fSort := aSort; fComparer := CompareObjects; end; function TDynamicObjectList<T>.CompareNumbers(const L, R: Integer): Integer; begin Result := L - R; end; function TDynamicObjectList<T>.CompareObjects(const aLeft, aRight: T): Integer; var L_Ctx : TRttiContext; L_Typ : TRttiType; L_Prop : TRttiProperty; L_Left : TClass absolute aLeft; L_Right : TClass absolute aRight; L_LeftValue, L_RightValue: TValue; begin if fSortField = '' then begin // Use default comparer if no specific field is specified .. Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); Exit; end; L_Ctx := TRttiContext.Create; try L_Typ := L_Ctx.GetType(T); // Get RTTI for type ( T ) L_Prop := nil; L_Prop := L_Typ.GetProperty(fSortField); if Assigned(L_Prop) then begin L_LeftValue := L_Prop.GetValue(L_Left); L_RightValue := L_Prop.GetValue(L_Right); case L_LeftValue.Kind of tkInteger, tkInt64: case fSort of sAsc: Result := CompareNumbers(L_LeftValue.AsInteger, L_RightValue.AsInteger); sDes: Result := CompareNumbers(L_RightValue.AsInteger, L_LeftValue.AsInteger); else Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); end; tkString, tkWString, tkLString, tkUString: case fSort of sAsc: Result := CompareNumbers(Integer.Parse(L_LeftValue.AsString), Integer.Parse(L_RightValue.AsString)); sDes: Result := CompareNumbers(Integer.Parse(L_LeftValue.AsString), Integer.Parse(L_RightValue.AsString)); else Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); end; else TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); end; end else Result := 0; // Handle case where property is not found finally L_Ctx.Free; end; end; function TDynamicObjectList<T>.IsSortedCorrectly: Boolean; var I: Integer; begin Result := True; for I := 1 to Count - 1 do begin if CompareObjects(Items[I - 1], Items[I]) > 0 then begin Result := False; Break; end; end; end; procedure TDynamicObjectList<T>.Sort(aSort: TSort); begin fSort := aSort; inherited Sort(TComparer<T>.Construct(fComparer)); end; end. using: in separate Unit: MyFonts.pas type TFonType = (ft_TTF, ft_OTF, ft_Unknown); TFontInfo = class strict private fFileID, fFontName : string; fFontType : TFonType; fFontFileName: string; private function Get_FontType: string; procedure Set_FontType(const aValue: string); public constructor Add(const aFileID, aFontName: string; const aFontType: TFonType); destructor Destroy; override; property ID: string read fFileID write fFileID; property FontName:string read fFontName write fFontName; property FontType:string read Get_FontType write Set_FontType; property FontFileName: string read fFontFileName write fFontFileName; end; TFontsList = class(TDynamicObjectList<TFontInfo>); in MainForm: uses MyFonts; procedure TMainView.FormCreate(Sender: TObject); var L_FontInfo: TFontInfo; L_ListItem: TListItem; begin fFontsRes_List := TFontsList.CreateWithSort('ID'); // Add some sample data fFontsLst.Add(TFontInfo.Add('3', 'Courier New', ft_TTF)); fFontsLst.Add(TFontInfo.Add('1', 'Arial', ft_TTF)); fFontsLst.Add(TFontInfo.Add('2', 'Times New Roman', ft_OTF)); // Sort the list by ID in Asc fFontsLst.Sort(sAsc); // Populate the ListView for L_FontInfo in fFontsLst do begin L_ListItem := LV_Fonts.Items.Add; L_ListItem.Caption := L_FontInfo.ID; L_ListItem.SubItems.Add(L_FontInfo.FontName); L_ListItem.SubItems.Add(L_FontInfo.FontType); L_ListItem.SubItems.Add(L_FontInfo.FontFileName); end; end; procedure TMainView.FormDestroy(Sender: TObject); begin fFontsRes_List.Free; end; currentlly it's works only with fields marked as string or integer but real value are in integer and sorted using : CompareNumbers

Hi mates, I have something on my mind but I couldn't implement it correctly, imagine a generic interface, some classes inherited from that interface, and one method in each class with the same name, now I'm trying to use this interface type every where for different approaches but it doesn't compile correctly. Please have a look at the code if you get a chance and share your thoughts with me, I do appreciate you in advance. The question is how can I implement such an idea properly and safely? I have attached a sample project to save you time too. unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Rtti; type IMyInterface<T> = interface function DoSomething: T; end; TMyClass<T> = class(TInterfacedObject, IMyInterface<T>) function DoSomething: T; end; TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } function UseInterface<T>(obj: IMyInterface<T>): T; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} { TMyClass<T> } function TMyClass<T>.DoSomething: T; var ctx: TRttiContext; typ: TRttiType; begin ctx := TRttiContext.Create; typ := ctx.GetType(TypeInfo(T)); if typ.TypeKind = tkInteger then Result := 20 // E2010 Incompatible types: 'T' and 'Integer' else if typ.TypeKind = tkString then Result := T('Hello') // E2089 Invalid typecast else if typ.AsInstance.MetaclassType.InheritsFrom(TStringList) then Result := (typ.AsInstance.MetaclassType.InitInstance(typ) as TStringList) //E2010 Incompatible types: 'T' and 'TStringList' else Result := Default(T); ctx.Free; end; { TForm1 } function TForm1.UseInterface<T>(obj: IMyInterface<T>): T; begin Result := obj.DoSomething; end; procedure TForm1.FormCreate(Sender: TObject); var obj1: IMyInterface<Integer>; obj2: IMyInterface<String>; obj3: IMyInterface<TStringList>; begin try obj1 := TMyClass<Integer>.Create; obj2 := TMyClass<String>.Create; obj3 := TMyClass<TStringList>.Create; ShowMessage(UseInterface<Integer>(obj1).ToString); ShowMessage(UseInterface<String>(obj2)); ShowMessage(UseInterface<TStringList>(obj3).Text); except on E: Exception do Writeln('Exception: ', E.ClassName, ': ', E.Message); end; end; end. Generic Interface.zip

Can someone help me? I use a TObjectDictionary<integer,TmesData> with doOwnsValues, but if I remove an object via .Remove(key) my destructor does not get called. My class declaration: TmesData = class private procedure socketDataAvailable(Sender: TObject; ErrCode: Word); public payload: string; sendCount: integer; sendSocket: TWSocket; log: ts; sendTime: tdatetime; constructor create(alog: ts; const ip,port,apayload: string); destructor Destroy; //close and free socket function doConnect():boolean; function doSend():integer; end; On my form I do //create sendList sendList:=TObjectDictionary<integer,TmesData>.Create([doOwnsValues]); // add objects sendlist.Add(strtoint(seq),TmesData.create(doLog,edIP.Text,edPort.Text,mes)) later I do processing with for var seq in sendlist.Keys do begin //do processing //... //remove current object after processing sendlist.Remove(seq); end; The destructor of my TmesData objects never gets called. I must miss something obvious.

Hi, given this configuration for spacing math operators sometimes the formatter formats generics declarations with spaces (especially in methods parameters) using 1.3.18 build 3342 How to fix? Thanks

Hi there, I have a component like this: TCustomEdit<T: record> = class; TOnValidate<T: record> = function (ASender: TCustomEdit<T>; AValue: T): Boolean of object; TCustomEdit<T: record> = class(TEdit) private fOnValidate: TOnValidate<T>; // code here published property OnValidate: TOnValidate<T> read fOnValidate write fOnValidate; end; TIntEdit = class(TCustomEdit<Integer>) // code here end; The code compiles and TIntEdit registers without any complaints. But, when I want to drop the component onto a form, Delphi crashes with AV. What I am missing? I tested it on Delphi XE4 and Delphi 10.4 CE. It's a bug, feature of just "by design"? @Stefan Glienke, will you help? Anyone?

if I pass set type into MyGenericMethod<T: record> - I get compile type error [dcc32 Error] Project2.dpr(28): E2512 Type parameter 'T' must be a non-nullable value type Is it OK or compiler bug ?? program Project2; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils; type TMyEnum = (en1); TMySet = set of TMyEnum; type TTestClass = class class procedure MyGenericMethod<T: record>; end; class procedure TTestClass.MyGenericMethod<T>; begin // end; begin try { TODO -oUser -cConsole Main : Insert code here } TTestClass.MyGenericMethod<TMySet>(); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.

I have a section of code where I need to modify the top record on a stack. This code is supposed to be highly performant, so I would like to optimize it as much as possible. I would like to get the top record of the stack without popping and pushing it. The record is somewhat complex, so copying the data back and forth to a temporary record is silly. A sample program is below type TMyRec=record s:string; end; PMyRec=^TMyrec; var stk:TStack<TMyRec>; rec:TMyRec; prec:pMyRec; begin stk:=TStack<TMyRec>.Create; rec.s:='Hello'; stk.push(rec); prec:=@stk.Peek; // get error “variable required” prec.s:=’Goodbye’; stk.Free; end; Seems like @stk.Peek is returning the address to the Peek method, not the pointer of the element being returned by the peek method. I have tried casting in various ways but it never compiles properly. Any ideas?

Hello all, I'm stumbling on an unexpected generics-related problem here (Delphi XE). I'm trying to implement a backward-running enumerator for a generic tList<T>. I believe I did everything correctly but still the enumerator runs forward unless I make a modification that really shouldn't be necessary. TYPE tListEnumReversed<T> = CLASS(tEnumerator<T>) PROTECTED fowner: tlist<T>; fListIndex: integer; FUNCTION DoGetCurrent: T; OVERRIDE; FUNCTION DoMoveNext: Boolean; OVERRIDE; PUBLIC CONSTRUCTOR Create(owner: tlist<T>); END; tListReversed<T> = CLASS(tlist<T>) PROTECTED FUNCTION DoGetEnumerator: tEnumerator<T>; OVERRIDE; END; CONSTRUCTOR tListEnumReversed<T>.Create(owner: tlist<T>); BEGIN fowner := owner; fListIndex := owner.count; END; FUNCTION tListEnumReversed<T>.DoGetCurrent: T; BEGIN Result := fowner[fListIndex]; END; FUNCTION tListEnumReversed<T>.DoMoveNext: Boolean; BEGIN Result := fListIndex > 0; IF Result THEN Dec(fListIndex); END; FUNCTION tListReversed<T>.DoGetEnumerator: tEnumerator<T>; BEGIN Result := tListEnumReversed<T>.Create(Self); END; This is the code I used for testing: ... Var t:tListReversed<Integer>; i:integer; begin t:=tListReversed<Integer>.Create; t.Add(1); t.Add(2); t.Add(3); For i in T do memo1.lines.add(inttostr(i)) t.free; end; The weird thing is, the code runs correctly if I make the following change.... And I have literally no idea why that is the case! As far as I can see, the base class tEnumerable<T> already has a method GetEnumerator which should call my overridden virtual Method DoGetEnumerator. What am I missing here ??? tListReversed<T> = CLASS(tlist<T>) PROTECTED FUNCTION DoGetEnumerator: tEnumerator<T>; OVERRIDE; PUBLIC FUNCTION GetEnumerator: TEnumerator<T>; END; ... function tListReversed<T>.GetEnumerator: TEnumerator<T>; begin result:=DoGetEnumerator; end;

I want to recursively walk the properties of MyVar: TMyOuterType - but the Items list may be empty. How can I walk the base element type of Items, i.e. TMyType - when I have no instance data? type TMyType = class public property One: string; property Two: string; end; TMyType2 = class(TMyType) public property Two: string; end; TMyType3 = class(TMyType2) public property Three: string; end; TMyTypeArray = TArray<TMyType>; // i.e. polymorphic TMyOuterType = class public property Items: TMyTypeArray; end; var MyVar: TMyOuterType;