Search code examples
delphifiremonkeyvcl

How to make a single component support both VCL and FMX?


I have a TComponent which controls some of the UI. This component is designed to support both VCL and Firemonkey by using conditionals. Such conditionals instruct my component whether to accept a VCL control or an FMX control. It's currently expected that this conditional is defined on the application level to instruct the component in run-time whether it's to manage a VCL or FMX control.

I'd like to publish my component into the IDE with support for both VCL and FMX, sharing the same unit with conditionals. However, depending on whether VCL or FMX is currently in use, the property names/types differ.

For example...

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;

My goal is to be able to drop this non-visual component onto either a VCL or FMX form, and automatically show the appropriate framework-specific properties in the object inspector.

How do I go about registering this component which shares both VCL and FMX code via conditionals?


Solution

  • I would strongly advise against creating framework-specific properties like you are trying to do. I would suggest instead creating separate framework-specific adapter components, and then you can assign one of those adapters to your main component as needed, eg:

    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.
    

    By using GroupDescendentsWith() to group each adapter with either FMX.Controls.TControl or Vcl.Controls.TControl, this allows the IDE to filter the components at design-time based on framework used in the parent project:

    On a VCL Form Designer, you will see only TMyComponentUIControl_VCLPageControl available in the Tool Palette.

    On a FMX Form Designer, you will see only TMyComponentUIControl_FMXTabControl available in the Tool Palette.

    On a DataModule Designer, you will not see either adapter, unless you set the TDataModule.ClassGroup property to a VCL or FMX group. Then you will see the appropriate adapter available in the Tool Palette.