I don't know OWNER object class name. So I must check everywhere in my codes like that :
if TObject(OWNER) is TFirstClass then begin
TFirstClass(OWNER).FirstFunction;
TFirstClass(OWNER).SecondFunction;
...
end else
if TObject(OWNER) is TSecondClass then begin
TSecondClass(OWNER).FirstFunction;
TSecondClass(OWNER).SecondFunction;
...
end;
Is there a better way? Because I must do this if condition in many place of the codes.
All functions of TFirstClass and TSecondClass (which I have to run) are the same.
Note : I use Delphi 5.
If you have no access to TFirstClass and TSecondClass, but still want to simplify your code, here's a way:
Create an adapter base class:
type
TMyAdapter = class(TObject)
public
procedure FirstMethod; virtual; abstract;
procedure SecondMethod; virtual; abstract;
end;
Then create descendant classes TFirstClassAdapter and TSecondClassAdapter and give them each a private reference to the instance of TFirstClass or TSecondClass respectively. Add a constructor which sets this reference. Override the methods of the adapter classes, so that they call through to the adapted classes.
type
TFirstClassAdapter = class(TMyAdapter)
private
fObject: TFirstClass;
public
constructor Create(AAdaptedObject: TFirstClass);
procedure FirstMethod; override;
procedure SecondMethod; override;
end;
constructor TFirstClassAdapter.Create(AAdaptedObject: TFirstClass);
begin
inherited Create;
fObject := AAdaptedObject;
end;
procedure TFirstClassAdapter.FirstMethod;
begin
fObject.FirstMethod;
end;
procedure TFirstClassAdapter.SecondMethod;
begin
fObject.SecondMethod;
end;
Same for the other class. Now you only need to decide whether you create the adapter once and pass it around, or whether you make a function that you call everywhere you need it, and which will give you an adapter for your concrete class.
If you implement the adapter using interfaces, then you will not even need to manage the lifetime of the adapter yourself.
This way you can have the polymorphic behaviour that Ulrich gave in his answer, but without the need to change TFirstClass and TSecondClass.
Derive TFirstClass and TSecondClass from a common base class that declares virtual methods FirstFunction and SecondFunction.
Uli.
At first excuse-me for my bad english.
If you can't do the 2 before responses (Adapters and derive from a base class), you can use RTTI to access a procedure by it's name.
The procedure must be declared in the published section.
If you've a declaration like this:
TFirstClass = class(TObject)
published
procedure FirstFunction;
procedure SecondFunction;
end;
TSecondClass = class(TObject)
published
procedure FirstFunction;
procedure SecondFunction;
end
You can do something like this to execute a method if you have the name:
// Acceso a la rutina; TObject is a Base class for
// TFirstClass and TSecondClass
Routine.Data := Pointer(obj as TObject);
// Devuelve la dirección de un método published; Method for it's name
Routine.Code := (obj as TObject).MethodAddress('SecondFunction');
// Not find
if (Routine.Code = nil) then Exit;
// execute
TExecuteMethod(Routine);
You can see similar codes here:
* Tip4
* Tip7
Regards.
Related
I'm having problems with my Delphi 2006 seeming to call the incorrect constructor during dynamic creation.
I asked almost the exact same question 5 yrs ago (Why does Delphi call incorrect constructor during dynamic object creation?), and I have reviewed that. But that thread had issues of overriding virtual calls which I don't have now. I have also tried searching through StackOverflow for a matching question, but couldn't find an answer.
I am working with legacy code, so I didn't write much of this. (If you see comments below with '//kt' adding something, that is me).
The code has base class, TPCEItem as follow. Note that it does NOT have a constructor.
TPCEItem = class(TObject)
{base class for PCE items}
private
<irrelevent stuff>
public
<irrelevent stuff>
end;
Next, there is class type to use for passing a parameter (more below).
TPCEItemClass = class of TPCEItem;
Next I have a child class as follows. Note that it DOES have a contructor. The compiler will not allow me to add 'override' to this create method because the ancestor class where this is declared (TObject) does not define it as virtual.
TPCEProc = class(TPCEItem)
{class for procedures}
protected
<irrelevent stuff>
public
<irrelevent stuff>
constructor Create;
destructor Destroy; override;
end;
The code then has a function for copying data, which is a conglomeration of descendant types. Because this is older code, mosts of these lists are plain TLists or TStringLists, holding untyped pointers. Thus for each copy command a corresponding type is passed in for correct use.
procedure TPCEData.CopyPCEData(Dest: TPCEData);
begin
Dest.Clear;
<irrelevent stuff>
CopyPCEItems(FVisitTypesList, Dest.FVisitTypesList, TPCEProc); //kt added
CopyPCEItems(FDiagnoses, Dest.FDiagnoses, TPCEDiag);
CopyPCEItems(FProcedures, Dest.FProcedures, TPCEProc);
CopyPCEItems(FImmunizations, Dest.FImmunizations, TPCEImm);
CopyPCEItems(FSkinTests, Dest.FSkinTests, TPCESkin);
CopyPCEItems(FPatientEds, Dest.FPatientEds, TPCEPat);
CopyPCEItems(FHealthFactors, Dest.FHealthFactors, TPCEHealth);
CopyPCEItems(FExams, Dest.FExams, TPCEExams);
<irrelevent stuff>
end;
This CopyPCEItems is as follows:
procedure TPCEData.CopyPCEItems(Src: TList; Dest: TObject; ItemClass: TPCEItemClass);
var
AItem: TPCEItem;
i: Integer;
IsStrings: boolean;
Obj : TObject;
begin
if (Dest is TStrings) then begin
IsStrings := TRUE
end else if (Dest is TList) then begin
IsStrings := FALSE
end else begin
exit;
end;
for i := 0 to Src.Count - 1 do begin
Obj := TObject(Src[i]);
if(not TPCEItem(Src[i]).FDelete) then begin
AItem := ItemClass.Create; //<--- THE PROBLEMATIC LINE
if (Obj.ClassType = TPCEProc) and (ItemClass = TPCEProc) then begin //kt added if block and sub block below
TPCEProc(Obj).CopyProc(TPCEProc(AItem));
end else begin
AItem.Assign(TPCEItem(Src[i])); //kt <-- originally this line was by itself.
end;
if (IsStrings) then begin
TStrings(Dest).AddObject(AItem.ItemStr, AItem)
end else begin
TList(Dest).Add(AItem);
end;
end;
end;
end;
The problematic line is as below:
AItem := ItemClass.Create;
When I step through the code with the debugger, and stop on this line, an inspection of the variable ItemClass is as follows
ItemClass = TPCEProc
The problems is that the .Create is calling TObject.Create, not TPCEProc.Create, which doesn't give me an opportunity to instantiate some needed TStringLists, and later leads to access violation error.
Can anyone help me understand what is going on here? I have a suspicion that the problem is with this line:
TPCEItemClass = class of TPCEItem;
It is because this is of a class of an ancestor type (i.e. TPCEItem), that it doesn't properly carry the information for the child type (TPCEProc)?? But if this is true, then why does the debugger show that ItemClass = TPCEProc??
How can I effect a call to TPCEProc.Create?
I have been programming in Delphi for at least 30 yrs, and it frustrates me that I keep having problems with polymorphism. I have read about this repeatedly. But I keep hitting walls.
Thanks in advance.
When you are constructing objects through meta-class you need to mark its base class constructor as virtual, and if you need a constructor in any of the descendant classes they need to override that virtual constructor.
If the base class does not have a constructor, you will need to add empty one.
TPCEItem = class(TObject)
public
constructor Create; virtual;
end;
TPCEItemClass = class of TPCEItem;
TPCEProc = class(TPCEItem)
public
constructor Create; override;
destructor Destroy; override;
end;
constructor TPCEItem.Create;
begin
// if the descendant class is TObject
// or any other class that has empty constructor
// you can omit inherited call
inherited;
end;
You have already identified the problem - the base class TPCEItem does not define a virtual constructor, it just inherits a constructor from TObject, which is not virtual.
As such, you cannot create instances of any TPCEItem-derived classes by using your TPCEItemClass metaclass type. In order for a metaclass to invoke the correct derived class constructor, the base class being referred to MUST have a virtual constructor, eg:
TPCEItem = class(TObject)
...
public
constructor Create; virtual;
end;
TPCEProc = class(TPCEItem)
...
public
constructor Create; override;
...
end;
procedure TPCEData.CopyPCEItems(...; ItemClass: TPCEItemClass);
var
AItem: TPCEItem;
...
begin
...
AItem := ItemClass.Create; // <-- THIS WORKS NOW!
...
if (Obj is TPCEProc) then begin // <-- FYI: use 'is' rather than ClassType to handle descendants of TPCEProc...
TPCEProc(Obj).CopyProc(TPCEProc(AItem));
...
end;
Congratulations you have identified the problematic line
AItem := ItemClass.Create; //<--- THE PROBLEMATIC LINE
But what is wrong with this line? You are calling constructor method from existing class instance. You should not do this ever. You should only call constructor methods from specific class types not existing class instances.
So in order to fix your code change the mentioned line to
AItem := TPCEItem.Create;
You may be thinking of perhaps calling AItem := TPCEItemClass.Create; since above in your code you made next declaration
TPCEItemClass = class of TPCEItem;
This declaration does not meant that TPCEItemClass is the same type as TPCEItem but instead that both types have same type structure but they are in fact two distinct types.
By the way what is the purpose of ItemClass: TPCEItemClass parameter of your CopyPCEItems procedure if you are not even using it in your procedure but instead work with local variable AItem: TPCEItem all the time? Well at least in your shown code that is.
...or vice versa. Let's suppose two classes on which I have no control, both inherit from the same base class:
TDataSet1 = class(TDataSet)
...
end;
TDataSet2 = class(TDataSet)
...
end;
I have an interface declaration like this:
IMyDataSet = interface
procedure MyProc;
end;
Then I have two classes that inherit from the previous ones and that implement my interface:
TMyDataSet1 = class(TDataSet1, IMyDataSet)
procedure MyProc;
end;
TMyDataSet2 = class(TDataSet2, IMyDataSet)
procedure MyProc;
end;
Now my problem is: i have a bunch of procedures and functions which must accept as parameter an object which can be an instance of both my classes.
I don't need to access properties or methods specific to my two classes or to the ancestor ones, only those from the base class TDataSet and those declared in the interface IMyDataSet.
If I declare a procedure like this:
procedure Foo(ADataSet: TDataSet);
I can only call methods from TDataSet class.
If instead I declare the procedure in this way:
procedure Foo(ADataSet: IMyDataSet);
I can see only methods that belong to that interface.
Is there a way so that I can see both TDataSet and IMyDataSet methods on the reference I pass to the procedure?
You can declare parameter as interface and then typecast it to object reference inside method. (This kind of typecasting works in Delphi 2010 and newer)
procedure Foo(ADataSet: IMyDataSet);
var
LDataSet: TDataSet;
begin
LDataSet := TDataSet(ADataSet);
...
end;
Note: If IMyDataSet interface is not implemented on TDataSet class above typecast will fail without raising exception and return nil.
You can also use as operator to typecast, but in that case failure raises exception.
LDataSet := ADataSet as TDataSet;
Another option is to pass parameter as object instance and then retrieve interface from object. In that case your interface must have GUID.
IMyDataSet = interface
['{XXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX}'] // replace with actual GUID
procedure MyProc;
end;
procedure Foo(ADataSet: TDataSet);
var
LDataSet: IMyDataSet;
begin
if Supports(ADataSet, IMyDataSet, LDataSet) then
begin
...
end;
end;
i have a class which contains another class.
Is it possible in Delphi to directly access the properties of the member class?
TNameValue = class
private
FSubName: string;
FSubValue: Integer;
public
property SubName: string read FSubName write FSubName;
property SubValue: Integer read FSubValue write FSubValue;
end;
TParentclass = class(TSomeotherclass)
FNameValue: TNameValue;
public
property NameValue: TNameValue read FNameValue write FNameValue;
end;
procedure TForm.Buttonclick();
begin
Parentclass := TParentclass.Create();
// here i would need to directly access the Property of the member class.
Showmessage(Parentclass.Subname);
end;
I know that i could make properties for alle the properties of the subclass that i want to access, but i have this class in multiple other classes and i don't want to change the code everywhere when the subclass changes.
Is there a way to define the property to publish its properties directly?
I know that i can access it using Parentclass.NameValue.Subname but i want to use it without the additional step of NameValue.
Is there a way to define the property to publish its properties directly?
No this is not possible as you would need multi inheritance to achieve this and Delphi does not support it. Either rework your class design or go through the hassle of implementing the needed properties.
Delphi doesn't automatically recognise that.
But you can help it.
constructor TParentClass.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
fSubClass := TSubClass.Create(Self);
fSubClass.SetSubComponent(True);
end;
like this you create a compound component
a component containing another component
changed from here:
unit uSubClass;
uses Classes;
type
TSubClass = class(TObject)
private
fProp: string;
protected
procedure SetProp(const aValue: string);
function GetProp: string;
public
property Prop: string read GetProp write SetProp;
end;
var SingleSubClass: TSubclass;
implmentation
procedure SetProp(const aValue: string);
begin
fProp := aValue;
end;
function GetProp: string;
begin
Result := fProp;
end;
initialization
SingleSubClass := TSubClass.Create;
finalization
SingleSubClass.Free;
end;
that SingleSubClass is now a global variable and can be accessed in another object.
procedure TForm123.Button1Click(Sender: TObject);
begin
ShowMessage(SingleSubClass.Prop);
end;
if you want other objects to be notified of a change on it, you'll have to add an observer pattern to it and register all interested objects for the changes
https://sourcemaking.com/design_patterns/observer/delphi
I have an interface.
type IProgressObserver = interface(IInterface)
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
end;
I have implemented the interface using a named class, as follows:
type TProgressObserver=class(TInterfacedObject, IProgressObserver)
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
end;
... implementation of methods go here .....
addProgressObserver(TProgressObserver.Create);
Is it possible to create an instance of this interface without declaring a class? Something like this (imaginary) code, that would do the same thing as above:
addProgressObserver(IProgressObserver.Create()
begin
procedure ReportProgress(Progress:Integer)
begin
ShowMessage('Progress Observed!');
end
procedure ReportError(Message:string)
begin
Log(Message);
end
end;);
Delphi has anonymous procedures, but does it have anonymous classes??
I found this similar question, but it's in Java.
I am using Delphi 2010
You can get pretty anonymous, implementing the interface using anonymous methods. But you don't get actual compiler support for this, you'll have to declare all the anonymous method types yourself, then implement the actual "anonymous" class. Given your IProgressObserver interface, the implementation would look something like this:
type
// This is the interface we'll be dealing with.
IProgressObserver = interface(IInterface)
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
end;
// This will help us anonymously create implementations of the IProgressObserver
// interface.
TAnonymousObserverImp = class(TInterfacedObject, IProgressObserver)
type
// Declare reference types for all the methods the interface needs.
TReportProgressProc = reference to procedure(Progress:Integer);
TReportErrorProc = reference to procedure(Message:string);
strict private
FReportProgressProc: TReportProgressProc;
FReportErrorProc: TReportErrorProc;
// Actual implementation of interface methods.
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
// private constructor, so we'll forced to use the public "Construct" function
constructor Create(aReportProgressProc: TReportProgressProc; aReportErrorProc: TReportErrorProc);
public
// This takes the required anonymous methods as parameters and constructs an anonymous implementation
// of the IProgressObserver interface.
class function Construct(aReportProgressProc: TReportProgressProc; aReportErrorProc: TReportErrorProc): IProgressObserver;
end;
{ TAnonymousObserverImp }
class function TAnonymousObserverImp.Construct(
aReportProgressProc: TReportProgressProc;
aReportErrorProc: TReportErrorProc): IProgressObserver;
begin
// Call the private constructor
Result := TAnonymousObserverImp.Create(aReportProgressProc, aReportErrorProc);
end;
constructor TAnonymousObserverImp.Create(
aReportProgressProc: TReportProgressProc; aReportErrorProc: TReportErrorProc);
begin
inherited Create;
// We simply save the references for later use
FReportProgressProc := aReportProgressProc;
FReportErrorProc := aReportErrorProc;
end;
procedure TAnonymousObserverImp.ReportError(Message: string);
begin
// Delegate to anonymous method
FReportErrorProc(Message);
end;
procedure TAnonymousObserverImp.ReportProgress(Progress: Integer);
begin
// Delegate to anonymous method
FReportProgressProc(Progress);
end;
Once all that code is in place you'll be able to write code like this:
var i: IProgressObserver;
begin
i := TAnonymousObserverImp.Construct(
procedure (Progress:Integer)
begin
// Do something with Progress
end
,
procedure (Message:string)
begin
// Do something with Message
end
)
end;
Looks pretty anonymous to me! Given the implementation of anonymous methods in Delphi it's also fairly fast and effective.
Short answer I'm afraid: sorry, no, Delphi doesn't have anonymous classes.
I need to fix a third-party component. This component's class has private variable which is actively used by its descendants:
TThirdPartyComponentBase = class
private
FSomeVar: Integer;
public
...
end;
TThirdPartyComponent = class (TThirdPartyComponentBase)
protected
procedure Foo; virtual;
end;
procedure TThirdPartyComponent.Foo;
begin
FSomeVar := 1; // ACCESSING PRIVATE FIELD!
end;
This works because both classes are in the same unit, so they're kinda "friends".
But if I'll try to create a new class in a new unit
TMyFixedComponent = class (TThirdPartyComponent)
procedure Foo; override;
end;
I can't access FSomeVar anymore, but I need to use it for my fix. And I really don't want to reproduce in my code all that tree of base classes.
Can you advise some quick hack to access that private field without changing the original component's unit if it's possible at all?
By the use of class helpers it's possible to accomplish access to the private parts of the base class from the derived class without loosing type safety.
Just add these declarations in another unit:
Uses YourThirdPartyComponent;
type
// A helper to the base class to expose FSomeVar
TMyBaseHelper = class helper for TThirdPartyComponentBase
private
procedure SetSomeVar( value : integer);
function GetSomeVar: integer;
public
property SomeVar:integer read GetSomeVar write SetSomeVar;
end;
TMyFixedComponent = class helper for TThirdPartyComponent
protected
procedure Foo;
end;
procedure TMyFixedComponent.Foo;
begin
// Cast to base class and by the class helper TMyBaseHelper the access is resolved
TThirdPartyComponentBase(Self).SomeVar := 1;
end;
function TMyBaseHelper.GetSomeVar: integer;
begin
Result := Self.FSomeVar; // ACCESSING PRIVATE FIELD!
end;
procedure TMyBaseHelper.SetSomeVar(value: integer);
begin
Self.FSomeVar := value; // ACCESSING PRIVATE FIELD!
end;
// Testing
var
TSV: TThirdPartyComponent;
begin
TSV := TThirdPartyComponent.Create;
try
TSV.Foo;
WriteLn(IntToStr(TSV.SomeVar)); // Writes 1
finally
TSV.Free;
end;
end.
As can be seen from comments in code, FSomeVar is exposed by a class helper from the TThirdPartyComponentBase class.
Another class helper for the TThirdPartyComponent implements the Foo procedure. In there, access to the SomeVar property of the base class helper is made via a type cast to the base class.
You have to use a hack to access a private field in any class (including a base class) in a different unit. In your case define in your unit:
type
__TThirdPartyComponentBase = class
private
FSomeVar: Integer;
end;
Then get the access:
__TThirdPartyComponentBase(Self).FSomeVar := 123;
Of course, that is dangerous, because you will need to control changes in the base class. Because if the fields layout will be changed and you will miss this fact, then the above approach will lead to failures, AV's, etc.
Don't know if this will help, but I seem to recall there is a way to "crack" a private variable into visibility.
I know, for example, I've encountered warnings from the compiler when I've moved a property from lower visibility (in the base class) to a more visible level (in my descendant). The warning stated that it's being declared at a different level of visibility...
It's been some time and I'm not certain, but I believe what you can do is in your descendant declare the same variable as protected. (You may have to use the Redeclare keyword for this to compile.)
Sorry I don't have more specific information on how to do this (if it's indeed possible.) Perhaps this posting will prompt one of the wizards here into correcting me! :-)
Expose the value of the private variable by a protected property in TThirdPartyComponent.
TThirdPartyComponent = class (TThirdPartyComponentBase)
private
Procedure SetValue(Value: Integer);
Function GetValue: Integer;
protected
Property MyVar: Integer read GetValue write Setvalue;
procedure Foo; virtual;
end;
Procedure TThirdPartyComponent.SetValue(Value: Integer);
begin
FSomeVar := Value ;
end;
Function GetValue: Integer;
begin
result := FSomeVar;
end;
In TMyFixedComponent class use the MyVar Property in the procedure which you would like to override.