I have a problem, see if you can help me. I have a base form.
type
TForm_Base = class(TForm)
oObjectoVO : TObject;
...
procedure Search<M:class,constructor>;
...
procedure TForm_Base.Search<M>;
begin
TBussinesObj<M>.Pesquisa(FDMemTableGrid);
end;
And I have a form that inherits the base form.
procedure TForm_Client.FormCreate(Sender: TObject);
begin
// TClient is class simple with the properties(write, read) of id, name, ...
oObjectoVO := TClient.Create;
end;
procedure TForm_Client.ButtonSearchClick(Sender: TObject);
begin
inherited;
end;
procedure TForm_Client.FormDestroy(Sender: TObject);
begin
FreeAndNil(oObjectoVO);
end;
My problem is here. I cannot pass the type of the object instantiated in the client form, to the generic method (Search ) to the base form. I don't know if it's possible.
procedure TForm_Base.ButtonSearchClick(Sender: TObject);
begin
Search<oObjectoVO.ClassType>; ******* Error *******
end;
Tanks.
Generics are a compile time construct. Consider this code:
Search<oObjectoVO.ClassType>
You are attempting to instantiate the generic with a type that is not known until run time.
You need to change Search from being a generic to being non-generic and accepting a parameter that specifies the class.
Consider this interfaces and its implementations.
unit utest;
interface
{$MODE OBJFPC}
type
IIntfA = interface
procedure writeA();
end;
IIntfB = interface(IIntfA)
procedure writeB();
end;
TADelegateClass = class(TInterfacedObject, IIntfA)
public
procedure writeA();
end;
TAClass = class(TInterfacedObject, IIntfA)
private
delegateA : IIntfA;
public
constructor create(const AInst : IIntfA);
destructor destroy(); override;
property A : IIntfA read delegateA implements IIntfA;
end;
TBClass = class(TAClass, IIntfB)
public
procedure writeB();
end;
implementation
procedure TADelegateClass.writeA();
begin
writeln('Implement IIntfA through delegation');
end;
constructor TAClass.create(const AInst : IIntfA);
begin
delegateA := AInst;
end;
destructor TAClass.destroy();
begin
inherited destroy();
delegateA := nil;
end;
procedure TBClass.writeB();
begin
writeln('Implement IIntfB');
end;
end.
Following program will not compile.
program test;
{$MODE OBJFPC}
uses
utest;
var b : IIntfB;
begin
b := TBClass.create(TADelegateClass.create());
b.writeA();
b.writeB();
end.
Free Pascal (version 3.0.4) complains
Error: No matching implementation for interface method "writeA;" found.
at line where TBClass is declared.
Of course, I can compile it successfully by implementing writeA either in TAClass or TBClass and call writeA method of TADelegateClass from there.
TAClass is concrete implementation of IIntfA interface through interface delegation but why TBClass, which is descendant of TAClass, is not considered a concrete implementation of IIntfA interface?
TAClass is concrete implementation of IIntfA interface through
interface delegation but why TBClass, which is descendant of TAClass,
is not considered a concrete implementation of IIntfA interface?
Short answer: it's not IIntfA that is the problem, it is IIntfB that is incomplete.
Long answer: Interface inheritance is C++ vtable inheritance, which is sometimes not intuitive.
In the example:
IIntfB = interface(IIntfA)
procedure writeB();
end;
could actually be written as
IIntfB = interface
procedure writeA();
procedure writeB();
end;
When implementing multiple interfaces, common parts are not reused. The compiler sets up individual tables from the implementing methods, such as:
TADelegateClass:
QueryInterface(IIntfA) = Self.vtable_IIntfA
vtable_IIntfA.writeA <- Self.writeA
TAClass:
QueryInterface(IIntfA) = delegateA.vtable_IIntfA
TBClass:
QueryInterface(IIntfA) = inherited delegateA.vtable_IIntfA
QueryInterface(IIntfB) = vtable_IIntfB
vtable_IIntfB.writeA <- (this is missing!)
vtable_IIntfB.writeB <- Self.writeB
TBClass does indeed not have an implementation of IIntfB.writeA.
This can be verified by manually assigning a method to the specific interface and observe the error disappearing:
TBClass = class(TAClass, IIntfB)
public
procedure IIntfB.writeA = writeB;
// dummy method, shows IIntfB.writeA is missing
Sadly, I don't know of any way to tell the compiler to access a mapping from another interface. FWIW, Delphi has the same bug/shortcoming.
I'm trying to create TObjectList class in Delphi XE8, but i get errors when i try to get the value.
compiler error message: "[dcc32 Error] : can't access to private symbol {System.Generics.Collections}TList.GetItem"
Here is my code:
unit Unit2;
interface
uses
Classes, System.SysUtils, System.Types, REST.Types, System.JSON, Data.Bind.Components,
System.RegularExpressions, System.Variants,
Generics.Collections;
type
TTruc = class
public
libelle : string;
constructor Create(pLibelle : string);
end;
TListeDeTrucs = class(TObjectList<TTruc>)
private
function GetItem(Index: Integer): TTruc;
procedure SetItem(Index: Integer; const Value: TTruc);
public
function Add(AObject: TTruc): Integer;
procedure Insert(Index: Integer; AObject: TTruc);
procedure Delete(Index: Integer);
property Items[Index: Integer]: TTruc read GetItem write SetItem; default;
end;
implementation
{ TTruc }
constructor TTruc.Create(pLibelle: string);
begin
libelle := pLibelle;
end;
{ TListeDeTrucs }
function TListeDeTrucs.Add(AObject: TTruc): Integer;
begin
result := inherited Add(AObject);
end;
procedure TListeDeTrucs.Insert(Index: Integer; AObject: TTruc);
begin
inherited Insert(index, AObject);
end;
procedure TListeDeTrucs.Delete(Index: Integer);
begin
inherited delete(index);
end;
function TListeDeTrucs.GetItem(Index: Integer): TTruc;
begin
result := inherited GetItem(index);
end;
procedure TListeDeTrucs.SetItem(Index: Integer; const Value: TTruc);
begin
inherited setItem(index, value);
end;
end.
the testing code is :
procedure TForm1.Button1Click(Sender: TObject);
var
l : TListeDeTrucs;
i : integer;
Obj : TTruc;
begin
l := TListeDeTrucs.Create(true);
l.Add(TTruc.Create('one'));
l.Add(TTruc.Create('two'));
Obj := TTruc.Create('three');
l.Add(Obj);
for i := 0 to l.count - 1 do
begin
showMessage(l[i].libelle);
end;
L.Delete(0);
l.extract(Obj);
l.Free;
end;
How can i make it work ?
Well, GetItem, and indeed SetItem are private. Your code cannot see them. Private members can be seen only in the unit in which they are declared. You need to use members that are at least protected.
This compiles:
function TListeDeTrucs.GetItem(Index: Integer): TTruc;
begin
Result := inherited Items[Index];
end;
procedure TListeDeTrucs.SetItem(Index: Integer; const Value: TTruc);
begin
inherited Items[Index] := Value;
end;
In this case your class is a little pointless because none of the methods in your class vary behaviour from the base class. But peut-être your real class does more.
I am trying to use an array of a custom class as a property for my component, but the problem is that the values are not been saved to the component, that means that if I set the values, save everything and open again the project, the values for the component disappears... My code looks like the following:
unit Unit1;
interface
uses Windows, ExtCtrls,Classes,Controls;
type
TMyClass=class(TPersistent)
private
FName: string;
FValue: double;
public
property Name: string read FName write FName;
property Value: double read FValue write FValue;
end;
TMyComponent= class(TCustomPanel)
private
FMyArray: array[0..200] of TMyClass;
function GetmyArray(Index: Integer): TMyClass;
procedure SetMyArray(index: Integer; Value: TMyClass);
public
property myArray[index: Integer]: TMyClass read GetMyArray write SetMyArray;
end;
implementation
function TMyComponent.GetmyArray(Index: Integer): TMyClass;
begin
result:= FmyArray[Index];
end;
procedure TMyComponent.SetMyArray(index: Integer; Value: TMyClass);
begin
FMyArray[index].FName:= Value.FName;
FMyArray[index].FValue:= Value.FValue;
end;
end.
I know that that only published properties can be streamed, but the problem is that my property is an array and it can not be published...
A suggestion that I had was to use DefineProperties() to provide a custom streaming but I don't see how to do this with an array.
Other possibility that I thought was to modify TMyClass to a kind of class that TMyComponent could be the parent of it, like it is done in TChart, which you can add different classes of series to it. But I don't know What class this should be
TMyClass=class(T???????????)
With that I could take out the property MyArray and create TMyClass and add to TMyComponent as the following:
MyArray1.parent:= MyComponent1;
MyArray2.parent:= MyComponent2;
...
. Which one is the better option? Or is there any other better idea?
The simpliest (and preferred) solution is to change TMyClass to derive from TCollectionItem and change TMyComponent.FMyArray to TOwnedCollection. Then the DFM will stream the items automatically for you, and you gain native design-time support for creating and manipulating TMyClass objects and their properties.
Try this:
unit Unit1;
interface
uses
Windows, ExtCtrls, Classes, Controls;
type
TMyClass = class(TCollectionItem)
private
FName: string;
FValue: double;
procedure SetName(const AValue: string);
procedure SetValue(AValue: double);
public
procedure Assign(ASource: TPersistent); override;
published
property Name: string read FName write SetName;
property Value: double read FValue write SetValue;
end;
TMyArray = class(TOwnedCollection)
private
function GetItem(Index: Integer): TMyClass;
procedure SetItem(Index: Integer; const Value: TMyClass);
public
constructor Create(AOwner: TPersistent);
function Add: TMyClass; reintroduce;
function Insert(Index: Integer): TMyClass; reintroduce;
property Items[Index: Integer]: TMyClass read GetItem write SetItem; default;
end;
TMyComponent = class(TCustomPanel)
private
FMyArray: TMyArray;
procedure SetMyArray(Value: TMyArray);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property myArray: TMyArray read FMyArray write SetMyArray;
end;
implementation
procedure TMyClass.Assign(ASource: TPersistent);
begin
if ASource is TMyClass then
begin
with TMyClass(ASource) do
begin
Self.FName := Name;
Self.FValue := Value;
end;
Changed(False);
end else
inherited;
end;
procedure TMyClass.SetName(const AValue: string);
begin
if FName <> AValue then
begin
FName := AValue;
Changed(False);
end;
end;
procedure TMyClass.SetValue(AValue: double);
begin
if FValue <> AValue then
begin
FValue := AValue;
Changed(False);
end;
end;
constructor TMyArray.Create(AOwner: TPersistent);
begin
inherited Create(AOwner, TMyClass);
end;
function TMyArray.GetItem(Index: Integer): TMyClass;
begin
Result := TMyClass(inherited GetItem(Index));
end;
procedure TMyArray.SetItem(Index: Integer; const Value: TMyClass);
begin
inherited SetItem(Index, Value);
end;
function TMyArray.Add: TMyClass;
begin
Result := TMyClass(inherited Add);
end;
function TMyArray.Insert(Index: Integer): TMyClass;
begin
Result := TMyClass(inherited Insert(Index));
end;
constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited;
FMyArray := TMyArray.Create(Self);
end;
destructor TMyComponent.Destroy;
begin
FMyArray.Free;
inherited;
end;
procedure TMyComponent.SetMyArray(Value: TMyArray);
begin
FMyArray.Assign(Value);
end;
end.
I'd vote for DefineProperties! The necessary code might look like this (assuming none of the instances in the array is nil):
procedure TMyComponent.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('MyArray', ReadMyArray, WriteMyArray, true);
end;
procedure TMyComponent.ReadMyArray(Reader: TReader);
var
N: Integer;
begin
N := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do begin
Reader.ReadListBegin;
FMyArray[N].Name := Reader.ReadString;
FMyArray[N].Value := Reader.ReadFloat;
Reader.ReadListEnd;
Inc(N);
end;
Reader.ReadListEnd;
end;
procedure TMyComponent.WriteMyArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := 0 to High(FMyArray) do begin
Writer.WriteListBegin;
Writer.WriteString(FMyArray[I].Name);
Writer.WriteFloat(FMyArray[I].Value);
Writer.WriteListEnd;
end;
Writer.WriteListEnd;
end;
Look at this sample:
//----------------------------------------------------------------------------
type
ISomeInterface = interface
procedure SomeMethod;
end;
// this is wrong, but illustrates that, what i need:
TSomeClassWhichImplementsSomeInterface = class of ISomeInterface;
var
gHardCodedPointer: Pointer; // no matter
procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;
end;
...
type
TMyClass = class(TInterfacedObject, ISomeInterface)
end;
...
// TMyClass implements ISomeInterface, so i can pass it into Dummy:
Dummy(TMyClass);
//----------------------------------------------------------------------------
Of course i can inherit TMyClass and use it childs, but I don't need this. I want to use another classes with their own hierarchy, just adding into them implementation of ISomeInterface (because there are no multiple-inheritance avaiable in Object Pascal, like in C++).
I know it may be looked crazy, don't ask me why I need this, just say - it is possibly to implement or not. Thanks a lot!
I think what you are looking for is this:
procedure Dummy;
var Intf : ISomeInterface;
begin
if Assigned(gHardCodedPointer) and Supports(gHardCodedPointer,ISomeInterface,Intf) then
Intf.SomeMethod
end;
If it's not, I have no clue about what you are trying to achieve there...
You can declare metaclasses, but you cannot define them in terms of what interfaces the base class implements. Interface implementation can only be checked at run time.
You can pass your Dummy function a metaclass, but you cannot use that metaclass to type-cast your plain pointer to a more specific type. Type-casting is a compile-time operation, but the actual value of the metaclass parameter isn't known until run time. The best you can do is type-cast it to the metaclass's base class. Then you can call all the methods that are defined in that base class.
But it seems you don't actually care what the base class is, as long as the class implements your interface. In that case, you can ignore the metaclass parameter. Type-cast your pointer to be a TObject (or, better yet, declare gHardCodedPointer to be a TObject in the first place), and then use the Supports function to get the interface reference.
var
SupportsInterface: Boolean;
Some: ISomeInterface;
begin
SupportsInterface := Supports(TObject(gHardCodedPointer), ISomeInterface, Some);
Assert(SupportsInterface, 'Programmer stored bad class instance in gHardCodedPointer');
Some.SomeMethod;
end;
If you really care about the metaclass parameter, you can add some enforcement for it, too. You can check whether the given class implements your interface, and you can check whether the object in gHardCodedPointer is an instance of that class:
Assert(ASomeClassToWorkWith.GetInterfaceEntry(ISomeInterface) <> nil);
Assert(TObject(gHardCodedPointer).InheritsFrom(ASomeClassToWorkWith));
But notice that you don't need to check either of those results to be able to call SomeMethod on gHardCodedPointer. They don't really matter.
By the way, the only hard-coded pointer value you can hope to have in Delphi is nil. All other pointer values are addresses that are very hard to predict at compile time because the compiler, the linker, and the loader all determine where everything really goes in memory. I suggest you come up with some other name for that variable that more accurately describes what it really holds.
Why can't you use the interface reference?
But, assuming there is a good reason for that, this might help.
As you have found out, you can't do class of on an interface.
What's more you can't use a variable value to cast anything to anything else. Casting is hardwired telling the compiler that you know the reference you are casting is of a specific type. Trying to do that with a var such as your ASomeClassToWorkWith parameter is going to produce errors as it goes against the very nature of casting.
Code below is not something I'd recommend, but it compiles and I think it does what you want. What it does is use a "dummy" ancestor and employs polymorfism to get the compiler to call the method on the correct type. If you do not mark SomeMethod as virtual, you will get the dummy ancestor's message on both button clicks.
The Instance function in the interface is there to show you a means of getting to the implementing instance of an interface without using RTTI. Just be aware of the caveat of this when using interface delegation: you may not get the instance you are expecting.
type
TForm1 = class(TForm)
TSomethingBtn: TButton;
TMyClassBtn: TButton;
procedure FormCreate(Sender: TObject);
procedure TSomethingBtnClick(Sender: TObject);
procedure TMyClassBtnClick(Sender: TObject);
private
{ Private declarations }
FSomething: TObject;
FMyClass: TObject;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TSomething = class; // forward;
TSomethingClass = class of TSomething;
ISomeInterface = interface
procedure SomeMethod;
function Instance: TSomething;
end;
TSomething = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual;
function Instance: TSomething;
end;
var
gHardCodedPointer: Pointer; // no matter
procedure Dummy(aSomething: TSomething);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
aSomething.SomeMethod;
end;
type
TMyClass = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual;
function Instance: TSomething;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FSomething := TSomething.Create;
FMyClass := TMyClass.Create;
end;
{ TMyClass }
function TMyClass.Instance: TSomething;
begin
Result := TSomething(Self);
end;
procedure TMyClass.SomeMethod;
begin
ShowMessage('This comes from TMyClass');
end;
{ TSomething }
function TSomething.Instance: TSomething;
begin
Result := Self;
end;
procedure TSomething.SomeMethod;
begin
ShowMessage('This comes from the "dummy" ancestor TSomething');
end;
procedure TForm1.TMyClassBtnClick(Sender: TObject);
begin
// Presume this has been set elsewhere
gHardCodedPointer := FMyClass;
Dummy(TSomething(gHardCodedPointer));
end;
procedure TForm1.TSomethingBtnClick(Sender: TObject);
begin
// Presume this has been set elsewhere
gHardCodedPointer := FSomething;
Dummy(TSomething(gHardCodedPointer));
end;
It seems I see what you want to do. You just have to use what MS and partners implemented in the core of interfaces, use guids. Below is the example, but you should definitely use your own guid with CTRL+SHIFT+G in IDE
...
type
ITestInterface = interface
['{2EA2580F-E5E5-4F3D-AF90-2BBCD65B917B}']
procedure DoSomething;
end;
TTestObject = class(TInterfacedObject, ITestInterface)
procedure DoSomething;
end;
TTestObject2 = class(TInterfacedObject, ITestInterface)
procedure DoSomething;
end;
...
procedure TestMethod(Obj: TInterfacedObject);
var
Intf: ITestInterface;
begin
if (Obj as IUnknown).QueryInterface(ITestInterface, Intf) = S_OK then
Intf.DoSomething;
end;
{ TTestObject }
procedure TTestObject.DoSomething;
begin
MessageDlg('This is TTestObject showing something', mtInformation, [mbOk], 0)
end;
{ TTestObject2 }
procedure TTestObject2.DoSomething;
begin
MessageDlg('This is TTestObject2 showing something', mtInformation, [mbOk], 0)
end;
procedure TForm2.Button1Click(Sender: TObject);
var
Obj1, Obj2: TInterfacedObject;
begin
Obj1:=TTestObject.Create;
Obj2:=TTestObject2.Create;
TestMethod(Obj1);
TestMethod(Obj2);
end;
Even if you could, you couldn't typecast the interface with a interface-var anyway.
Same as with classes when you typecast a pointer to a metaclass, you'll get something of type metaclass (class of), not something of the type that is in metaclass.
With classes you solve this by typecast to the lowest common class in the hierachy. You can do the same with interfaces. ... If they inherit from eachother.
I think you have to use the interface, not the class:
procedure Dummy(ASomeClassToWorkWith: ISomeInterface);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
ASomeClassToWorkWith.SomeMethod;
end;
You just have to think amout reference counting
If you realy want the object instance you could change the interface like this:
type
ISomeInterface = interface
procedure SomeMethod;
function ImplementedInObject: TObject;
end;
procedure Dummy(ASomeInterfaceToWorkWith: ISomeInterface);
var
ASomeObjectToWorkWith: TObject;
begin
ASomeInterfaceToWorkWith.SomeMethod;
ASomeObjectToWorkWith := ASomeInterfaceToWorkWith.ImplementedInObject;
// Do what is needed with object
end;
...
type
TMyClass = class(TInterfacedObject, ISomeInterface)
function ImplementedInObject: TObject;
end;
function TMyClass.ImplementedInObject: TObject;
begin
Result := Self;
end;
The difference when calling code via interface variable or via variable pointing to an instance of a class that implements methods of the same interface is that different virtual method tables (VMT) are used, i.e. in a VMTs of an interface there will be only interface methods (plus AddRef, Release and QI, of course), in a VMT of a class there will be all virtual methods of that class.
That means that your code
ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;
will be compiled to call TSomeClassWhichImplementsSomeInterface.SomeMethod directly instead of virtual method in VMT of ISomeInterface through interface pointer.
Even more, since interfaces cannot declare class methods and class attributes, an interface type is not a object (while class is an object), therefore "class of interface" does not make any sence.
You can add intermediate abstract class and declare you "class of interface" as class of the intermediate class:
type
TInterfacedObjectWithISomeInterface = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual; abstract;
end;
TSomeClassWhichImplementsSomeInterface = class of TInterfacedObjectWithISomeInterface;
procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);
...
type
TMyClass = class(TInterfacedObjectWithISomeInterface)
procedure SomeMethod; override;
end;