It depends on how you define action support. There are two types:
- Perhaps a custom Action property of your component that is assigned by the Action component
- The Action component itself.
Action property
Each descendant of TControl has an Action property, the execution of which by default is associated with left-clicking. This link is operated by ActionLink. By default, ActionLink is of type TControlActionLink, which synchronizes labels, tooltips, enable states, etc. Both actions and actions of the control. If this basic functionality is all you need, just publish the Action property in the component type declaration, and the Delphi infrastructure will take care of everything, for example Serg and LU RD have already answered.
If you want your own Action property to be associated with some other condition or event (that is, other than Click), or if you want to implement the Action property for a specific sub-element of your component (which is not a descendant of TControl), then you You can implement your own native Action property by defining and implementing your own ActionLink class.
Suppose your component is some kind of grid in which there are columns, and you want each column to have an action property that should be called when the user clicks on the column heading. Since such columns are probably of type TCollectionItem, the column type does not have an action property by default. Therefore, you must implement it yourself. Consider the following example, which associates an action header with a column heading, refers to an action, an included state back in the readonly property of a column, etc ....:
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.
Please note that this code is only divided into valid parts of the action.
Source: www.nldelphi.com .
Action component
The action component is assigned to the action property of an arbitrary component. But since the explanation of everything related to writing such an action component is quite complete, I will make it easy for myself by providing an example below.
Suppose you want to create a control that provides zoom capabilities, and you also want the corresponding ZoomIn and ZoomOut actions to be assigned to the 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: 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.
Activation of this action (by clicking on a button on the toolbar or by selecting a menu item) calls the ZoomIn procedure in the following priority:
- The Zoomer control that you manually set in the associated action property, if it is done, and if the action is enabled, otherwise:
- when requesting the Target application, but only if this goal is a focused Zoomer control or otherwise:
- active control throughout the application, but only if it is an activated Zoomer control.
Subsequently, the ZoomOut action is simply added:
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;
Please note that component components require registration in the IDE to be able to use their development time.
Applicable food reading in Delphi help:
Source: www.nldelphi.com .