Как добавить поддержку действий в моем компоненте

Question

Что мне нужно сделать для добавления поддержки действий в мой компонент. Это компонент кнопки, но я думаю, он одинаков для любого типа компонента. Любая информация или как поможет.

Answer 1

Это зависит от того, как вы определяете поддержку действий. Существует два вида:

• Возможно настраиваемое свойство Action вашего компонента, которое может быть назначено компонентом Action
• Сам компонент Action.

Свойство действия

Каждый потомок TControl имеет свойство Action, выполнение которого по умолчанию связано с щелчком левой кнопки мыши. Эта ссылка управляется ActionLink. ActionLink по умолчанию имеет тип TControlActionLink, который заботится о синхронизации заголовка, подсказки, включенного состояния и т. Д. Как действия, так и элемента управления. Если эта базовая функциональность - это все, что вам нужно, просто опубликуйте свойство Action в объявлении типа вашего компонента, а среда Delphi позаботится обо всем, как уже отвечали Serg и LU RD.

Если вы хотите, чтобы ваше собственное свойство Action было связано с каким-либо другим условием или событием (т.е. отличным от Click), или если вы хотите реализовать свойство Action для определенного подэлемента вашего компонента (который не является потомком TControl), тогда Вы можете реализовать собственное свойство Action, определив и реализовав собственный класс ActionLink.

Предположим, что ваш компонент представляет собой какую-то сетку со столбцами, и вы хотите, чтобы у каждого столбца было свойство action, которое должно вызываться, когда пользователь щелкает заголовок столбца. Поскольку такие столбцы, вероятно, относятся к типу TCollectionItem, тип столбца по умолчанию не имеет свойства action. Таким образом, вы должны реализовать один самостоятельно. Рассмотрим следующий пример, который связывает заголовок действия с заголовком столбца, обратно связывает включенное состояние действия обратно со свойством столбца только для чтения и так далее...:

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.}

Компонент действия

Компонент action назначается свойству action произвольного компонента. Но поскольку объяснение всего, что связано с написанием такого компонента действия, является довольно всеобъемлющим, я облегчу для себя приведение примера ниже.

Предположим, вы хотите создать элемент управления, который предоставляет возможности масштабирования, а также вам нужны соответствующие действия 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. приложением запрошенная цель, но только если эта цель является целевым элементом управления Zoomer или иным образом:
3. активный элемент управления во всем приложении, но только если это активированный элемент управления Zoomer.

Впоследствии, действие ZoomOut просто добавляется:

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, то поддержка действий наследуется. Все, что вам нужно сделать, это объявить свойство действия как опубликованное.