停止德尔福 7 中的事件传播

我在Delphi 7中遇到了一个关于事件传播的问题(由于我的无知(。

我被要求在窗体上的某些控件上动态附加一个OnMouseUp事件处理程序(我对此很好(，但如果OnMouseUp存在，则不得处理该控件上的OnClick事件。

背景

如果你问这背后的原因，好吧，我负责修改一个旧的生产监控应用程序(叹息(，从现在开始，它必须适应某些控件的条件行为，以直接响应以前单击特殊功能按钮。

其中一些控件已经具有OnClick事件处理程序;团队提出的第一个解决方案是准时干预每个OnClick处理程序，并管理与特殊功能按钮状态相关的上下文操作。

我

建议利用应用程序表单已经存在的面向对象设计：它们都继承自同一个自定义祖先对象，因此我计划在其中插入一个初始化方法，以动态地将OnMouseUp事件附加到声明为在子类中支持它的控件。

需要

我

并不是在这里要求对这一切(可能缺乏(设计的好处进行验证或质疑(顺便说一下，经过大量的思考和推理，这似乎是我们可以少痛苦地走的道路(;我的问题是，要进行这样的设计，我必须让动态附加的OnMouseUp事件处理程序停止事件传播到这些控件上预先存在的OnClick事件。

德尔福 7 可能吗？

请注意，以下内容并未明确回答此处的问题。这更像是对概念重新设计的建议(重定向OnClick事件而不是添加额外的OnMouseUp(。这是关于如何将所有组件(如果需要，可能会过滤(的 OnClick 事件处理程序(如果分配了一些(重定向到另一个(通用(OnClick 事件处理程序。它还包括一种将它们恢复到原始状态的方法。

在下面的示例中，我将尝试向您展示如何替换 OnClick 事件处理程序，然后选择性地还原特定事件处理程序(如果组件已写入一些(。这是对所有已发布 OnClick 事件的组件完成的，因此您无需提前知道组件类是否具有可用的 OnClick 事件(但可以非常简单地将其修改为仅使用特定类(。

该代码由以下内容组成：

OnSpecialClick - 它是调用 ReplaceOnClickEvents 过程时所有 OnClick 事件将绑定的事件处理程序，请注意，必须发布它才能对 RTTI !!
Button1Click - 此处表示应替换的旧事件处理程序，它在设计时绑定到 Button1.OnClick 事件
ReplaceOnClickEvents - 方法，该方法循环访问窗体上的所有组件，并检查
当前迭代的组件是否分配了 OnClick 事件处理程序;如果是，则将其存储到备份集合中，并用 OnSpecialClick 替换此事件处理程序
RestoreOnClickEvents - 方法，用于还原原始 OnClick 事件处理程序;它循环访问备份集合并将事件方法分配给其存储的组件实例
CheckBox1Click - 此复选框单击事件旨在是公共模式和特殊模式之间的切换(CheckBox1 选中状态表示是特殊模式(，只有此 OnClick 事件不会替换为 ReplaceOnClickEvents 调用(因为您无法将模式恢复正常(

这是：

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TypInfo, StdCtrls, Contnrs;
type
  TEventBackup = class
    Component: TComponent;
    OnClickMethod: TMethod;
  end;
type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    procedure ReplaceOnClickEvents;
    procedure RestoreOnClickEvents;
  published
    procedure OnSpecialClick(Sender: TObject);
  end;
var
  Form1: TForm1;
  EventBackupList: TObjectList;
implementation
{$R *.dfm}
procedure TForm1.OnSpecialClick(Sender: TObject);
begin
  ShowMessage('Hi, I''m an OnSpecialClick event message!');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Hi, I''m just that boring original OnClick event message!');
end;
procedure TForm1.ReplaceOnClickEvents;
var
  I: Integer;
  Component: TComponent;
  EventMethod: TMethod;
  EventBackup: TEventBackup;
begin
  for I := 0 to ComponentCount - 1 do
  begin
    Component := Components[I];
    if Component = CheckBox1 then
      Continue;
    if IsPublishedProp(Component, 'OnClick') then
    begin
      EventMethod := GetMethodProp(Component, 'OnClick');
      if Assigned(EventMethod.Code) and Assigned(EventMethod.Data) then
      begin
        EventBackup := TEventBackup.Create;
        EventBackup.Component := Component;
        EventBackup.OnClickMethod := EventMethod;
        EventBackupList.Add(EventBackup);
        EventMethod.Code := MethodAddress('OnSpecialClick');
        EventMethod.Data := Pointer(Self);
        SetMethodProp(Component, 'OnClick', EventMethod);
      end;
    end;
  end;
end;
procedure TForm1.RestoreOnClickEvents;
var
  I: Integer;
  EventBackup: TEventBackup;
begin
  for I := 0 to EventBackupList.Count - 1 do
  begin
    EventBackup := TEventBackup(EventBackupList[I]);
    SetMethodProp(EventBackup.Component, 'OnClick', EventBackup.OnClickMethod);
  end;
  EventBackupList.Clear;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    ReplaceOnClickEvents
  else
    RestoreOnClickEvents;
end;
initialization
  EventBackupList := TObjectList.Create;
  EventBackupList.OwnsObjects := True;
finalization
  EventBackupList.Free;
end.

正如 TLama 和 TOndrej 所说，有几种方法可以完成您正在尝试的事情：

对OnClick事件处理程序执行if Assigned(Control.OnMouseUp) then Exit;
在分配OnMouseUp时"取消分配"OnClick事件(反之亦然(

这两种方法都将完成您详细介绍的内容，尽管"取消分配"OnClick事件对性能(在本质上很小的程度上(是最好的，因为您不会重复执行if语句。

背景

需要

相关内容

最新更新

热门标签：