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

StackOverflow https://stackoverflow.com/questions/6806195

Вопрос

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

Это было полезно?

Решение

Это зависит от того, как вы определяете поддержка действий. Анкет Есть два вида:

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

Действие

У каждого потомка TControl есть собственность действия, которое по умолчанию связано с левой кнопкой мыши нажатия. Этот ссылка на сайт управляется ActionLink. Связь по умолчанию имеет тип tcontrolactionLink, который заботится о синхронизации заголовка, подсказке, включенном состоянии и т. Д. Как о действии, так и о контроле. Если эта базовая функциональность - все, что вы хотите, то просто опубликуйте свойство действия в объявлении типа компонента, и Delphi Framework позаботится обо всех, например Серг а также Lu Rd уже ответил.

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

Предположим, что ваш компонент - это какая -то сетка, которая имеет столбцы, и вы хотите, чтобы в каждом столбце имели свойство действия, которое следует использовать, когда пользователь нажимает на заголовок столбца. Поскольку такие столбцы, вероятно, будут иметь тип tcollectionItem, тип столбца не имеет свойства действия по умолчанию. Итак, вы должны реализовать его самостоятельно. Рассмотрим следующий пример, который связывает заголовок действия с заголовком столбца, связывает подтверждение действия действия, включенное действием обратно с свойством Creamonly столбца и т. Д.

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. по запросу заявки Цель, но только в том случае, если эта цель является целенаправленным управлением Zoomer или иным образом:
  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 Help:

Источник: www.nldelphi.com.

Другие советы

Основная поддержка действий реализована в классе TControl, поэтому в самом простом случае все, что вам нужно сделать, это унаследовать свой компонент от потомка TControl и объявить Action недвижимость, как опубликовано, пример:

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

Если ваш компонент обладает дополнительными свойствами, которые должны быть связаны со свойствами акций, вы также должны переопределить ActionChange метод

Если ваш компонент уже является потомком Tbutton, то поддержка действий наследуется. Все, что вам нужно сделать, это объявить собственность действия как опубликованное.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top