基于 RTTI 的 TFrame 的创建和管理

缘由

在大型的 Delphi 程序开发中，界面会有非常多不一样的窗口。最原始的设计方式是在一个 Form 里面，堆叠一大堆的 Panel，每个 Panel 上摆放不同的控件。运行期需要显示什么界面，就让对应的 Panel 显示出来。这样做的问题是，设计期所有的界面元素都堆在一个窗口里面，控件太多互相覆盖，完全没法通过可视化的拖拉来摆放控件达到想要的视觉效果。

好一点的办法是每个界面开一个 TForm（对应运行期就是一个 Form 窗口），每个 Form 里面设计一个界面。需要换界面就显示不同的 Form。这样也符合【模块化】设计的模式。

上述做法的问题是：

A. Form 占用比较多的资源。几百个 Form 消耗的资源比较多。

B. 现在流行单窗口显示，仅仅是在一个 Form 里面换界面，而不是弹窗式的多窗口显示。单窗口显示的有点是避免了应用程序弹出一大堆窗口，用户失去当前操作焦点的问题。

解决上述问题的办法：

使用 TFrame 作为界面设计的容器。在 Frame 上面摆放视觉控件。一个 Frame 就是一个界面模块。

这样一来，程序就变成了有一个主窗体，这里我把它叫做 Form1，在这个 Form1 里面，按照当前用户操作需要，显示不同的 Frame1，Frame2...

更进一步的问题

问题来了，大型程序如果有几百个 Frame，那这个 Form1 所在的单元 Unit1 就需要引用（Delphi 的语法：uses）这几百个 Frame 的单元的名字。光那个 uses 后面的单元名字就一大堆，而且，有了这样的引用，一旦那个单元不在当前的工程项目里面（可能中途做了修改或者删除），就会连编译都通不过。总之就是管理起来很麻烦。

针对上述问题的一种解决方案

目标：

针对几百上千个代表不同界面的 Frame，呈现这些 Frame 模块的主 Form 不需要引用所有的 Frame 对应的单元文件。也不需要知道每个 Frame 的类型比如 TFrame1, TFrame2...等等。代码只需要使用每个 Frame 的类型名称的字符串，就可以把这个 Frame 显示到界面上。即便这个 Frame 已经不存在，也不会编译或者运行出错，仅仅是不能显示出来而已。

实现方式

1. 采用 Delphi 的 RTTI，可以通过类或者对象的方法的字符串名称，获得该方法的指针，并调用该方法。因此，我们就可以在没有引用这个 TFrame1 的情况下，调用它的 Create 方法。

2. 每个 TFrame1, TFrame2 都注册类型。这样就可以通过 FindClass 函数获得它的类类型。

3. 可能有一些 Frame 在程序里需要同时显示多个不同的实例，因此，需要使用一个 List 把它管理起来。因为相同类型的多个不同实例的对象需要有不同的对象名字，所以可以用名字作为索引来管理。因此这里可以使用 TDictionary 来管理。

代码如下

unit UFrameFactory;
{--------------------------------------------------------------------------
  使用 RTTI，输入 Frame 的字符串名字和 Parent，把它显示到 Parent 上面。
  1. Frame 必须在自己的单元的初始化部分 initialization 里面 RegisterClass 自己的类。
  2. 返回这个 Frame 的实例；
  3. 如果一个 Frame 需要同时有多个实例，用 TDictionary 管理。

  关于 TDictionary 管理这些 Frame 需要实现的功能：
  1. 对象缓冲，如果已经创建，下次需要，直接取出来，不用再次创建；
  2. 同一个 TFrame 多实例：如果需要同时两个，需要能够保存两个，使用名称来区别？可以给不同的 Tag 值来区别；
  3. 生命周期管理 -- Frame 创建时给它的 Owner 赋值 Application，最终由 Application 来管理。


  pcplayer 2024-5-13
-----------------------------------------------------------------------------}
interface

uses  System.SysUtils, System.Variants, System.Classes, System.Generics.Collections,
  Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, RTTI;



type
  TFrameManager = class
  private
    FList: TDictionary<string, TFrame>;

    class var FFrameManager: TFrameManager;

    function FindFrame(const FrameName, FrameTypeName: string): TFrame;
    function TheSameType(const AFrame: TFrame; const FrameTypeName: string): Boolean;
    class function GetFrameManager: TFrameManager; static;
  public
    constructor Create;
    destructor Destroy;

    function ShowFrame(const AParent: TWinControl; const FrameName, FrameTypeName: string): TFrame;
    procedure ReleaseFrame(const FrameName: string);

    class property FrameManager: TFrameManager read GetFrameManager;
  end;

function CreateShowFrame(const AParent: TWinControl; const FrameName: string): TFrame;

implementation


function CreateShowFrame(const AParent: TWinControl; const FrameName: string): TFrame;
var
  Ctx: TRttiContext;
  AType: TRttiType;
  AMethod: TRttiMethod;
  AValue: TValue;

  AClass: TClass;
begin
  //使用 RTTI，不需要引用该类所在单元，仅仅用类的字符串名称就可以。
  Result := nil;
  AClass := FindClass(FrameName);

  //其实，这里因为我们是只针对 TFrame 的，这里可以直接类型转换 AClass 为 TFrame 然后调用 TFrame.Create
  //而无需使用 RTTI 去查 Create 方法的指针。
  {
  if not (AClass is TFrame) then Exit;
  Result := TFrame(AClass).Create(Application);

  }

  Ctx := TRttiContext.Create;
  try
    AType := Ctx.GetType(AClass);
    if not Assigned(AType) then Exit;


    AMethod := AType.GetMethod('Create');
    if not Assigned(AMethod) then Exit;

    AValue := AMethod.Invoke(AClass, [Application]);

    if AValue.IsObject then
    begin
      if not (AValue.AsObject is TFrame) then Exit;

      Result := TFrame(AValue.AsObject);
      Result.Parent := AParent;
      Result.Align := alClient;
      Result.BringToFront;
    end;
  finally
    Ctx.Free;
  end;
end;

{ TFrameManager }

constructor TFrameManager.Create;
begin
  FList := TDictionary<string, TFrame>.Create;
end;

destructor TFrameManager.Destroy;
begin
  FList.Free;
end;

function TFrameManager.FindFrame(const FrameName,
  FrameTypeName: string): TFrame;
var
  AFrame: TFrame;
begin
  Result := nil;

  if Self.FList.ContainsKey(FrameName) then
  begin
    if not Self.FList.TryGetValue(FrameName, AFrame) then Exit;
    if Self.TheSameType(AFrame, FrameTypeName) then Result := AFrame;
  end;
end;


class function TFrameManager.GetFrameManager: TFrameManager;
begin
  Result := FFrameManager;
end;

procedure TFrameManager.ReleaseFrame(const FrameName: string);
var
  AFrame: TFrame;
begin
  if Self.FList.TryGetValue(FrameName, AFrame) then
  begin
    FreeAndNil(AFrame);
  end;
end;

function TFrameManager.ShowFrame(const AParent: TWinControl; const FrameName,
  FrameTypeName: string): TFrame;
begin
  Result := Self.FindFrame(FrameName, FrameTypeName);
  if not Assigned(Result) then
  begin
    if Self.FList.ContainsKey(FrameName) then
    begin
      raise Exception.Create('同名但不同类型的Frame已经存在！');
    end;

    Result := CreateShowFrame(AParent, FrameTypeName);
    Result.Name := FrameName;
    Self.FList.Add(FrameName, Result);
  end;

  with Result do
  begin
    Parent := AParent;
    Align := alClient;
    BringToFront;
  end;
end;

function TFrameManager.TheSameType(const AFrame: TFrame;
  const FrameTypeName: string): Boolean;
var
  AClass: TClass;
begin
  Result := False;

  AClass := FindClass(FrameTypeName);
  Result := (AFrame is AClass);
end;

initialization
  TFrameManager.FFrameManager := TFrameManager.Create;

finalization
  TFrameManager.FFrameManager.Free;

end.

如何使用

在设计期，我们可以创建很多不同的 Frame。在主窗体（Form1）里面，需要显示某个 Frame 的地方，调用它的代码很简单，只需要一行代码就搞定：

procedure TForm1.Button4Click(Sender: TObject);
begin
  TFrameManager.FrameManager.ShowFrame(Panel3, 'Frame1A', 'TFrame1');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  TFrameManager.FrameManager.ShowFrame(Panel4, 'Frame1B', 'TFrame1');
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  TFrameManager.FrameManager.ShowFrame(Panel5, 'Frame2A', 'TFrame2');
end;

上面的代码演示了：

1. TFrame1 并排显示了2个实例。

2. TFrame2 显示了一个实例。

总结一下

1. 通过上述方式，可以简化大型应用程序的代码，减少出错机会。

2. 其实用不着 RTTI，虽然我的代码里面使用了 RTTI。