I have class with 2 events: OnConnect and OnDisconnect:
type
TEvent = reference to procedure;
TConnection = class
private
fOnConnect: TEvent;
fOnDisconnect: TEvent;
public
procedure SomeBehavior(aChoice: Boolean);
property OnConnect: TEvent read fOnConnect write fOnConnect;
property OnDisconnect: TEvent read fOnDisconnect write fOnDisconnect;
end;
implementation
{ TConnection }
procedure TConnection.SomeBehavior(aChoice: Boolean);
begin
if aChoice then
fOnConnect
else
fOnDisconnect;
//im not cheacking Assign(Events) to make example simple
end;
now I would like to do same thing but in more object style.
I mean use interfaces and observer pattern from String4D. And i made this:
interface
uses
Spring.DesignPatterns;
type
IObserver = interface
procedure ReactToConnect(aText: String);
procedure ReactToDisconnect(aTimeoutInMs: Integer);
end;
IConnection<T> = interface(IObservable<IObserver>)
procedure SomeBehavior(aChoice: Boolean);
end;
implementation
uses
System.SysUtils;
type
TConnection = class(TObservable<IObserver>, IConnection<IObserver>)
public
procedure SomeBehavior(aChoice: Boolean);
end;
{ TConnection }
procedure TConnection.SomeBehavior(aChoice: Boolean);
var
procOnConnect: TProc<IObserver>;
procOnDisconnect: TProc<IObserver>; // what if i want no parameters?
someText: String;
someNumber: Integer;
begin
someText := RandomText;
procOnConnect := procedure(aObserver: IObserver)
begin
aObserver.ReactToConnect(someText);
end;
someNumber := RandomInt;
procOnDisconnect := procedure(aObserver: IObserver)
begin
aObserver.ReactToDisconnect(someNumber);
end;
if aChoice then
Self.NotifyListeners(procOnConnect)
else
Self.NotifyListeners(procOnDisconnect);
end;
im doing it fisrt time and just want to ask if its proper way? or im doing somethink heretical here?
Related
I have multiple collections like:
TFooList = TObjectDictionary<string,TFoo>;
TBarList = TObjectDictionary<string,TBar>;
....
TRoot = class
value : string
end;
TFoo = class(TRoot)
...
end;
TBar = class(TRoot)
...
end;
And I have an interface/class that could save or load collections:
ISave = interface
procedure Save( TDictionary<string, string> );
function Load: TDictionary<string, string>;
end;
Note that the interface expects a key/string pair collection in order to work properly.
I implemented some ISave classes in order to load/save the collection to/from file or databases:
TDbSave = class( TInterfacedObject , ISave )
....
end;
iSave := TDbSave( ConnString )
TFileSave = class( TInterfacedObject , ISave )
....
end;
iSave := TFileSave( fileName );
So, the last piece would be inherit from each collection and create the save/load methods to "translate" each collection into/from TDictionary(string, string)
TFooListSavable = TFooList;
procedure Create( save_load : ISave );
procedure Save;
procedure Load;
....
end;
procedure TFooListSavable.Save
// 1. create a TDictionary<string, string>
// 2. load the dictionary above with my collection translating
// each Foo object into a string
// 3. call save_load.Save( dictionary );
end;
procedure TFooListSavable.Load
// 1. create a TDictionary<string, string>
// 2. call save_load.load to load it
// 3. Move over the collection and translate string into TFoo and
// 4. AddOrEquals each TFoo created into TFooListSavable.
end;
So, I have two problems with this approach:
1) The interface that save or load expects a string value from the Collection and, although all the objects in each collection inherit from a class that has this string defined, I don't know how to transform a collection like TDictionary<string,TFoo> into a TDictionary<string,string> without resorting to the code above (which will duplicate the collection in order to pass it to iSave object).
2) I feel that, although I can replace iSave objects changing the way the collections would be saved/loaded without changing the collections themselves, I don't know if it is the best approach to save/load collections that keep related objects.
I think you are going about this the wrong way.
ISave should not have any concept of any TDictionary at all. It should just expose methods for reading/writing basic data types (integers, strings, etc). Let TFooListSavable and TBarListSavable decide how to serialize their respective TDictionary data however they want, calling the ISave methods as needed.
Even better would be if TFooListSavable and TBarListSavable pass ISave to each individual TFoo/TBar and let them serialize their own data members directly.
For example, something like this:
type
ISerialize = interface
function HasData: Boolean;
procedure StartWriteCollection;
procedure StartWriteItem;
procedure FinishWriteCollection;
procedure FInishWriteItem;
procedure WriteBoolean(value: Boolean);
procedure WriteInteger(value: Integer);
procedure WriteString(const value: String);
...
procedure StartReadCollection;
procedure StartReadItem;
procedure FinishReadCollection;
procedure FinishReadItem;
function ReadBoolean: Boolean;
function ReadInteger: Integer;
function ReadString: String;
...
end;
TRoot = class
public
value : string;
constructor Create; virtual;
procedure Save(Dest: ISerialize); virtual;
procedure Load(Src: ISerialize); virtual;
end;
TBaseList<T: TRoot, constructor> = class(TObjectDictionary<string, T>)
public
procedure Save(Dest: ISerialize);
procedure Load(Src: ISerialize);
end;
TFoo = class(TRoot)
public
myint: Integer;
...
procedure Save(Dest: ISerialize); override;
procedure Load(Src: ISerialize); override;
end;
TFooList = TBaseList<TFoo>;
TBar = class(TRoot)
mybool: Boolean;
...
procedure Save(Dest: ISerialize); override;
procedure Load(Src: ISerialize); override;
end;
TBarList = TBaseList<TBar>;
TDbSerialize = class(TInterfacedObject, ISerialize)
...
end;
TFileSerialize = class(TInterfacedObject, ISerialize)
...
end;
procedure TBaseList<T>.Save(Dest: ISerialize);
var
pair: TPair<string, T>;
begin
Dest.StartWriteCollection;
for pair in Self do
begin
Dest.StartWriteItem;
Dest.WriteString(pair.Key);
TRoot(pair.Value).Save(Dest);
Dest.FinishWriteItem;
end;
Dest.FinishWriteCollection;
end;
procedure TBaseList<T>.Load(Src: ISerialize);
var
Cnt, I: Integer;
key: string;
value: T;
begin
Self.Clear;
Src.StartReadCollection;
While Src.HasData do
begin
Src.StartReadItem;
key := Src.ReadString;
value := T.Create;
try
value.Load(Src);
Self.Add(key, value);
except
value.Free;
raise;
end;
Src.FinishReadItem;
end;
Src.FinishReadCollection;
end;
procedure TRoot.Save(Dest: ISerialize);
begin
Dest.WriteString(value);
end;
procedure TRoot.Load(Src: ISerialize);
begin
value := Src.ReadString;
end;
procedure TFoo.Save(Dest: ISerialize);
begin
inherited;
Dest.WriteInteger(myint);
end;
procedure TFoo.Load(Src: ISerialize);
begin
inherited;
myint := Src.ReadInteger;
end;
procedure TBar.Save(Dest: ISerialize);
begin
inherited;
Dest.WriteBoolean(mybool);
end;
procedure TBar.Load(Src: ISerialize);
begin
inherited;
mybool := Src.ReadBoolean;
end;
I have to connect several measurement devices to my app (ie. caliper, weight scale, ...), not being tied to a specific brand nor model, so on client side I use interfaces with generic methods (QueryValue). Devices are connected on COM port and accessed on an asynchronous way:
Ask for a value (= send a specific character sequence on
COM port)
Wait for a response
On 'business' side my components use TComPort internally, which data reception event is TComPort.OnRxChar. I wonder how I could fire this event through an interface? Here is what I've done so far:
IDevice = interface
procedure QueryValue;
function GetValue: Double;
end;
TDevice = class(TInterfacedObject, IDevice)
private
FComPort: TComPort;
FValue: Double;
protected
procedure ComPortRxChar;
public
constructor Create;
procedure QueryValue;
function GetValue: Double;
end;
constructor TDevice.Create;
begin
FComPort := TComPort.Create;
FComPort.OnRxChar := ComPortRxChar;
end;
// COM port receiving data
procedure TDevice.ComPortRxChar;
begin
FValue := ...
end;
procedure TDevice.GetValue;
begin
Result := FValue;
end;
But I need an event to know when to call GetValue on client side. What's the usual way to perform that kind of data flow?
You can add event property to interface
IDevice = interface
function GetValue: Double;
procedure SetMyEvent(const Value: TNotifyEvent);
function GetMyEvent: TNotifyEvent;
property MyEvent: TNotifyEvent read GetMyEvent write SetMyEvent;
end;
and realize it in TDevice class
TDevice = class(TInterfacedObject, IDevice)
private
FMyEvent: TNotifyEvent;
procedure SetMyEvent(const Value: TNotifyEvent);
function GetMyEvent: TNotifyEvent;
public
function GetValue: Double;
procedure EmulChar;
end;
Then as usually call FMyEvent handler (if assigned) in the end of ComPortRxChar.
Tform1...
procedure EventHandler(Sender: TObject);
procedure TForm1.EventHandler(Sender: TObject);
var
d: Integer;
i: IDevice;
begin
i := TDevice(Sender) as IDevice;
d := Round(i.GetValue);
ShowMessage(Format('The answer is %d...', [d]));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
id: IDevice;
begin
id:= TDevice.Create;
id.MyEvent := EventHandler;
(id as TDevice).EmulChar; //emulate rxchar arrival
end;
procedure TDevice.EmulChar;
begin
if Assigned(FMyEvent) then
FMyEvent(Self);
end;
function TDevice.GetMyEvent: TNotifyEvent;
begin
Result := FMyEvent;
end;
function TDevice.GetValue: Double;
begin
Result := 42;
end;
procedure TDevice.SetMyEvent(const Value: TNotifyEvent);
begin
FMyEvent := Value;
end;
Can the object of (TObjectList) know when some values of (TMyObject) was changed?
Some example:
TMyObject = class
oName: string;
end;
TMyObjectList = class(TObjectList<TMyObject>)
end;
procedure Form1.Button1.Click(Sender: TObject);
var
Obj: TMyObject;
List: TMyObjectList;
Begin
List:= TMyObjectList.Create;
Obj:= TMyObject.Create;
List.Add(Obj);
List[0].oName:= 'Test'; // here a want to know from var (List) when this object (Obj or List[0]) changed his value..
end;
Thanks for any help.
I just added the TObservableList<T> type to Spring4D (feature/observablelist branch). It is mostly modeled after .NET and uses the INotifyPropertyChanged interface to attach its event handler to any objects that support it. This class has been part of DSharp for quite some time and is used in production. It might change a bit in the future and become full part of the library.
Here is a small example how to use it so you get an idea:
program Project60;
{$APPTYPE CONSOLE}
uses
Spring,
Spring.Collections,
SysUtils;
type
TNotifyPropertyChangedBase = class(TInterfaceBase, INotifyPropertyChanged)
private
fOnPropertyChanged: Event<TPropertyChangedEvent>;
function GetOnPropertyChanged: IPropertyChangedEvent;
protected
procedure PropertyChanged(const propertyName: string);
end;
TMyObject = class(TNotifyPropertyChangedBase)
private
fName: string;
procedure SetName(const Value: string);
public
property Name: string read fName write SetName;
end;
TMain = class
procedure ListChanged(Sender: TObject; const item: TMyObject;
action: TCollectionChangedAction);
end;
{ TNotifyPropertyChangedBase }
function TNotifyPropertyChangedBase.GetOnPropertyChanged: IPropertyChangedEvent;
begin
Result := fOnPropertyChanged;
end;
procedure TNotifyPropertyChangedBase.PropertyChanged(
const propertyName: string);
begin
fOnPropertyChanged.Invoke(Self,
TPropertyChangedEventArgs.Create(propertyName) as IPropertyChangedEventArgs);
end;
{ TMyObject }
procedure TMyObject.SetName(const Value: string);
begin
fName := Value;
PropertyChanged('Name');
end;
{ TMain }
procedure TMain.ListChanged(Sender: TObject; const item: TMyObject;
action: TCollectionChangedAction);
begin
case action of
caAdded: Writeln('item added ', item.Name);
caRemoved, caExtracted: Writeln('item removed ', item.Name);
caChanged: Writeln('item changed ', item.Name);
end;
end;
var
main: TMain;
list: IList<TMyObject>;
o: TMyObject;
begin
list := TCollections.CreateObservableList<TMyObject>;
list.OnChanged.Add(main.ListChanged);
o := TMyObject.Create;
o.Name := 'o1';
list.Add(o);
o := TMyObject.Create;
o.Name := 'o2';
list.Add(o);
list[1].Name := 'o3';
Readln;
end.
There is nothing built in that can do what you ask. You will need to implement a notification mechanism yourself. This is the classic scenario for the Observer Pattern.
There are many implementations of this pattern already in existence. One obvious choice would be to use the implementation in Spring4D. Nick Hodges recent book, More Coding in Delphi, includes a chapter on this pattern which I would recommend.
Found the way, how to call method of TObjectList from TMyObject. Using TNotifyEvent in base Object.
Example:
TMyClass = class(TObject)
private
FName: string;
FOnNameEvent: TNotifyEvent;
procedure SetName(value: string);
public
property Name: string read FName write SetName;
property OnNameEvent: TNotifyEvent read FOnNameEvent write FOnNameEvent;
end;
procedure TMyClass.SetName(value: string);
begin
FName := value;
if Assigned(FOnNameEvent) then
FOnNameEvent(Self);
end;
procedure MyNameEvent(Sender: TObject);
var
i: Integer;
begin
for i := 0 to MyListOfMyClassObjects.Count -1 do
if Sender = MyListOfMyClassObjects.Item[i] then
begin
MessageBox(0, PChar(TMyClass(MyListOfMyClassObjects.Item[i]).Name), nil, MB_OK);
break;
end;
end;
procedure MyProc;
var
MyObject: TMyClass;
begin
MyObject := TMyClass.Create;
MyObject.OnNameEvent := MyNameEvent;
MyListOfMyClassObjects.Add(MyObject);
end;
There are 3 classes (there may be much more), which have the same procedure (procedure Populate). They are nearly identical and differs only by object creation. All I want is to write a universal procedure in the base class, which will replace this notorious repeating of code forever. I am not really sure, if I can express exactly what I am up to, but look at the code below and see.
TGrandFather = class(TObject)
end;
TFather = class(TGrandFather)
end;
TSon = class(TFather)
end;
TGrandson.... and so on...
TGrandFathers = class (TList)
public
procedure Populate(Amount:Integer);
end;
TFathers = class (TGrandFathers)
public
procedure Populate(Amount:Integer);
end;
TSons = class (TFathers)
public
procedure Populate(Amount:Integer);
end;
TGrandsons....
...
procedure TGrandFathers.Populate(Amount:Integer);
var i:integer;
xGrandFather:TGrandFather;
begin
for i := 0 to Amount do
begin
xGrandFather:=TGrandFather.Create;
Add(xGrandFather);
end;
end;
procedure TFathers.Populate(Amount:Integer);
var i:integer;
xFather:TFather;
begin
for i := 0 to Amount do
begin
xFather:=TFather.Create; //this is the point, which makes trouble
Add(xFather);
end;
end;
procedure TSons.Populate(Amount:Integer);
var i:integer;
xSon:TSon;
begin
for i := 0 to Amount do
begin
xSon:=TSon.Create; //this is the point, which makes trouble
Add(xSon);
end;
end;
procedure Grandsons...
Thanx...
To answer your question, you could use a metaclass through "class of" if you want to go the route you are going. This block of code demonstrates how you would accomplish that. The hierarchy needs to be cleaned up but you should get the gist of what is going on through this code.
A metaclass is a class whose instances are classes. This allows you to build a more generic framework because you can then use your metaclass to create the classes that you need.
type
TGrandFather = class(TObject)
end;
TStrangeHeirarchyClass = class of TGrandFather;
TFather = class(TGrandFather)
end;
TSon = class(TFather)
end;
TGrandFathers = class(TList)
protected
procedure PopulateInternal(aAmount:Integer; aContainedClass:
TStrangeHeirarchyClass);
public
procedure Populate(Amount:Integer);
end;
TFathers = class (TGrandFathers)
public
procedure Populate(Amount:Integer);
end;
TSons = class (TFathers)
public
procedure Populate(Amount:Integer);
end;
implementation
procedure TGrandFathers.Populate(Amount:Integer);
begin
PopulateInternal(Amount, TGrandFather);
end;
procedure TGrandFathers.PopulateInternal(aAmount:Integer; aContainedClass:
TStrangeHeirarchyClass);
var
i:integer;
xFamilyMember:TGrandFather;
begin
for i := 0 to aAmount do
begin
xFamilyMember := aContainedClass.Create;
Add(xFamilyMember);
end;
end;
procedure TFathers.Populate(Amount:Integer);
begin
PopulateInternal(Amount, TFather);
end;
procedure TSons.Populate(Amount:Integer);
begin
PopulateInternal(Amount, TSon);
end;
The way it works is that the metaclass TStrangeHeirarchyClass, which you can use just like a regular data type, stores the underlying class that you would like to work with. You can pass the type in as a parameter (like I did in the code example above) or store it in the class as a property or field like this:
TGrandFathers = class(TList)
private
FContainedClass: TStrangeHeirarchyClass;
public
procedure Populate(Amount:Integer);
property ContainedClass: TStrangeHeirarchyClass read
FContainedClass write FContainedClass;
end;
Once you have set this property you would then be able to use it to create instances of the class type that it was set to. So, setting the ContainedClass as a TFather would result in calls to ContainedClass.Create creating instances of TFather.
As David indicated in the comments, you will run into problems if you use a metaclass and override the default constructor. Your code in the constructor will never run. You either need to wither use virtual constructors or override the existing AfterConstruction method which is a virtual method that is called by the constructor. Something like this would be an example if you were using AfterConstruction:
TGrandFathers = class(TList)
protected
FContainedClass: TStrangeHeirarchyClass;
public
procedure AfterConstruction; override;
procedure Populate(Amount:Integer);
end;
TFathers = class (TGrandFathers)
public
procedure AfterConstruction; override;
end;
TSons = class (TFathers)
public
procedure AfterConstruction; override;
end;
implementation
procedure TGrandFathers.AfterConstruction;
begin
inherited;
FContainedClass := TGrandFather;
// Other construction code
end;
procedure TGrandFathers.Populate(aAmount:Integer);
var
i:integer;
xFamilyMember:TGrandFather;
begin
for i := 0 to aAmount do
begin
xFamilyMember := FContainedClass.Create;
Add(xFamilyMember);
end;
end;
procedure TFathers.AfterConstruction;
begin
inherited;
FContainedClass := TFather;
// Other construction code
end;
procedure TSons.AfterConstruction;
begin
inherited;
FContainedClass := TSon;
// Other construction code
end;
Your hierarchy looks very strange though. I think something like this would be more appropriate:
type
TRelationType = (ptSon, ptFather, ptGrandfather);
TPerson = class;
TRelation = class(TObject)
strict private
FRelationship: TRelationType;
FRelation: TPerson;
public
property Relation: TPerson read FRelation write FRelation;
property Relationship: TRelationType read FRelationship write FRelationship;
end;
TRelationList = class(TList)
//...
end;
TPerson = class(TObject)
strict private
FPersonName: string;
FRelations: TRelationList;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
property PersonName: string read FPersonName write FPersonName;
property Relations: TRelationList read FRelations;
end;
implementation
procedure TPerson.AfterConstruction;
begin
inherited;
FRelations := TRelationList.Create;
end;
procedure TPerson.BeforeDestruction;
begin
FRelations.Free;
inherited;
end;
This seems to work:
//MMWIN:CLASSCOPY
unit _MM_Copy_Buffer_;
interface
implementation
type
TBaseSelfCreating = class(TObject)
procedure Populate(Amount: Integer);
procedure Add(Obj: TObject);
end;
{TBaseSelfCreating}
procedure TBaseSelfCreating.Add(Obj: TObject);
begin
Assert(Obj is TBaseSelfCreating);
Assert(Obj <> Self);
Obj.Free;
end;
procedure TBaseSelfCreating.Populate(Amount: Integer);
var
i: Integer;
begin
for i := 1 to Amount do Add(Self.ClassType.Create);
end;
end.
Simply use Self.ClassType.Create:
program Project13;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TFoo1 = class
procedure Boo;
end;
TFoo2 = class(TFoo1)
end;
{ TFoo1 }
procedure TFoo1.Boo;
var
x: TFoo1;
begin
x := Self.ClassType.Create as TFoo1;
write(Cardinal(Self):16, Cardinal(x):16);
Writeln(x.ClassName:16);
end;
begin
try
TFoo1.Create.Boo;
TFoo2.Create.Boo;
Readln;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
If you do not want to use Generics or you are using a version of Delphi without Generics, then this is a way. Yes, I know I can use forward declaration to remove one class, but this is clearer to follow.
Interface
type
TBaseAncestor = class
end;
TBaseClass = class of TBaseAncestor;
TGrandFathers = class (TBaseAncestor)
FClassType : TBaseClass;
constructor Create (AOwner : TControl); reintroduce; virtual;
procedure Populate;
procedure Add (X : TBaseAncestor);
end;
TFathers = class (TGrandFathers)
constructor Create (AOwner : TControl); override;
end;
Implementation
{ TGrandFathers }
constructor TGrandFathers.Create(AOwner: TControl);
begin
inherited Create;
FClassType := TGrandFathers;
end;
procedure TGrandFathers.Add (X : TBaseAncestor);
begin
end;
procedure TGrandFathers.Populate;
const
Amount = 5;
var
I : integer;
x : TBaseAncestor;
begin
for I := 0 to Amount do
begin
x := FClassType.Create;
Add (x);
end;
end;
{ TFathers }
constructor TFathers.Create(AOwner: TControl);
begin
inherited;
FClassType := TFathers;
end;
Each descendant stores its class into the class variable. And Populate uses this for Creation. I have been using this before Generics came along.
I created several new objects
TMyMemo = class (TMemo)
private
FYahoo = Integer;
procedure SetYahoo(Value:integer)
public
procedure Google(A,B:integer; S:string);
published
property Yahoo:integer read FYahoo write SetYahoo;
end;
TMyPaintbox = class (TPaintbox)
private
FYahoo = Integer;
procedure SetYahoo(Value:integer)
public
procedure Google(A,B:integer; S:string);
published
property Yahoo:integer read FYahoo write SetYahoo;
end;
TMyButton = class (TButton)
private
FYahoo = Integer;
procedure SetYahoo(Value:integer)
public
procedure Google(A,B:integer; S:string);
published
property Yahoo:integer read FYahoo write SetYahoo;
end;
.
.
.
These Controls are placed on Form1. Is there a way, how can I change the same property (Yahoo) and run the procedure (Google), which is declared in different objects in general?
I do not want to manually check class type like:
if Controls[i] is TMyMemo then ...
if controls[i] is TMyPaintbox then ...
because I do not know how many of my new classes will have property Yahoo and method Google (This is only simple example).
Probably I have to use ^ and # operator or FieldAdress, MethodAddress I do not know what else. Can you help me find general solution?
procedure Form1.Button1Click(Sender:TObject);
var i:integer;
begin
for i:=0 to Form1.ControlCount-1 do
begin
Controls[i].Google(4,5, 'Web'); // this should be changed somehow
Controls[i].Yahoo:=6; // this should be changed somehow
end;
end;
end;
Thanks
Define an interface which has both method Google() and property Yahoo defined.
Make your TMyButton, TMyMemo and TMyPaintbox inherit from that interface and override those methods to do what is necessary.
In the loop, cast the controls to the interface type using the "as" operator and access the Yahoo field and Google() method.
Here is the code - The is operator doesnt work as intended in Delphi 2009 and below, so I had to write a function for that - It needs to rely on catching a cast exception, so it isn't the cleanest solution:
type
TMyInterface = interface(IInterface)
['{1F379072-BBFE-4052-89F9-D4297B9A826F}']
function GetYahoo : Integer;
procedure PutYahoo(i : Integer);
property Yahoo : Integer read GetYahoo write PutYahoo;
procedure Google(A, B : integer; S : string);
end;
TMyButton = class (TButton, TMyInterface)
private
FStr : String;
FYah : Integer;
public
function GetYahoo : Integer;
procedure PutYahoo(i : Integer);
procedure Google(A, B : integer; S : string);
end;
TMyMemo = class (TMemo, TMyInterface)
private
FStr : String;
FYah : Integer;
public
function GetYahoo : Integer;
procedure PutYahoo(i : Integer);
procedure Google(A, B : integer; S : string);
end;
{ TMyButton }
function TMyButton.GetYahoo: Integer;
begin
Result := 0;
end;
procedure TMyButton.Google(A, B: integer; S: string);
begin
FStr := S + '=' + IntToStr(A + B);
end;
procedure TMyButton.PutYahoo(i: Integer);
begin
FYah := 42;
end;
{ TMyMemo }
function TMyMemo.GetYahoo: Integer;
begin
//
end;
procedure TMyMemo.Google(A, B: integer; S: string);
begin
//
end;
procedure TMyMemo.PutYahoo(i: Integer);
begin
//
end;
function IsMyIntf(c : TControl) : TMyInterface;
begin
try
Result := c as TMyInterface;
except on e : Exception do
Result := nil;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
i: Integer;
p : TMyInterface;
begin
for i := 0 to ControlCount - 1 do
begin
p := IsMyIntf(Controls[i]);
if (p <> nil) then
begin
p.PutYahoo(i);
p.Google(i, i, 'Hah!');
end;
end;
end;
Use the same base class
Use an interface
Use the D2010 RTTI
Implement a custom message on all controls and process it.
#lyborko, the Controls[i] returns a TControl Class wich not have an implementation for the Google method and the Yahoo property.for resolve you problem, you can check the class of the Controls[i] using the ClassType property and then implement something like this.
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
for i:=0 to Form1.ControlCount-1 do
begin
if Controls[i].ClassType = TMyPaintbox then
begin
TMyPaintbox (Controls[i]).Google(4,5, 'Web');
TMyPaintbox (Controls[i]).Yahoo:=6;
end
else
if Controls[i].ClassType = TMyMemo then
begin
TMyMemo (Controls[i]).Google(4,5, 'Web');
TMyMemo (Controls[i]).Yahoo:=6;
end
else
if Controls[i].ClassType = TMyButton then
begin
TMyButton (Controls[i]).Google(4,5, 'Web');
TMyButton (Controls[i]).Yahoo:=6;
end;
end;
end;
Better that use IF...ELSE with differents classes for know the component class you can use RTTI to know if an object has a específic property. You can find the code and explanation here:
Modify control properties using RTTI
Here you can find more code for access properties of a component using RTTI.
Regards.
You are propobly looking for RTTI.
Se this article about that http://delphi.about.com/od/vclusing/a/coloringfocused.htm (look at page 3)
The Only problem is that it Can't se public properties/methods, only published (i don't know if that stil is true in delphi 2010). A lot of RTTI info for delphi 2010 can be found here http://robstechcorner.blogspot.com/2009/09/so-what-is-rtti-rtti-is-acronym-for-run.html .
Calling a method by name (via RTTI): Se http://delphi.about.com/cs/adptips2004/a/bltip0204_3.htm