Delphi/Lazarus |有没有办法简化全局 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 的成员，所有视觉控件都派生自它，但大多数控件不会将其提升为 published。但是，由于它被声明为 protected，您可以使用访问器 class 在任何控件上访问它，例如：

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 的受保护成员，并且声明 TControlAccess 的单位可以访问所有 TControlAccess 的成员受保护的成员。

另一方面，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;