运行时分配的操作快捷键在自定义组件中无法触发。

3

我遇到了一个问题,当代码完全在运行时创建(即没有表单设计器组件)时,无法将操作分配给自定义组件的继承操作属性。如果在表单设计器中使用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高手可以...

此操作的目的是允许开发人员通过属性在对象检查器中指定自定义快捷方式以将按钮分配给操作。我想直接分配到“内置”操作,但找不到如何访问其Shortcut属性。(显然,我可以通过其他HotKey Delphi功能实现这一点,如果必须,我也会这样做,但我还想了解Actions,并且这似乎是一个好的起点...)


1
我想知道的是,为什么你想从组件代码内部分配给 Action。在我看来,这似乎是你的根本问题。我希望组件不要这样做。一旦你停止这样做,就不会再有问题了。 - David Heffernan
3个回答

3
您不需要在设计时创建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 参数中获取窗体,而不是使用 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,那么快捷键将不会被处理。+1 - NGLN
感谢Dalija的帮助!一个小问题:为什么我们需要调用SetSubComponent(TRUE) - Al The Developer
哦,好的。谢谢。我会在今天晚些时候尝试一切,并告诉大家它的效果如何。我觉得这将完全满足我的需求! - Al The Developer
好的,我做了一些调查。为了处理快捷方式,操作的ActionList需要由MainForm或当前聚焦的表单拥有。这意味着,如果一个ActionList由一个次要表单拥有,并且有一个聚焦的MainForm,则不会处理附加到MainForm上的ActionControl的操作的快捷方式。首先将调用Application.IsKeyMsg。如果返回false,则将调用Application.IsShortCut - NGLN
此外,在D7中,ActionList必须在TCustomForm.FActionLists中注册。在XE2中,该字段已经消失,而TCustomForm只是遍历所有间接拥有的ActionLists。因此,在最近的Delphi版本中,ActionList的所有者(即aOwner)也可以是Self - NGLN
显示剩余3条评论

2

概述

TControl中没有内置的Action组件。它是一个未分配默认值的Action属性。控件的用户可以使用所需的任何Action来分配该属性。控件的设计者(即你)不必提供Action或ActionList。

实际问题

我想直接分配给“内置”的Action,但找不到如何访问其Shortcut属性。

默认情况下,“内置”的Action只是一个未分配的TAction属性。如果未分配该属性,即该属性不指向Action组件,则其Shortcut属性不存在。

该Action的目的是允许开发人员(即你组件/控件的用户)通过属性在对象检查器中为按钮分配自定义快捷方式。

如果这是你唯一的目标,那么只需发布Action属性并不再做任何操作:

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

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

为什么您当前的代码无法正常工作

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

Self.Parent 在构造函数期间为 nil。关于这个有两件事:

  • 除非你在析构函数中自己销毁 ActionList,否则会出现内存泄漏。
  • 对于默认的快捷键处理,应用程序会遍历所有由当前聚焦窗体或 MainForm 直接或间接拥有的 ActionList。你的 ActionList 没有所有者,因此它的快捷键永远不会被评估。

当前代码的解决方案

首先,对你的代码提出一些善意的评论:

  • Self 是隐式的,不需要也不习惯使用。
  • 运行时制作的组件不需要设置 Name 属性。
  • ActionVisibleEnabled 属性默认为 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流系统出现问题),所以有另一种方法可以通过将其添加到受保护的FActionLists字段来向窗体注册ActionList。
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中。另请参见:如何在我的组件中添加动作支持?
  • TControl.Action是一个公共属性,而TControl.SetAction不是虚拟的。这意味着控件的用户可以分配不同的动作,使此动作无效,您无法对其进行任何处理或反对。 (不发布是不够的)。相反,声明另一个动作属性,或者再次提供单独的动作组件。

但是如果我在ActionList创建调用中使用self,则ActionList将具有类型为TCustomComponent的所有者,它不是Form、Frame或Datamodule。也许我应该在Loaded()方法的重载中完成所有这些代码,在那里我可以分配Parent属性? - Al The Developer
我刚刚尝试使用 "Self",但在按下快捷键时它会使 Delphi (IDE 和应用程序) 崩溃。而且,当我启动一个新的窗体应用程序并放置这段代码时,当 IDE 启动新的应用程序时,我会收到一个关于 "unable to open bds.default" 的奇怪错误消息。有什么想法吗? - Al The Developer
我修改了答案,因为我的初始陈述是错误的。关于你的错误:我怀疑你没有从表单设计器中删除控件的先前实例。无论如何,ActionList不再在设计时创建,所以这个问题也应该解决了。 - NGLN
嗯,我理解你的观点,感谢你的努力!我会测试这段代码以确保我理解它,但对于这种情况,我将使用其他非操作功能来实现快捷方式。 - Al The Developer
是的,我完全误解了你的问题。我以为你想要将快捷方式添加到控件的操作中,但现在我明白了,你希望控件的用户能够添加它。在这种情况下,David的评论命中了要害。 - NGLN
+one 这是一个非常好的答案。 - David Heffernan

0
非常感谢所有的帮助!对于那些以后会使用这个问题进行谷歌搜索的人(我现在除了 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致以最高的赞扬!


网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接