Ответ 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
GroupDescendantsWith(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
GroupDescendantsWith(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 Form Designer вы увидите только
TMyComponentUIControl_VCLPageControl
доступно в палитре инструментов.
В конструкторе форм FMX вы увидите только TMyComponentUIControl_FMXTabControl
, доступный в палитре инструментов.
В конструкторе DataModule вы не увидите ни одного адаптера, если не установите свойство TDataModule.ClassGroup
для группы VCL или FMX. Затем вы увидите соответствующий адаптер, доступный в палитре инструментов.