Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

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

AW: Gibt es ein Objekt das eine "Zeile" einer DB kapselt?

  Alt 21. Nov 2013, 02:55
Der Visitor von Uwe hat ein paar Beschränkungen hinsichtlich der Generics (z.B. TList<T> ) oder bei gleichlautenden Klassennamen aus unterschiedlichen Units.

Hier meine Visitor-Interpretation
Delphi-Quellcode:
unit View.Main;

interface

  uses
    Visitor,

    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    Vcl.StdCtrls;

  type
    TMainView = class( TForm )
      Button1 : TButton;
      Edit1 : TEdit;
      Label1 : TLabel;
      Memo1 : TMemo;
      procedure Button1Click( Sender : TObject );
    private
      procedure PrepareVisitor( AVisitor : TVisitor );
    public

    end;

  var
    MainView : TMainView;

implementation

{$R *.dfm}

  procedure TMainView.Button1Click( Sender : TObject );
    var
      LVisitor : TVisitor;
      LIdx : Integer;
    begin
      LVisitor := TVisitor.Create;
      try
        PrepareVisitor( LVisitor );

        for LIdx := 0 to ComponentCount - 1 do
        begin
          LVisitor.Visit( Components[LIdx] );
        end;

      finally
        LVisitor.Free;
      end;
    end;

  procedure TMainView.PrepareVisitor( AVisitor : TVisitor );
    begin
      AVisitor.Clear;

      AVisitor.RegisterType<TButton>(
        procedure( Instance : TButton )
          begin
            Instance.Caption := 'a button';
          end );

      AVisitor.RegisterType<TEdit>(
        procedure( Instance : TEdit )
          begin
            Instance.Text := 'an edit';
          end );

      AVisitor.RegisterType<TLabel>(
        procedure( Instance : TLabel )
          begin
            Instance.Caption := 'a label';
          end );

      AVisitor.RegisterType<TMemo>(
        procedure( Instance : TMemo )
          begin
            Instance.Clear;
            Instance.Lines.Add( 'a memo' );
          end );
    end;

end.
Delphi-Quellcode:
unit Visitor;

interface

  uses
    System.SysUtils,
    System.Generics.Collections;

  type
    IVisitorHandler = interface
      ['{7C5BA846-6286-406A-AC87-3BC89F2E9F21}']
      procedure Visit( const Instance : TObject );
    end;

    IVisitorHandler<T : class> = interface( IVisitorHandler )
    end;

    TVisitor = class
    private
      FVisitorDict : TDictionary<TClass, IVisitorHandler>;
    public
      constructor Create;
      destructor Destroy; override;

      procedure RegisterType<T : class>( AVisitor : IVisitorHandler<T> ); overload;
      procedure RegisterType<T : class>( AVisitor : TProc<T> ); overload;

      procedure Clear;
      procedure Visit( Instance : TObject );
    end;

    TVisitorHandler = class abstract( TInterfacedObject, IVisitorHandler )
    protected
      procedure Visit( const Instance : TObject ); virtual; abstract;
    end;

    TVisitorHandler<T : class> = class abstract( TVisitorHandler, IVisitorHandler<T> )
    end;

    TAnonVisitorHandler<T : class> = class( TVisitorHandler<T> )
    private
      FVisitor : TProc<T>;
    protected
      procedure Visit( const Instance : TObject ); override;
    public
      constructor Create( AVisitor : TProc<T> );
    end;

implementation

    { TVisitor }

  procedure TVisitor.Clear;
    begin
      FVisitorDict.Clear;
    end;

  constructor TVisitor.Create;
    begin
      inherited;
      FVisitorDict := TDictionary<TClass, IVisitorHandler>.Create;
    end;

  destructor TVisitor.Destroy;
    begin
      FVisitorDict.Free;
      inherited;
    end;

  procedure TVisitor.RegisterType<T>( AVisitor : TProc<T> );
    begin
      RegisterType<T>( TAnonVisitorHandler<T>.Create( AVisitor ) );
    end;

  procedure TVisitor.RegisterType<T>( AVisitor : IVisitorHandler<T> );
    begin
      FVisitorDict.AddOrSetValue( T, AVisitor );
    end;

  procedure TVisitor.Visit( Instance : TObject );
    var
      LClass : TClass;
    begin
      LClass := Instance.ClassType;
      while Assigned( LClass ) do
      begin
        if FVisitorDict.ContainsKey( LClass )
        then
        begin
          FVisitorDict[LClass].Visit( Instance );
          Break;
        end;
        LClass := LClass.ClassParent;
      end;
    end;

  { TAnonVisitorHandler<T> }

  constructor TAnonVisitorHandler<T>.Create( AVisitor : TProc<T> );
    begin
      inherited Create;
      FVisitor := AVisitor;
    end;

  procedure TAnonVisitorHandler<T>.Visit( const Instance : TObject );
    begin
      FVisitor( Instance as T );
    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