Auf Interfaces zugreifen?

[viakt133]

Hallo,

bin wieder bei den Interfaces angekommen. Hab jetzt diesen Ansatz:

Delphi-Quellcode:

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.