¿Cómo agrego soporte para acciones en mi componente?

Question

¿Qué necesito hacer para agregar soporte de acciones a mi componente? Es un componente de botón, pero supongo que es lo mismo para cualquier tipo de componente que sea. Cualquier información o cómo ayudará.

Answer 1

Eso depende de cómo defines soporte de acción. Hay dos tipos:

• Una propiedad de acción posiblemente personalizada de su componente, que es asignable por un componente de acción
• El componente de acción en sí.

Una propiedad de acción

Cada descendiente de TControl tiene una propiedad de acción que la ejecución está vinculada por defecto a un clic del mouse izquierdo. Este Enlace es administrado por un ActionLink. El ActionLink predeterminado es del tipo TControlactionLink que se encarga de la sincronización de la leyenda, la pista, el estado habilitado, etc. tanto de la acción como de la del control. Si esta funcionalidad base es todo lo que desea, simplemente publique la propiedad de acción en su declaración de tipo de componente y el marco de Delphi se encarga de todo, como Sarg y Lu rd ya respondido.

Si desea que su propia propiedad de acción esté vinculada a alguna otra condición o evento (es decir, que no sea hacer clic), o si desea implementar una propiedad de acción para un sub elemento específico de su componente (que no es un descendiente tcontrol), entonces entonces Puede implementar su propia propiedad de acción personalizada definiendo e implementando una clase de ActionLink personalizada.

Supongamos que su componente es algún tipo de cuadrícula que tiene columnas y desea que cada columna tenga una propiedad de acción que debe invocarse cuando el usuario haga clic en el título de una columna. Dado que es probable que tales columnas sean de un tipo TCollectionItem, el tipo de columna no tiene una propiedad de acción por defecto. Entonces tienes que implementar uno tú mismo. Considere el siguiente ejemplo que vincula el título de la acción con el título de la columna, vincula el estado habilitado de la acción inversamente a la propiedad Readonly de la columna y así sucesivamente ...::

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.

Tenga en cuenta que este código está despojado solo para las piezas de acción aplicables.

^{Fuente: www.nldelphi.com.}

Un componente de acción

Se asigna un componente de acción a la propiedad de acción de un componente arbitrario. Pero dado que explicar todo lo que está involucrado en escribir tal componente de acción es bastante completo, me facilitaré proporcionar el ejemplo a continuación.

Supongamos que desea hacer un control que proporcione capacidades de zoom y que también desea las acciones correspondientes de Zoomin y ZooMout que se pueden asignar a los botones de la barra de herramientas.

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.

Activar esta acción (con un clic en un botón de barra de herramientas, o elegir un elemento de menú) llama en la siguiente prioridad la rutina de zoomin de:

1. El control Zoomer que ha establecido manualmente en la propiedad relacionada de la acción, si se hace, y si la acción está habilitada, de lo contrario:
2. el por la aplicación solicitada Objetivo, pero solo si ese objetivo es un control zoomer enfocado, o de otra manera:
3. El control activo en toda la aplicación, pero solo si ese es un control Zoomer habilitado.

Posteriormente, la acción de zoomout simplemente se agrega:

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;

Tenga en cuenta que los componentes de acción requieren el registro en el IDE para poder usarlos el tiempo de diseño.

Ayuda de lectura aplicable en la ayuda de Delphi:

• Escritura de componentes de acción,
• Cómo las acciones encuentran sus objetivos,
• Registro de acciones,
• Lo que sucede cuando una acción dispara,
• Actualización de acciones,
• Configuración de listas de acción.

^{Fuente: www.nldelphi.com.}

Answer 2

El soporte de acción básica se implementa en la clase TControl, por lo que en el caso más simple, todo lo que tiene que hacer es heredar su componente de TControl Descendente y declarar Action Propiedad publicada, Ej:

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

Si su componente tiene propiedades adicionales que deben vincularse a las propiedades de tacción, también debe anular ActionChange método.

Answer 3

Si su componente ya es descendiente de Tbutton, entonces se hereda el apoyo de acción. Todo lo que necesita hacer es declarar la propiedad de acción como se publica.