运行时分配操作的快捷方式不会在自定义组件中触发

Posted 2023-03-17

技术标签:

【中文标题】运行时分配操作的快捷方式不会在自定义组件中触发【英文标题】：Runtime assigned action's ShortCut does not fire in custom component 【发布时间】：2015-01-19 03:37:10 【问题描述】：

当代码完全在运行时创建时（即没有表单设计器组件），我无法让分配给自定义组件继承的 Action 属性的 Action 工作。如果我在表单设计器中使用 ActionList，然后使用相同的代码，则一切正常。

这是我从TCustomControl 派生的组件的构造函数：

  self.FButtonSCActionList := TActionList.Create( self.Parent );
  self.FButtonSCActionList.Name := 'ButtonSCActionList';
  self.FButtonSCAction := TAction.Create( self.FButtonSCActionList );
  self.FButtonSCAction.Name := 'ClickShortcutAction';
  self.FButtonSCAction.OnExecute := self.ExecuteButtonShortcut;
  self.FButtonSCAction.ShortCut := TextToShortCut('CTRL+K');
  self.FButtonSCAction.Enabled := TRUE;
  self.FButtonSCAction.Visible := TRUE;
  self.FButtonSCAction.ActionList := self.FButtonSCActionList;
  self.Action := FButtonSCAction;

如果我使用此代码创建自定义控件，将其添加到工具栏，将其放置在新 VCL Forms 应用程序中的表单上，然后运行该应用程序，当我按下快捷键时没有任何反应。如果我在没有此代码的情况下创建控件，请将其放在表单上并将 Actionlist 分配给表单，然后将仅涉及创建操作并将其分配给组件的 Action 属性的代码行放入按钮的 onclick 事件处理程序中，然后它会正确响应快捷键。在我的一生中，我看不出有什么不同，但希望您的 Actions Delphi 大师可以...

此操作的目的是允许开发人员通过属性为对象检查器中的按钮分配自定义快捷方式。我想直接分配给“内置”操作，但无法找到如何访问其快捷方式属性。（显然我可以通过其他 HotKey delphi 功能来做到这一点，如果我必须这样做，但我也想了解 Actions，这似乎是一个很好的起点......）

【问题讨论】：

我想知道你为什么要从组件的代码中分配给Action。在我看来，这是你的根本问题。我希望组件不会那样做。一旦你停止这样做，就没有问题了。 【参考方案1】：

总结

TControl 中没有内置的操作组件。它是一个默认未分配的 Action property。控件的用户可以为属性分配所需的任何操作。控件的设计者（您）不必提供 Action 或 ActionList。

实际问题

我想直接分配给“内置”操作，但不知道如何访问其快捷方式属性。

内置 Action 默认情况下只是一个未分配的TAction 属性。而如果该属性没有被赋值，即该属性不指向一个Action组件，那么它的ShortCut属性就不存在了。

此操作的目的是允许开发人员（红色。您的组件/控件的用户）通过属性为对象检查器中的按钮分配自定义快捷方式。

如果这是您的唯一目标，那么只需发布 Action 属性，无需进一步操作：

type
  TMyControl = class(TCustomControl)
  published
    property Action;
  end;

这将导致属性出现在开发人员的对象检查器中。开发人员只需为其分配一个自己的操作，并设置该操作的 ShortCut 属性。因此，实际的解决方案是摆脱所有当前代码。

为什么您当前的代码不起作用

self.FButtonSCActionList := TActionList.Create( self.Parent );

Self.Parent 在构造函数期间是nil。有两点：

除非您自己在析构函数中销毁 ActionList，否则会发生内存泄漏。对于默认的 ShortCut 处理，应用程序遍历所有 ActionLists，这些 ActionLists（间接）由当前聚焦的表单或 MainForm 拥有。您的 ActionList 没有所有者，因此它的快捷方式永远不会被评估。

当前代码的解决方案

首先，在您的代码中添加一些善意的 cmets：

Self 是隐含的，既不需要，也不需要。运行时制作的组件不需要Name 属性集。动作的Visible 和Enabled 属性默认为True。

其次，正如Dalija Prasnikar 已经说过的，在设计时不需要ActionList。并且 ActionList 必须由控件拥有的表单间接拥有。所以控件也可以拥有 ActionList (XE2)。

constructor TMyControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButtonSCAction := TAction.Create(Self);
  FButtonSCAction.OnExecute := ExecuteButtonShortcut;
  FButtonSCAction.ShortCut := TextToShortCut('CTRL+K');
  Action := FButtonSCAction;
  if not (csDesigning in ComponentState) then
  begin
    FButtonSCActionList := TActionList.Create(Self);
    FButtonSCAction.ActionList := FButtonSCActionList;
  end;
end;

在 XE2 之前的某个地方，至少在 D7 中，ActionList 必须通过控件拥有的表单进行注册。（还有更多，但由于控件不太可能是另一个窗体的父级，也不太可能在另一个窗体被聚焦时调用该操作，因此可以进行这种简化）。可以通过使表单成为 ActionList 的所有者来完成注册。由于您将 ActionList 的所有权授予控件之外，因此让 ActionList 使用FreeNotification 将其可能的销毁通知给控件。（好吧，这有点牵强，因为通常控制也会被销毁，但严格来说应该这样做）。

type
  TMyControl = class(TCustomControl)
  private
    FButtonSCActionList: TActionList;
    FButtonSCAction: TAction;
  protected
    procedure ExecuteButtonShortcut(Sender: TObject);
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TMyControl.Create(AOwner: TComponent);
var
  Form: TCustomForm;

  function GetOwningForm(Component: TComponent): TCustomForm;
  begin
    repeat
      if Component is TCustomForm then
        Result := TCustomForm(Component);
      Component := Component.Owner;
    until Component = nil;
  end;

begin
  inherited Create(AOwner);
  FButtonSCAction := TAction.Create(Self);
  FButtonSCAction.OnExecute := ExecuteButtonShortcut;
  FButtonSCAction.ShortCut := TextToShortCut('CTRL+K');
  Action := FButtonSCAction;
  if not (csDesigning in ComponentState) then
  begin
    Form := GetOwningForm(Self);
    if Form <> nil then
    begin
      FButtonSCActionList := TActionList.Create(Form);
      FButtonSCActionList.FreeNotification(Self);
      FButtonSCAction.ActionList := FButtonSCActionList;
    end;
  end;
end;

procedure TMyControl.ExecuteButtonShortcut(Sender: TObject);
begin
  //
end;

procedure TMyControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FButtonSCActionList) and (Operation = opRemove) then
    FButtonSCActionList := nil;
end;

请注意，当GetOwningForm 返回False 时（当开发人员创建没有所有者的控件时），不会创建ActionList，因为它无法解析拥有的表单。覆盖 SetParent 可以解决这个问题。

因为将所有权转移给另一个组件感觉没有必要（如果csDesigning in ComponentState，当代码运行时可能会给 IDE 的流系统带来问题），还有另一种方法可以将 ActionList 注册到表单通过将其添加到受保护的FActionLists 字段：

type
  TCustomFormAccess = class(TCustomForm);

constructor TMyControl.Create(AOwner: TComponent);
var
  Form: TCustomForm;

  function GetOwningForm(Component: TComponent): TCustomForm;
  begin
    repeat
      if Component is TCustomForm then
        Result := TCustomForm(Component);
      Component := Component.Owner;
    until Component = nil;
  end;

begin
  inherited Create(AOwner);
  FButtonSCAction := TAction.Create(Self);
  FButtonSCAction.OnExecute := ExecuteButtonShortcut;
  FButtonSCAction.ShortCut := TextToShortCut('CTRL+K');
  Action := FButtonSCAction;
  if not (csDesigning in ComponentState) then
  begin
    Form := GetOwningForm(Self);
    if Form <> nil then
    begin
      FButtonSCActionList := TActionList.Create(Self);
      FButtonSCAction.ActionList := FButtonSCActionList;
      if TCustomFormAccess(Form).FActionLists = nil then
        TCustomFormAccess(Form).FActionLists := TList.Create;
      TCustomFormAccess(Form).FActionLists.Add(FButtonSCActionList)
    end;
  end;
end;

对此解决方案的反思：

这种方法不可取。您不应在自定义控件中创建操作组件。如果必须，请单独提供它们，以便控件的用户可以决定将自定义操作添加到哪个 ActionList。另见：How do I add support for actions in my component? TControl.Action 是公共属性，TControl.SetAction 不是虚拟的。这意味着控件的用户可以分配一个不同的动作，使这个动作无用，你不能做任何事情，也不能反对它。（不发表是不够的）。相反，声明另一个 Action 属性，或者 - 再次 - 提供一个单独的 Action 组件。

【讨论】：

但是如果我在 ActionList create 调用中使用 self，ActionList 将拥有 TCustomComponent 类型的所有者，它不是 Form、Frame 或 Datamodule。我是否应该在 Loaded() 方法的重载中执行所有这些代码，而不是在其中分配 Parent 属性？我刚刚尝试使用“Self”，当按下快捷键时它会导致 delphi（IDE 和应用程序）崩溃。此外，当我使用此代码启动一个新的表单应用程序时，当 ide 启动新应用程序时，我收到一条奇怪的错误消息，关于“无法打开 bds.default”。有什么想法吗？我编辑了答案，因为我最初的陈述是错误的。关于您的错误：我怀疑您没有从表单设计器中删除之前的控件实例。无论如何，ActionList 不再是设计时创建的，所以这也应该解决。人力资源管理。我理解你的意思，感谢你所做的一切努力！我将测试此代码以确保我理解它，但将使用其他非操作功能来实现快捷方式。是的，我完全误解了你的问题。我以为您想为控件的操作添加快捷方式，但现在我知道您希望控件的用户能够添加它。在这种情况下，David's comment 恰到好处。【参考方案2】：

您不需要在设计时创建 ActionList。在您的 Create 方法中使用以下代码：

  FButtonSCAction := TAction.Create(Self);
  FButtonSCAction.SetSubComponent(true);
  FButtonSCAction.OnExecute := ExecuteButtonShortcut;
  FButtonSCAction.ShortCut := TextToShortCut('CTRL+K');
  FButtonSCAction.Enabled := TRUE;
  FButtonSCAction.Visible := TRUE;
  Action := FButtonSCAction;
  if not (csDesigning in ComponentState) then
    begin
      FButtonSCActionList := TActionList.Create(aOwner);
      FButtonSCAction.ActionList := FButtonSCActionList;
    end;

在控件的运行时创建期间，您可能会遇到这样的情况：传递给您的控件的所有者不是窗体本身，而是另一个控件。在这种情况下，您不必使用 aOwner 创建操作列表，而是必须调用函数，该函数将为您提供来自 aOwner 参数的表单。

function GetOwnerForm(Component: TComponent): TComponent;
begin
  Result := Component;
  while (Result <> nil) and (not (Result is TCustomForm)) do
    begin
      Result := Result.Owner;
    end;
end;

FButtonSCActionList := TActionList.Create(GetOwnerForm(aOwner));

【讨论】：

啊哈。我怀疑我应该使用所有者而不是父母（因为它必须在调用创建之前设置）但是这个信息宝石是宝藏！将在早上实施并发布结果。感谢您的帮助！如果 aOwner 不是 MainForm，则不会处理 ShortCut。 +1 @NGLN ShortCut 即使 aOwner 不是 MainForm 也会被处理，只要相关表单有焦点。感谢 Dalija 的帮助！一个小问题：为什么我们需要打电话给SetSubComponent(TRUE)？ @AlTheDeveloper 实际上您不必调用 SetSubComponent(true)，但如果您出于任何原因决定将 FBuffonSCAction 添加为已发布属性，则可以在设计时对其进行编辑。跨度> 【参考方案3】：

非常感谢大家的帮助！对于那些将在以后的 google-fu 中使用这个问题的人（我生活这些天而不是在 Delphi IDE 中......）这里是自定义组件的最终全功能代码：

unit ActionTester;

interface

uses

  Winapi.windows,
  Vcl.ExtCtrls,
  System.Types,
  System.SysUtils ,
  System.Classes,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Graphics,
  Messages,
  Vcl.Buttons,
  System.Variants,
  System.UITypes,
  Dialogs,
  Vcl.ExtDlgs,
  Generics.Collections,
  System.Actions,
  Vcl.ActnList,
  Clipbrd,
  TypInfo,
  Rtti,
  Menus;

type
  TActionTester = class(TCustomControl)
  private
     Private declarations 
  protected
     Protected declarations 
    FButtonSCActionList: TActionList;
    FButtonSCAction: TAction;
    procedure ExecuteButtonShortcut(Sender: TObject);
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
     Public declarations 
    constructor Create(AOwner: TComponent); override;
    Procedure Paint; override;
    Destructor Destroy; Override;
  published
     Published declarations 
    Property OnClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TActionTester]);
end;

 TActionTester 

constructor TActionTester.Create(AOwner: TComponent);
var
  Form: TCustomForm;

  function GetOwningForm(Component: TComponent): TCustomForm;
  begin
    result := NIL;
    repeat
      if Component is TCustomForm then
        Result := TCustomForm(Component);
      Component := Component.Owner;
    until Component = nil;
  end;

begin
  inherited Create(AOwner);
  FButtonSCAction := TAction.Create(Self);
  FButtonSCAction.OnExecute := ExecuteButtonShortcut;
  FButtonSCAction.ShortCut := TextToShortCut('CTRL+K');
  FButtonSCAction.SetSubComponent(true);
  if not (csDesigning in ComponentState) then
  begin
    Form := GetOwningForm(Self);
    if Form <> nil then
    begin
      FButtonSCActionList := TActionList.Create(Form);
      FButtonSCActionList.FreeNotification(Self);
      FButtonSCAction.ActionList := FButtonSCActionList;
    end;
  end;
end;

destructor TActionTester.Destroy;
begin
  FreeAndNil( self.FButtonSCAction );
  inherited;
end;

procedure TActionTester.ExecuteButtonShortcut(Sender: TObject);
begin
  if assigned( self.OnClick ) then self.OnClick( self );
end;

procedure TActionTester.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FButtonSCActionList) and (Operation = opRemove) then
    FButtonSCActionList := nil;
end;

procedure TActionTester.Paint;
begin
  inherited;
  self.Canvas.Brush.Color := clGreen;
  self.Canvas.Brush.Style := bsSolid;
  self.Canvas.FillRect( self.GetClientRect );
end;

end.

像魅力一样工作！向 NGLN、David 和 Dalija 致敬！

【讨论】：

以上是关于运行时分配操作的快捷方式不会在自定义组件中触发的主要内容，如果未能解决你的问题，请参考以下文章

多维数组的运行时分配

onChange 没有为自定义子组件触发

如何在运行时分配多维数组？

在自定义样式组件模板字符串上运行 stylelint

Visual Studio不会在浏览器中运行，某些快捷方式也不会执行任何操作

如何在 Android 中以编程方式触发自定义信息窗口