我如何添加对组件中动作的支持

Question

我需要做些什么来向我的组件添加动作支持。它是一个按钮组件，但我猜它的任何组件类型都是相同的。任何信息或如何有所帮助。

Answer 1

这取决于您如何定义 行动支持. 。有两种：

• 组件的可能定制的操作属性，该属性可由操作组件分配
• 动作组件本身。

动作属性

每个TCONTROL后代都有一个动作属性，默认情况下执行到左鼠标按钮单击。这个 关联 由ActionLink管理。默认的ActionLink是类型的TcontrolactionLink，该类型会照顾标题的同步，提示，启用状态等...既是操作和控件的同步。如果此基础功能是您想要的，那么只需在您的组件类型声明中发布操作属性，而Delphi框架则像 塞尔格 和 Lu Rd 已经回答了。

如果您希望自己的行动属性链接到其他条件或事件（即单击除外），或者要为组件的特定子元素（不是TCONTROL后代）实现操作属性，则您可以通过定义和实施自定义ActionLink类来实现自己的自定义动作属性。

假设您的组件是具有列的某种网格，您希望每列具有一个动作属性，当用户单击列的标题时，应调用该属性。由于此类列可能是TcollectionItem类型的，因此列列默认情况下没有操作属性。因此，您必须自己实施一个。考虑下一个示例将操作的标题链接到列的标题，将启用该操作的状态成反与列的ReadOnly属性链接...：

unit Unit1;

interface

uses
  Classes, ActnList, SysUtils;

type
  TColumn = class;

  TColumnActionLink = class(TActionLink)
  protected
    FClient: TColumn;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: Boolean; override;
    function IsEnabledLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    function IsVisibleLinked: Boolean; override;
    procedure SetCaption(const Value: String); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
    procedure SetVisible(Value: Boolean); override;
  end;

  TColumnActionLinkClass = class of TColumnActionLink;

  TColumn = class(TCollectionItem)
  private
    FActionLink: TColumnActionLink;
    FGrid: TComponent;
    FOnTitleClick: TNotifyEvent;
    FReadOnly: Boolean;
    FTitle: String;
    FVisible: Boolean;
    function DefaultTitleCaption: String;
    procedure DoActionChange(Sender: TObject);
    function GetAction: TBasicAction;
    function IsOnTitleClickStored: Boolean;
    function IsReadOnlyStored: Boolean;
    function IsVisibleStored: Boolean;
    procedure SetAction(Value: TBasicAction);
  protected
    procedure ActionChanged(Sender: TObject; CheckDefaults: Boolean); dynamic;
    procedure DoTitleClick; virtual;
    function GetActionLinkClass: TColumnActionLinkClass; virtual;
    property ActionLink: TColumnActionLink read FActionLink write FActionLink;
  public
    destructor Destroy; override;
    procedure InitiateAction; virtual;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property OnTitleClick: TNotifyEvent read FOnTitleClick write FOnTitleClick
      stored IsOnTitleClickStored;
    property ReadOnly: Boolean read FReadOnly write FReadOnly
      stored IsReadOnlyStored;
    property Title: String read FTitle write FTitle;
    property Visible: Boolean read FVisible write FVisible
      stored IsVisibleStored;
  end;

implementation

{ TColumnActionLink }

procedure TColumnActionLink.AssignClient(AClient: TObject);
begin
  FClient := TColumn(AClient);
end;

function TColumnActionLink.IsCaptionLinked: Boolean;
begin
  Result := inherited IsCaptionLinked and (Action is TCustomAction) and
    (FClient.Title = TCustomAction(Action).Caption);
end;

function TColumnActionLink.IsEnabledLinked: Boolean;
begin
  Result := inherited IsEnabledLinked and (Action is TCustomAction) and
    (FClient.ReadOnly <> TCustomAction(Action).Enabled);
end;

function TColumnActionLink.IsOnExecuteLinked: Boolean;
begin
  Result := inherited IsOnExecuteLinked and
    (@FClient.OnTitleClick = @Action.OnExecute);
end;

function TColumnActionLink.IsVisibleLinked: Boolean;
begin
  Result := inherited IsVisibleLinked and (Action is TCustomAction) and
    (FClient.Visible = TCustomAction(Action).Visible);
end;

procedure TColumnActionLink.SetCaption(const Value: string);
begin
  if IsCaptionLinked then
    FClient.Title := Value;
end;

procedure TColumnActionLink.SetEnabled(Value: Boolean);
begin
  if IsEnabledLinked then
    FClient.ReadOnly := not Value;
end;

procedure TColumnActionLink.SetOnExecute(Value: TNotifyEvent);
begin
  if IsOnExecuteLinked then
    FClient.OnTitleClick := Value;
end;

procedure TColumnActionLink.SetVisible(Value: Boolean);
begin
  if IsVisibleLinked then
    FClient.Visible := Value;
end;

{ TColumn }

procedure TColumn.ActionChanged(Sender: TObject; CheckDefaults: Boolean);
begin
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults or (Caption = DefaultTitleCaption) then
        FTitle := Caption;
      if not CheckDefaults or (not ReadOnly) then
        ReadOnly := not Enabled;
      if not CheckDefaults or not Assigned(FOnTitleClick) then
        FOnTitleClick := OnExecute;
      if not CheckDefaults or (Self.Visible = True) then
        Self.Visible := Visible;
      Changed(False);
    end;
end;

function TColumn.DefaultTitleCaption: String;
begin
  Result := 'Column' + IntToStr(Index);
end;

destructor TColumn.Destroy;
begin
  FreeAndNil(FActionLink);
  inherited Destroy;
end;

procedure TColumn.DoActionChange(Sender: TObject);
begin
  if Sender = Action then
    ActionChanged(Sender, False);
end;

procedure TColumn.DoTitleClick;
begin
  if Assigned(FOnTitleClick) then
    if (Action <> nil) and (@FOnTitleClick <> @Action.OnExecute) then
      FOnTitleClick(Self)
    else if FActionLink = nil then
      FOnTitleClick(Self)
    else if FActionLink <> nil then
      if (FGrid <> nil) and not (csDesigning in FGrid.ComponentState) then
      begin
        if not FActionLink.Execute(FGrid) then
          FOnTitleClick(Self);
      end
      else
        if not FActionLink.Execute(nil) then
          FOnTitleClick(Self);
end;

function TColumn.GetAction: TBasicAction;
begin
  if FActionLink <> nil then
    Result := FActionLink.Action
  else
    Result := nil;
end;

function TColumn.GetActionLinkClass: TColumnActionLinkClass;
begin
  Result := TColumnActionLink;
end;

procedure TColumn.InitiateAction;
begin
  if FActionLink <> nil then
    FActionLink.Update;
end;

function TColumn.IsOnTitleClickStored: Boolean;
begin
  Result := (FActionLink = nil) or not ActionLink.IsOnExecuteLinked;
end;

function TColumn.IsReadOnlyStored: Boolean;
begin
  Result := (FActionLink = nil) or not FActionLink.IsEnabledLinked;
  if Result then
    Result := FReadOnly;
end;

function TColumn.IsVisibleStored: Boolean;
begin
  Result := (FActionLink = nil) or not FActionLink.IsVisibleLinked;
  if Result then
    Result := not Visible;
end;

procedure TColumn.SetAction(Value: TBasicAction);
begin
  if Value = nil then
    FreeAndNil(FActionLink)
  else
  begin
    if FActionLink = nil then
      FActionLink := GetActionLinkClass.Create(Self);
    FActionLink.Action := Value;
    FActionLink.OnChange := DoActionChange;
    ActionChanged(Value, csLoading in Value.ComponentState);
    if FGrid <> nil then
      Value.FreeNotification(FGrid);
  end;
  Changed(False);
end;

end.

请注意，此代码仅将其剥离到适用的操作零件。

^{资源： www.nldelphi.com.}

动作组件

操作组件可分配给任意组件的操作属性。但是，由于解释撰写这样的动作组成部分所涉及的所有内容都是非常全面的，因此我将在提供下面的示例时使自己变得容易。

假设您要制作一个提供缩放功能的控件，并且还希望可以分配给工具栏按钮的相应的Zoomin和Zoomout操作。

unit Zoomer;

interface

uses
  Classes, Controls, ActnList, Forms, Menus, Windows;

type
  TZoomer = class;

  TZoomAction = class(TCustomAction)
  private
    FZoomer: TZoomer;
    procedure SetZoomer(Value: TZoomer);
  protected
    function GetZoomer(Target: TObject): TZoomer;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    destructor Destroy; override;
    function HandlesTarget(Target: TObject): Boolean; override;
    procedure UpdateTarget(Target: TObject); override;
  published
    property Caption;
    property Enabled;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property OnExecute; { This property could be omitted. But if you want to be
                          able to override the default behavior of this action
                          (zooming in on a TZoomer component), then you need to
                          assign this event. From within the event handler
                          you could invoke the default behavior manually. }
    property OnHint;
    property OnUpdate;
    property Zoomer: TZoomer read FZoomer write SetZoomer;
  end;

  TZoomInAction = class(TZoomAction)
  public
    constructor Create(AOwner: TComponent); override;
    procedure ExecuteTarget(Target: TObject); override;
  end;

  TZoomer = class(TCustomControl)
  public
    procedure ZoomIn;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('RoyMKlever', [TZoomer]);
  RegisterActions('Zoomer', [TZoomInAction], nil);
end;

{ TZoomAction }

destructor TZoomAction.Destroy;
begin
  if FZoomer <> nil then
    FZoomer.RemoveFreeNotification(Self);
  inherited Destroy;
end;

function TZoomAction.GetZoomer(Target: TObject): TZoomer;
begin
  if FZoomer <> nil then
    Result := FZoomer
  else if (Target is TZoomer) and TZoomer(Target).Focused then
    Result := TZoomer(Target)
  else if Screen.ActiveControl is TZoomer then
    Result := TZoomer(Screen.ActiveControl)
  else
    { This should not happen! HandlesTarget is called before ExecuteTarget,
      or the action is disabled }
    Result := nil;
end;

function TZoomAction.HandlesTarget(Target: TObject): Boolean;
begin
  Result := ((FZoomer <> nil) and FZoomer.Enabled) or
    ((FZoomer = nil) and (Target is TZoomer) and TZoomer(Target).Focused) or
    ((Screen.ActiveControl is TZoomer) and Screen.ActiveControl.Enabled);
end;

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

procedure TZoomAction.SetZoomer(Value: TZoomer);
begin
  if FZoomer <> Value then
  begin
    if FZoomer <> nil then
      FZoomer.RemoveFreeNotification(Self);
    FZoomer := Value;
    if FZoomer <> nil then
      FZoomer.FreeNotification(Self);
  end;
end;

procedure TZoomAction.UpdateTarget(Target: TObject);
begin
  Enabled := HandlesTarget(Target);
end;

{ TZoomInAction }

constructor TZoomInAction.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := 'Zoom in';
  Hint := 'Zoom in|Zooms in on the selected zoomer control';
  ShortCut := Menus.ShortCut(VK_ADD, [ssCtrl]);
end;

procedure TZoomInAction.ExecuteTarget(Target: TObject);
begin
  GetZoomer(Target).ZoomIn;
  { For safety, you cóuld check if GetZoomer <> nil. See remark in GetZoomer. }
end;

{ TZoomer }

procedure TZoomer.ZoomIn;
begin
  { implementation of zooming in }
end;

end.

激活此操作（单击工具栏按钮或选择菜单项）在以下优先级呼叫Zoomin例程：

1. 您手动在操作的属性中手动设置的Zoomer控件，如果是这样做的，如果启用了该操作，否则：否则：
2. 由请求的申请 目标, ，但前提是该目标是重点的变焦控制，或者其他情况：
3. 整个应用程序中的活动控件，但前提是启用Zoomer控件。

随后，简单地添加了缩放操作：

type
  TZoomOutAction = class(TZoomAction)
  public
    constructor Create(AOwner: TComponent); override;
    procedure ExecuteTarget(Target: TObject); override;
  end;

{ TZoomOutAction }

constructor TZoomOutAction.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := 'Zoom out';
  Hint := 'Zoom out|Zooms out on the selected zoomer control';
  ShortCut := Menus.ShortCut(VK_SUBTRACT, [ssCtrl]);
end;

procedure TZoomOutAction.ExecuteTarget(Target: TObject);
begin
  GetZoomer(Target).ZoomOut;
end;

请注意，操作组件需要在IDE中注册，以便能够使用它们的设计时间。

适用在Delphi帮助中阅读食物：

• 编写动作组件,
• 行动如何找到目标,
• 注册动作,
• 动作开火时会发生什么,
• 更新操作,
• 设置操作列表.

^{资源： www.nldelphi.com.}

Answer 2

基本动作支持是在Tcontrol类中实现的，因此在最简单的情况下，您要做的就是从TCONTROL后代继承您的组件并声明 Action 出版的财产，例如：

type
  TMyGraphicControl = class(TGraphicControl)
  published
    property Action;
  end;

如果您的组件具有应链接到Taction属性的其他属性，则还应覆盖 ActionChange 方法。

Answer 3

如果您的组件已经是tbutton的后代，则继承了动作支持。您需要做的就是将行动属性声明为发布。