Mega Code Archive
How do you add Interfaces to a List
<![CDATA[
Title: How do you add Interfaces to a List ?
Question: It's more efficient to control Interfaces in a List and ask with QueryInterface() which objects support an Interface
Answer:
First we need some Interfaces (the same goes also in Kylix, pure Interfaces are independent from COM, it's a feature of ObjectPascal):
type
IKiss = interface (IUnknown)
['{19A231B1-269F-45A2-85F1-6D8A629CC53F}']
procedure kiss; stdcall;
end;
ISpeak = interface (IUnknown)
['{B7F6F015-88A6-47AC-9176-87B6E313962D}']
procedure sayHello; stdcall;
end;
Second the interfaces must be implemented:
TDog = class (TInterfacedObject, ISpeak)
public
procedure sayHello; stdcall;
end;
TFrench = class (TInterfacedObject, ISpeak, IKiss)
public
procedure kiss; stdcall;
procedure sayHello; stdcall;
end;
TEnglish = class (TInterfacedObject, ISpeak)
public
procedure sayHello; stdcall;
end;
e.g. the dog with
procedure TDog.sayHello;
begin
showmessage('dog is barking wauwau');
end;
Now we add the instances of the interface in the list, using the defined type TInterfaceList so we are able to ask with QueryInterface if an object supports an Interface, in our example if a dog as an object can kiss or just sayhello:
procedure TForm1.btnCollectClick(Sender: TObject);
var
collection: TInterfaceList;
i: Integer;
aObjspeak: ISpeak;
aObjKiss: IKiss;
begin
collection:= TinterfaceList.create;
try
with collection do begin
add(TEnglish.create);
add(TFrench.create);
add(TDog.create) ;
end;
for i:= 0 to collection.count - 1 do begin
aObjSpeak:= collection[i] as ISpeak; //TFrench, TEnglish, TDog
if aObjSpeak NIL then
aObjSpeak.sayHello;
collection[i].queryInterface(IKiss, aObjKiss); //only TFrench
if aObjKiss NIL then
aObjKiss.kiss;
end;
finally
collection.free;
end;
end;
Tips:
if you get by using AS Operator or QueryInterface() the error:
[Error] uSingletonF.pas(117): Operator not applicable to this operand type
You must get with CTRL + SHIFT + G a GUID
ISpeak = interface (IUnknown)
['{B7F6F015-88A6-47AC-9176-87B6E313962D}'] //GUID
-----------------------Example with the observer pattern--------
{$IFDEF OInterface}
TIObserver = interface
procedure Update(ChangedSubject: TObservable);
end;
{$ENDIF}
TObservable = class (TObject)
procedure Add(Observer: TIObserver); virtual; abstract;
procedure Remove(Observer: TIObserver); virtual; abstract;
procedure Notify; virtual; abstract;
end;
TMySubject = class (TObservable)
private
{$IFDEF OInterface}
FIObservers: TInterfaceList;
{$ENDIF}
//FObservers: TList;
Fx: Integer;
Fy: Integer;
Fz: Integer;
public
constructor Create;
destructor Destroy; override;
function getX: Integer;
function getY: Integer;
function getZ: Integer;
procedure Notify; override;
procedure Add(Observer: TIObserver); override;
procedure Remove(Observer: TIObserver); override;
procedure setX(value: integer);
procedure setY(value: integer);
procedure setZ(value: integer);
end;
constructor TMySubject.Create;
begin
inherited Create;
{$IFDEF OInterface}
FIObservers := TInterfaceList.Create;
{$ENDIF}
end;
TMyBarsMaker = class (TInterfacedObject, TIObserver)
private
FBarX: TProgressBar;
FBarY: TProgressBar;
FBarZ: TProgressBar;
public
constructor CreateBars(aParent: TWinControl);
destructor Destroy; override;
function makePanel(aOwner: TWinControl): TPanel; virtual;
procedure Update(ChangedSubject: TObservable); //override;
end;
TMyTrackBars = class (TInterfacedObject, TIObserver)
private
FBarX: TTrackBar;
FBarY: TTrackBar;
FSubject: TMySubject;
procedure TrackBarChange(Sender: TObject);
public
constructor CreateBars(aParent: TWinControl; aSubject: TMySubject);
destructor Destroy; override;
procedure Update(ChangedSubject: TObservable); //override;
end;
and the main routine to notify the objects in the interface list:
procedure TMySubject.Notify;
var
i: Integer;
begin
for i:= 0 to pred(FIObservers.Count) do
TIObserver(FIObservers.Items[i]).Update(Self);
end;
// or more type safe:
//myOS: TIObserver;
for i:= 0 to pred(FIObservers.Count) do begin
myOS:= TIObserver(FIObservers[i]);
FIObservers[i].queryInterface(TIObserver, myOS);
if Assigned(myOS)then
myOS.Update(self);
end;
and all consumers are type safe with the interface:
{$IFDEF OInterface}
FMyBars: TIObserver;
FMyTrackBars: TIObserver;
FFormAdapter: TIObserver;
{$ENDIF}
]]>