如何使单个组件同时支持 VCL 和 FMX？

Question

我有一个TComponent，它控制着一些用户界面。该组件旨在通过使用条件来支持 VCL 和 Firemonkey。这样的条件指示我的组件是接受 VCL 控件还是 FMX 控件。目前预计此条件在应用程序级别定义，以在运行时指示组件是管理 VCL 还是 FMX 控件。

我想将我的组件发布到支持 VCL 和 FMX 的 IDE 中，并与条件共享相同的单元。但是，根据当前使用的是 VCL 还是 FMX，属性名称/类型会有所不同。

例如...

type
  TMyComponent = class(TComponent)
  published
    {$IFDEF USE_FMX}
    property TabControl: TTabControl read FTabControl write SetTabControl;
    {$ENDIF}
    {$IFDEF USE_VCL}
    property PageControl: TPageControl read FPageControl write SetPageControl;
    {$ENDIF}
  end;

我的目标是能够将此非可视组件拖放到 VCL 或 FMX 表单上，并在对象检查器中自动显示适当的特定于框架的属性。

如何注册这个通过条件句共享 VCL 和 FMX 代码的组件？

Answer 1

我强烈建议反对像您尝试那样创建特定于框架的属性。我建议改为创建单独的特定于框架的适配器组件，然后您可以根据需要将这些适配器之一分配给您的主要组件，例如：

unit MyComponentUI;

interface

uses
  Classes;

type
  TMyComponentUIControl = class(TComponent)
  public
    procedure DoSomethingWithControl; virtual; abstract;
    ...
  end;

implementation

...

end.

unit MyComponentFmxUI;

uses
  MyComponentUI,
  FMX.TabControl;

type
  TMyComponentUIControl_FMXTabControl = class(TMyComponentUIControl)
  private
    FTabControl: TTabControl;
    procedure SetTabControl(Value: TTabControl);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure DoSomethingWithControl; override;
  published
    property TabControl: TTabControl read FTabControl write SetTabControl;
  end;

procedure Register;

implementation

uses
  FMX.Controls;

procedure TMyComponentUIControl_FMXTabControl.DoSomethingWithControl; 
begin
  if FTabControl <> nil then
  begin
    ...
  end;
end;

procedure TMyComponentUIControl_FMXTabControl.SetTabControl(Value: TTabControl);
begin
  if FTabControl <> Value then
  begin
    if FTabControl <> nil then FTabControl.RemoveFreeNotification(Self);
    FTabControl := Value;
    if FTabControl <> nil then FTabControl.FreeNotification(Self);
  end;
end;

procedure TMyComponentUIControl_FMXTabControl.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FTabControl) then
    FTabControl := nil;
end;

procedure Register;
begin
  GroupDescendentsWith(TMyComponentUIControl_FMXTabControl, TControl);
  RegisterComponents('My Component', [TMyComponentUIControl_FMXTabControl]);
end;

end.

unit MyComponentVclUI;

interface

uses
  MyComponentUI,
  Vcl.ComCtrls;

type
  TMyComponentUIControl_VCLPageControl = class(TMyComponentUIControl)
  private
    FPageControl: TPageControl;
    procedue SetPageControl(Value: TPageControl);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure DoSomethingWithControl; override;
  published
    property PageControl: TPageControl read FPageControl write SetPageControl;
  end;

procedure Register;

implementation

uses
  Vcl.Controls;

procedure TMyComponentUIControl_VCLPageControl.DoSomethingWithControl; 
begin
  if FPageControl <> nil then
  begin
    ...
  end;
end;

procedure TMyComponentUIControl_VCLPageControl.SetPageControl(Value: TPageControl);
begin
  if FPageControl <> Value then
  begin
    if FPageControl <> nil then FPageControl.RemoveFreeNotification(Self);
    FPageControl := Value;
    if FPageControl <> nil then FPageControl.FreeNotification(Self);
  end;
end;

procedure TMyComponentUIControl_VCLPageControl.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FPageControl) then
    FPageControl := nil;
end;

procedure Register;
begin
  GroupDescendentsWith(TMyComponentUIControl_VCLPageControl, TControl);
  RegisterComponents('My Component', [TMyComponentUIControl_VCLPageControl]);
end;

end.

unit MyComponent;

interface

uses
  Classes,
  MyComponentUI;

type
  TMyComponent = class(TComponent)
  private
    FUIControl: TMyComponentUIControl;
    procedure SetUIControl(Value: TMyComponentUIControl);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure DoSomething;
  published
    property UIControl: TMyComponentUIControl read FUIControl write SetUIControl;
  end;

procedure Register;

implementation

procedure TMyComponent.DoSomething;
begin
  ...
  if FUIControl <> nil then
    FUIControl.DoSomethingWithControl;
  ...
end;

procedure TMyComponent.SetUIControl(Value: TMyComponentUIControl);
begin
  if FUIControl <> Value then
  begin
    if FUIControl <> nil then FUIControl.RemoveFreeNotification(Self);
    FUIControl := Value;
    if FUIControl <> nil then FUIControl.FreeNotification(Self);
  end;
end;

procedure TMyComponent.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FUIControl) then
    FUIControl := nil;
end;

procedure Register;
begin
  RegisterComponents('My Component', [TMyComponent]);
end;

end.

通过使用GroupDescendentsWith() 将每个适配器与FMX.Controls.TControl 或Vcl.Controls.TControl 分组，这允许IDE 在设计时根据父项目中使用的框架过滤组件：

在 VCL 表单设计器上，您只会看到 TMyComponentUIControl_VCLPageControl 在工具面板中可用。

在 FMX 表单设计器中，您只会看到工具面板中的 TMyComponentUIControl_FMXTabControl。

在 DataModule Designer 上，您将看不到任何一个适配器，除非您将 TDataModule.ClassGroup 属性设置为 VCL 或 FMX 组。然后您将在工具面板中看到相应的适配器。