delphi - How do I add support for actions in my component

Question

What do I need to do for adding actions support to my component. It is a button component but I guess it is the same for whatever component type it is. Any information or how to will help.

Answer 1

That depends on how you define action support. There is two kinds:

• A possibly customized Action property of your component, which is assignable by an Action component
• The Action component itself.

An action property

Every TControl descendant has an Action property which execution is by default linked to a left mouse button click. This link is managed by an ActionLink. The default ActionLink is of the type TControlActionLink which takes care of the synchronization of the caption, the hint, the enabled state, etc... of both the Action and that of the Control. If this basis functionality is all that you want, then simply publish the Action property in your component type declaration and the Delphi framework takes care of all, like Serg and LU RD already answered.

If you want your own Action property to be linked to some other condition or event (i.e. other than Click), or if you want to implement an Action property for a specific sub element of your component (that is not a TControl descendant), then you can implement your own custom Action property by defining and implementing a custom ActionLink class.

Suppose your component is some kind of grid which has columns and you want every column to have an action property that should be invoked when the user clicks the title of a column. Since such columns are likely to be of a TCollectionItem type, the column type does not have an action property by default. So you have to implement one yourself. Consider the next example which links the action's caption to the column's title, links the action's enabled state inversely to the column's readonly property and so on...:

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.

Note that this code is stripped to only the applicable action parts.

^{Source: www.nldelphi.com.}

An action component

An action component is assignable to the action property of an arbitrary component. But since explaining all that is involved with writing such an action component is pretty comprehensive, I will make it easy for myself in providing the example below.

Suppose you want to make a control that provides zoom capabilities and that you also want the corresponding ZoomIn and ZoomOut actions that can be assigned to toolbar buttons.

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: TZoome