unit UAppIntfFactory;
interface
uses
Classes, Sysutils, Contnrs, UAppIntf;
var
Interfaces: TInterfaceList;
//In DElphi eingebaut
ClassesIntf: TObjectList;
//In DElphi eingebaut
Interfaced: IAppInterface;
procedure SetClassOf(Instance: TObject);
procedure SetInterfaceOf(
Name:
String);
function GetInterfaceOf(
Name:
String): IInterface;
function GetClassOf(Instance: TObject): TObject;
implementation
uses UAppIntfImpl;
procedure SetClassOf(Instance: TObject);
begin
if Assigned(ClassesIntf)
then
begin
ClassesIntf.Add(Instance);
end;
end;
procedure SetInterfaceOf(
Name:
String);
begin
if Assigned(Interfaces)
then
begin
Interfaces.Add(Interfaced);
end;
end;
function GetClassOf(Instance: TObject): TObject;
var Index: Integer;
begin
if Assigned(ClassesIntf)
then
begin
Index := 0;
while Index < ClassesIntf.Count
do
begin
{
if Instance is Classesintf.Items[index] then
begin
Result := ClassesIntf.Items[Index];
Index := ClassesIntf.Count;
end;
}
Inc(
Index);
end;
end;
end;
function GetInterfaceOf(
Name:
String): IInterface;
var Index: Integer;
begin
if Assigned(Interfaces)
then
begin
Result := Interfaces.Items[
Index];
end;
end;
initialization
Interfaces := TInterfaceList.Create;
ClassesIntf := TObjectList.Create;
finalization
ClassesIntf.Free;
Interfaces.Free;
end.
//Hier die Implementation der Klassen:
unit UAppIntfImpl;
interface
uses
Classes, Sysutils, Dialogs, UAppIntf, UAppIntfFactory;
type
TAppIntfImpl =
class(TInterfacedObject, IAppInterface)
procedure DoSomething;
end;
TAppIntfImpl2 =
class(TInterfacedObject, IAppInterface)
procedure DoSomething;
end;
var
InterfacedClass1: TAppIntfImpl;
InterfacedClass2: TAppIntfImpl2;
implementation
{ TAppIntfImpl }
procedure TAppIntfImpl.DoSomething;
begin
ShowMessage('
the Interfaced method von TAppIntfImpl');
end;
procedure TAppIntfImpl2.DoSomething;
begin
ShowMessage('
the Interfaced method von TAppIntfImpl2');
end;
initialization
//InterfacedClass := TAppIntfImpl.Create;
if Assigned(Interfaces)
then
begin
Interfaces.Add( InterfacedClass1 );
Interfaces.Add( InterfacedClass2 );
end;
if Assigned(ClassesIntf)
then
begin
ClassesIntf.Add(InterfacedClass1);
ClassesIntf.Add(InterfacedClass2);
end;
//InterfacedClass.Free;
end.
//Hier kommt die Anwendung:
unit UAppIntfUser;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, UAppIntf, StdCtrls, UAppIntfFactory, UAppIntfImpl;
type
TForm1 =
class(TForm)
Button1: TButton;
cbxIntfChange: TComboBox;
lbIntfChange: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure cbxIntfChangeCloseUp(Sender: TObject);
private
{ Private-Deklarationen }
FInterfaceExists: Boolean;
public
FInterface: IAppInterface;
{ Public-Deklarationen }
FInterfaced: IAppInterface;
FInterface2: TAppIntfImpl;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if FInterfaceExists
then
//FInterfaced.DoSomething;
FInterface2.DoSomething;
end;
procedure TForm1.cbxIntfChangeCloseUp(Sender: TObject);
var Index: Integer;
begin
Index := cbxIntfChange.ItemIndex;
cbxIntfChange.Text := cbxIntfChange.Items.Strings[
Index];
//FInterfaced := Interfaces.Items[Index];
//------ Hier kommt eine Listen-Index-Exception, die ich mir nicht erklären kann
FInterface2 := TAppIntfImpl(ClassesIntf.Items[
index]);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FInterfaceExists := true;
//FInterfaced := GetInterfaceOf('Impl2');
end;
end.