[Delphi] GetClass与RegisterClass的应用一例

利用GetClass与RegisterClass可以实现根据字符串来实例化具体的子类，这对于某些需要动态配置程序的场合是很有用的。其他的应用如子窗体切换，算法替换等都能得到应用。

unit Example1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1  =  class(TForm)
    Button1: TButton;
     procedure  Button1Click(Sender: TObject);
  private
  public
   end ;

  ILog  =  interface(IUnknown)
    [ ' {A65044FC-644C-482A-BBFF-50A618835FC6} ' ]
     procedure  WriteMessage;
   end ;

  TLog  =  class(TInterfacedPersistent, ILog)
  public
    class  function  CreateInstance(Name: string): TLog; overload;
     procedure  WriteMessage; virtual; abstract;
   end ;

  TTextLog  =  class(TLog)
  public
     procedure  WriteMessage; override;
   end ;

  TXMLLog  =  class(TLog)
  public
     procedure  WriteMessage; override;
   end ;

  TNullLog  =  class(TLog)
  public
     procedure  WriteMessage; override;
   end ;

var
  Form1: TForm1;

implementation

{ $R *.dfm }

procedure  TForm1.Button1Click(Sender: TObject);
var
  Log: TLog;
begin
   {  实际应用中可以从配置中读取字符串来决定实例化具体的子类  }
  Log : =  TLog.CreateInstance( ' TXMLLog ' );
   if  Assigned(Log)  then
   begin
    Log.WriteMessage;
    Log.Free;
   end ;
end ;

class  function  TLog.CreateInstance(Name: string): TLog;
var
  AClass: TPersistentClass;
begin
  Result : =   nil ;
  AClass : =  GetClass(Name);
   if  Assigned(AClass)  then
   begin
    Result : =  AClass.NewInstance as TLog;
    Result.Create;
   end
   else
     {  error handle  }
end ;

{  TTextLog  }

procedure  TTextLog.WriteMessage;
begin
   // 写入到文本文件
end ;

{  TXMLLog  }

procedure  TXMLLog.WriteMessage;
begin
   // 写入到XML文件
end ;

{  TNullLog  }

procedure  TNullLog.WriteMessage;
begin
   {  nothing need to do  }
end ;

initialization
  RegisterClass(TTextLog);
  RegisterClass(TXMLLog);
  RegisterClass(TNullLog);

finalization
  UnRegisterClass(TTextLog);
  UnRegisterClass(TXMLLog);
  UnRegisterClass(TNullLog);

end .