Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#6

AW: ClassFactory ähnlich wie Spring Framework, Hilfe gesucht!

  Alt 6. Feb 2014, 14:50
Wenn man auch noch das hier
Delphi-Quellcode:
type
  IFoo = interface
    ['{4C53C006-737E-4F3C-A424-D5A34335EC0C}']
    procedure Bar;
  end;

  TFoo = class( TInterfacedObject, IFoo )
  private
    procedure Bar;
  end;

  TAnotherFoo = class( TFoo )
  private
    procedure Bar;
  end;

  { TFoo }

procedure TFoo.Bar;
begin
  Writeln( Self.ClassName + '.Bar' );
end;

{ TAnotherFoo }

procedure TAnotherFoo.Bar;
begin
  Writeln( Self.ClassName + '.Bar' );
end;

procedure Test;
var
  LFoo : IFoo;
begin
  GlobalContainer.RegisterClass<IFoo, TFoo>;
  GlobalContainer.RegisterClass<IFoo, TAnotherFoo>( 'Another' );
  LFoo := GlobalContainer.GetClass<IFoo>;
  LFoo.Bar; // -> TFoo.Bar
  LFoo := GlobalContainer.GetClass<IFoo>( 'Another' );
  LFoo.Bar; // -> TAnotherFoo.Bar
end;
abgetütet haben will, dann so
Delphi-Quellcode:
unit Container;

interface

uses
  System.SysUtils,
  System.Generics.Collections;

type
  EContainerException = class( Exception );

  GlobalContainer = class
  private
    class var _ClassDict : TDictionary<string, TClass>;
  protected
    class constructor Create;
    class destructor Destroy;
  public
    class procedure RegisterClass<TInterface : IInterface; TRegClass : class>( const Name : string = '' );
    class function GetClass<T : IInterface>( const Name : string = '' ) : T;
  end;

implementation

uses
  System.TypInfo;

{ GlobalContainer }

class constructor GlobalContainer.Create;
begin
  _ClassDict := TDictionary<string, TClass>.Create;
end;

class destructor GlobalContainer.Destroy;
begin
  _ClassDict.Free;
end;

class function GlobalContainer.GetClass<T>( const Name : string ) : T;
var
  LGUID : TGUID;
  LKey : string;
  LClass : TClass;
  LObj : TObject;
begin
  LGUID := GetTypeData( TypeInfo( T ) ).Guid;
  LKey := LGUID.ToString + Name.ToUpper;
  if _ClassDict.ContainsKey( LKey ) then
  begin
    LClass := _ClassDict.Items[LKey];
    LObj := LClass.Create;
    Supports( LObj, LGUID, Result );
  end
  else
    raise EContainerException.CreateFmt( 'Keine Klasse zum Interface%s(%s) gefunden', [LGUID.ToString, Name] );
end;

class procedure GlobalContainer.RegisterClass<TInterface, TRegClass>( const Name : string );
var
  LGUID : TGUID;
  LKey : string;
begin
  LGUID := GetTypeData( TypeInfo( TInterface ) ).Guid;
  LKey := LGUID.ToString + Name.ToUpper;
  _ClassDict.AddOrSetValue( LKey, TRegClass );
end;

end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat