德尔福/拉撒路|有没有办法简化全局 OnMouseEnter 事件处理？

Question

问题

我想在Windows 上的Delphi XE6中简化以下代码，随着我添加越来越多类型的组件，该代码变得难以维护。

可移植性说明:我想稍后在 Linux 上的 Lazarus 2.0.2 中使用相同的代码，几乎不需要任何更改，因此 Windows 消息处理不再适用问题。

问题是，我似乎找不到一种方法将 OnMouseEnter 事件处理程序分配给整个表单上的所有组件。

我尽了一切努力，包括对象树中常见的各种类。 OnMouseEnter 事件似乎没有任何共同点。

事件处理程序本身只包含一个命令(procedure = void function)，并且不会再有更多命令，也许这可以简化整个问题？

如下所示，此时我需要将每种类型的组件(目前只有 TLabel、TButton 和 TEdit)添加到 for 循环中。

<小时/>

procedure TFormMain.FormCreate(Sender: TObject);
var
    I: Integer;
begin
    for I := 0 to FormMain.ComponentCount - 1 do
    begin
        if FormMain.Components[I] is TLabel then
        begin
            (FormMain.Components[I] as TLabel).OnMouseEnter
                := @CustomGenericMouseEnter;
        end;
        if FormMain.Components[I] is TButton then
        begin
            (FormMain.Components[I] as TButton).OnMouseEnter
                := @CustomGenericMouseEnter;
        end;
        if FormMain.Components[I] is TEdit then
        begin
            (FormMain.Components[I] as TEdit).OnMouseEnter
                := @CustomGenericMouseEnter;
        end;
    end;
end;

procedure TFormMain.CustomGenericMouseEnter(Sender: TObject);
begin
    SingleCustomProcedure; // no arguments, nor return value
end;

<小时/>

动机

我正在编写一个颜色选择器应用程序，因此想向用户显示鼠标坐标。

我在那里有一个轮询计时器，我不想添加不必要的代码，所以我希望这是不言自明的:

procedure TFormMain.TimerMousePollTimer(Sender: TObject);
begin
    if MousePosChanged then
    begin
        LabelEdit_MousePosX.Text := MousePosX.ToString;
        LabelEdit_MousePosY.Text := MousePosY.ToString;
    end;
end;

此外，我确实实现了 OnMouseLeave。

Answer 1

The OnMouseEnter event seems to be nowhere in the common ground.

事实上，确实如此。 OnMouseEnter 是 TControl 的成员，所有可视控件均源自该控件，但大多数控件不会将其提升为已发布。但是，由于它被声明为 protected ，因此您可以使用访问器类在任何控件上访问它，例如:

type
  TControlAccess = class(TControl)
  end;

procedure TFormMain.FormCreate(Sender: TObject);
var
  I: Integer;
  Comp: TComponent;
begin
  for I := 0 to ComponentCount - 1 do
  begin
    Comp := Components[I];
    if Comp is TControl then
      TControlAccess(Comp).OnMouseEnter := CustomGenericMouseEnter;
  end;
end;

这是有效的，因为 TControlAccess 可以访问所有 TControl 的 protected 成员，并且声明 TControlAccess 的单元可以访问所有TControlAccess 的 protected 成员。

另一方面，OnMouseEnter 最初是 protected ，因此控件可以决定是否要公开对其的访问。如果您想尊重该决定并仅将其设置为促进该决定的控件，则可以使用 RTTI，例如:

uses
  ..., TypInfo;

procedure TFormMain.FormCreate(Sender: TObject);
var
  I: Integer;
  Comp: TComponent;
  Prop: PPropInfo;
  M: TMethod;
begin
  TNotifyEvent(M) := CustomGenericMouseEnter;
  for I := 0 to ComponentCount - 1 do
  begin
    Comp := Components[I];
    if not (Comp is TControl) then Continue;
    Prop := GetPropInfo(Comp, 'OnMouseEnter', [tkMethod]);
    if Prop <> nil then
      SetMethodProp(Comp, Prop, M);
  end;
end;

或者(仅限 Delphi 2010+):

uses
  ..., System.Rtti;

procedure TFormMain.FormCreate(Sender: TObject);
var
  I: Integer;
  Ctx: TRttiContext;
  Comp: TComponent;
  Prop: TRttiProperty;
  V: TValue;
begin
  V := TValue.From<TNotifyEvent>(CustomGenericMouseEnter);
  for I := 0 to ComponentCount - 1 do
  begin
    Comp := Components[I];
    if not (Comp is TControl) then Continue;
    Ctx.GetType(Comp.ClassType).GetProperty('OnMouseEnter');
    if (Prop <> nil) and (Prop.Visibility in [TMemberVisibility.mvPublic, TMemberVisibility.mvPublished]) then
      Prop.SetValue(Comp, V);
  end;
end;