Как добавить поддержку действий в моем компоненте
-
25-10-2019 - |
Вопрос
Что мне нужно сделать для добавления действий в поддержку моего компонента. Это компонент кнопки, но я думаю, что он тот же для любого типа компонента. Любая информация или как поможет.
Решение
Это зависит от того, как вы определяете поддержка действий. Анкет Есть два вида:
- Возможно, настраиваемое свойство действия вашего компонента, которое можно назначить компонентом действия
- Сам компонент действия.
Действие
У каждого потомка 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:
- Управление Zoomer, которое вы вручную установили в свой свойство действию, если это сделано, и если действие включено, в противном случае:
- по запросу заявки Цель, но только в том случае, если эта цель является целенаправленным управлением Zoomer или иным образом:
- Активный элемент управления во всем приложении, но только в том случае, если это включенное управление 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, то поддержка действий наследуется. Все, что вам нужно сделать, это объявить собственность действия как опубликованное.