Klasseninstanz zur Laufzeit bestimmen

[Sir Rufo]

Nun ja, bei XE4 gibt es natürlich auch schon nettere Arten, damit umzugehen

Delphi-Quellcode:

unit Unit1;

interface

uses
  {System.}Generics.Collections,
  {System.}SysUtils;

type
  TObjectHandler = class abstract
  private type
    TAction = TProc<TObject>;
  private
    FRoutes: TDictionary<TClass, TAction>;
  protected type
    TRoute<T> = procedure( Argument: T ) of object;
  protected
    procedure RegisterRoute<T: class>( ARoute: TRoute<T> );
    procedure DoRaise( Argument: TObject );
  end;

  TFoo = class

  end;

  TBar = class

  end;

  TFooBar = class( TObjectHandler )
  private
    procedure Apply( Argument: TFoo ); overload;
    procedure Apply( Argument: TBar ); overload;
  public
    constructor Create( );

    procedure Handle( Argument: TObject );
  end;

implementation

{ TObjectHandler }

procedure TObjectHandler.DoRaise( Argument: TObject );
var
  LAction: TAction;
begin
  if FRoutes.TryGetValue( Argument.ClassType, LAction ) then
    LAction( Argument )
  else
    raise ENotImplemented.CreateFmt( 'Handler für %s fehlt', [ Argument.ClassName ] );
end;

procedure TObjectHandler.RegisterRoute<T>( ARoute: TRoute<T> );
begin
  FRoutes.Add( T,
    procedure( Argument: TObject )
    begin
      ARoute( Argument as T );
    end );
end;

{ TFooBar }

procedure TFooBar.Apply( Argument: TFoo );
begin

end;

procedure TFooBar.Apply( Argument: TBar );
begin

end;

constructor TFooBar.Create;
begin
  inherited Create;
  RegisterRoute<TFoo>( Apply );
  RegisterRoute<TBar>( Apply );
end;

procedure TFooBar.Handle( Argument: TObject );
begin
  DoRaise( Argument );
end;

end.

[Dejan Vu]

Zu sehr verwirren wollte ich den TE nun auch nicht.

'Case' (oder hier: if/else-Schlangen) sind zwar 'böse', aber in Fabrikmethoden durchaus erlaubt. Denn es ist ja nun kein Mehrwert ggü dem if/else bzw. 'case' (geht hier leider nicht), eine 1:1 Abbildung in eine Liste (oder Dictionary) zu stopfen.

Obwohl.. bei endlose if/else-Wicklungen würde ich nicht drauf beharren.

[Sir Rufo]

Wenn ich CleanCode haben möchte, dann nehmen ich so ein Routing-Dictionary.

(Gerade fällt mir auf, dass die Basis-Klasse keinen Destruktor hat ... ts ts ts)

[Dejan Vu]

Zitat von Sir Rufo:

Wenn ich CleanCode haben möchte, dann nehmen ich so ein Routing-Dictionary

Kann man. Muss man nicht.

Zitat von Robert C. Martin in 'Clean Code':

...is to bury the switch statement in the basement of an ABSTRACT FACTORY and never let anyone see it. The factory will use the switch statement to create appropriate instances ... My general rule for switch statements is that they can be tolerated if they appear only once..

[idefix2]

Zitat von Dejan Vu:

'Case' (oder hier: if/else-Schlangen) sind zwar 'böse'

Was, jetzt ist case also auch schon böse geworden?

Man kanns übertreiben...

[Sir Rufo]

Zitat von idefix2:

Zitat von Dejan Vu:

'Case' (oder hier: if/else-Schlangen) sind zwar 'böse'

Was, jetzt ist case also auch schon böse geworden?

Man kanns übertreiben...

Bitte auch den Kontext lesen und im selbigen verstehen.

[Delbor]

Hi zusammen

Sorry, wenn ich auf Sir Rufos Vorschlag bisher nicht eingegangen bin; der Grund liegt vor allem darin, dass ich bisher sehr wenig mit Generics arbeite, da ich die Dinger zu wenig durchschaue.
Eigentlich ist die einzige generische Klasse, die ich bisher benutze, eine Objectliste, die mir einst DeddyH vorgeschlagen hat. Ein weiterer seiner Vorschläge betraf die Verwendung einer Class Factory.Und so sieht das Ding heute bei mir aus :

Delphi-Quellcode:

uses Generics.Collections, Vcl.Forms, System.Classes, System.SysUtils;

type
  EFrameNotRegistered = class(Exception);
  TFrameClass = class of TFrame;

  TFrameFactory = class abstract
  strict private
    class var FAssociations: TDictionary<string, TFrameClass>;
    class constructor Create;
    class destructor Destroy;
  public
    class procedure RegisterFrameClass(const Extension: string; FrameClass: TFrameClass);
    class function GetRegisteredFrameClass(const Extension: string; AOwner: TComponent): TFrame;
  end;

implementation

{ TFrameFactory }

class constructor TFrameFactory.Create;
begin
  FAssociations := TDictionary<string, TFrameClass>.Create;
end;

class destructor TFrameFactory.Destroy;
begin
  FAssociations.Free;
end;

class function TFrameFactory.GetRegisteredFrameClass(const Extension: string;
  AOwner: TComponent): TFrame;
  var AFrameClass: TFrameClass;   //TCustomFrameClass
begin
  if FAssociations.TryGetValue(AnsiLowerCase(Extension), AFrameClass) then
    Result := AFrameClass.Create(AOwner)
  else
    raise EFrameNotRegistered.CreateFmt('Für die Endung %s ist keine Frameklasse registriert.', [Extension]);
end;

class procedure TFrameFactory.RegisterFrameClass(const Extension: string;
  FrameClass: TFrameClass);
begin
  FAssociations.AddOrSetValue('.' + AnsiLowerCase(Extension), FrameClass);
end;

end.

Meinen Frames muss ich dann noch folgendes verpassen:

Delphi-Quellcode:

initialization
  TFrameFactory.RegisterFrameClass('css', TCSSFrame);

Dein Vorschlag ist offenbar das generische Gegenstück zu dieser Fabrikklasse, und wenn mich meine bisherigen Kenntnisse der Generics nicht täuschen, könnte ich da jede Klasse registrieren, die, in deinem Beispiel, von TFoo, bzw. TBar erbt oder selbst von einem dieser Typen ist.
Somit könnte ich da jeden meiner Eventhandler registrieren. Hab ich das richtig verstanden?

Gruss
Delbor

[Delbor]

Hi zusammen

Vielen Dank für eure Antworten!
@Dejan Vu:

Delphi-Quellcode:

procedure TCssAttriTLBXFrame.CmbxAttributesCloseUp(Sender: TObject);
begin
   FActiveAttribut := TAttributsClass(CmbxAttributes.Items.Objects[CmbxAttributes.ItemIndex]);
  Label1.Caption := FActiveAttribut.ClassName;  //FActiveAttribut.AttributName;       CmbxAttributes.Items[CmbxAttributes.ItemIndex];

end;

Hier entspricht FActiveAttribut deiner Variablen 'Attribut' in der Prozedur CreateEvent. Als ClassName wird mir hier allerdings TAttributClass zurückgegeben. Gebe ich im Label FActiveAttribut.AttributName aus, erhalte ich allerdings den von mir an die Instanz übergebenen String. Das bedeutet aber auch: die Info über die Klasseninstanz ist in meiner Feldvariablen enthalten - das zeigt ja auch dein Code mit der Abfrage:
  if Attribut=FCommentAttri then result := FCSSCommentEvent Deshalb denke ich, die Info ist im Property 'Tipinfo' von Tpersistent-Nachfolgern enthalten. Die Frage ist (oder war) nur: wie komme ich da ran?

Zitat:

...denn wenn das 'CommentEvent' gefeuert wird, ist ja klar, das mit den CommitAttributen etwas los ist, ergo muss man das Attribut nicht übergeben.

Doch, muss ich, da die Klasse die neuen, und wenn die nicht geändert wurden, die alten Werte enthält. Die Synhighlither enthalten propertys gleichen Namens wie die von mir erstellten Instanzen, sind aber vom Tip der Klasse TSynHighlighterAttributes. So zum Beispiel für TSynCssSyn:

Delphi-Quellcode:

    fCommentAttri: TSynHighlighterAttributes;
    fPropertyAttri: TSynHighlighterAttributes;
    fKeyAttri: TSynHighlighterAttributes;
    fSpaceAttri: TSynHighlighterAttributes;

    fStringAttri: TSynHighlighterAttributes;
    fColorAttri: TSynHighlighterAttributes;
    fNumberAttri: TSynHighlighterAttributes;
    fSymbolAttri: TSynHighlighterAttributes;

    fTextAttri: TSynHighlighterAttributes;
    fValueAttri: TSynHighlighterAttributes;
    fUndefPropertyAttri: TSynHighlighterAttributes;
    fImportantPropertyAttri: TSynHighlighterAttributes;

Ein Auszug aus der dfm:

Delphi-Quellcode:

    AndAttri.Background = clRed
    CommentAttri.Foreground = clOlive
    CommentAttri.Style = [fsBold, fsItalic]
    IdentifierAttri.Foreground = clBlue
    IdentifierAttri.Style = [fsBold, fsUnderline]
    KeyAttri.Foreground = clBlue
    SpaceAttri.Foreground = clMoneyGreen
    SpaceAttri.Style = [fsUnderline]
    SymbolAttri.Foreground = clGray
    TextAttri.Foreground = clRed
    TextAttri.Style = [fsItalic]
    UndefKeyAttri.Background = clYellow
    ValueAttri.Background = clSilver

Das sind die Werte, die meine Klasse übergeben muss.

Delphi-Quellcode:

Procedure TMyForm.CallEventHandler (Event : TAttributEvent; Attribut : TAttributsClass);
Begin
  if Assigned (Event) Then
    Event(Self, Attribut);
end;

Das heisst: im Eventhandler, der diesen Event entgegennimmt, muss ich erstmal die übergebene Instanz identifizieren. Also eigentlich das Gegenstück zu deiner Prozedur CreateEvent schreiben und dann an passender Stelle die Zuweisung machen - pro identifizierter Instanz je einmal. Oder ich kann die 'passende Stelle' in jeweils eine eigene Prozedur auslagern. Das wären dann 9 - 12 Zuweisungsproceduren, gleichviel, wie einzelne Eventhandler nötig wären.
Einzig bei den 'Kanonieren' (die das Event abfeuern) wäre was einzusparen.

Inzwischen habe ich deinen neuen Beitrag mitbekommen, Dejan Vu.

Zitat:

'Case' (oder hier: if/else-Schlangen) sind zwar 'böse', aber in Fabrikmethoden durchaus erlaubt. Denn es ist ja nun kein Mehrwert ggü dem if/else bzw. 'case' (geht hier leider nicht), eine 1:1 Abbildung in eine Liste (oder Dictionary) zu stopfen.

Und damit sprichst du eigentlich genau das an, was mir kürzlich in den Sinn gekommen ist: meine Attributklassen befinden sich alle in einer Objectliste. Es reicht also, diese zu durchlaufen und in einer Prozedur auf die Klasseninstanz zu prüfen.

Zitat:

(Gerade fällt mir auf, dass die Basis-Klasse keinen Destruktor hat ... ts ts ts)

UUps!! - Du meinst sicher meine...

Gruss
Delbor

[Sir Rufo]

Nein, mein TObjectHandler hat keinen, obwohl dort das Dictionary aufgeräumt werden muss.