通过状态栏以非模态形式显示提示

Question

在状态栏中显示提示的规范方法是通过以下代码：

    Constructor TMyForm.Create;
    begin
     inherited create (nil);
     ...
     Application.OnHint:= MyHint;
     ...
    end;

    procedure TMyForm.MyHint (Sender: TObject);
    begin
     sb.simpletext:= Application.Hint;
    end;  

    procedure TMyForm.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
     Application.OnHint:= nil;
     ...
    end;

当程序由模态形式组成时，上述方法工作得很好，但是当使用非模态形式（不一定是 MDI）时，就会出现问题。在这些情况下，将创建一个非模态表单并将Application.OnHint 分配给非模态表单内的一个过程；状态栏显示来自表单的提示。但是如果创建另一个非模态表单，Application.OnHint 现在被分配给第二个表单中的相同过程。在第一个非活动表单中将鼠标移到带有提示的控件上会导致该提示显示在第二个表单的状态栏中！

如何使每个非模态表单显示仅源自其自身控件的提示？一种可能性是当表单变为非活动状态时从控件中删除提示，并在表单再次变为活动状态时恢复它们，但这是非常不雅的。问题在于Application.OnHint 事件。

Answer 1

事实证明，OP 只是希望每个表单的状态栏显示来自该表单的所有提示（不介意它也显示来自其他表单的提示）。

所以这是微不足道的。只需给所有表单添加一个状态栏，然后将TApplicationEvents 组件放到每个表单上。为每个组件的OnHint 事件创建一个处理程序：

procedure TForm6.ApplicationEvents1Hint(Sender: TObject);
begin
  StatusBar1.SimpleText := Application.Hint;
end;

然后一切都会正常工作：

更新

看来 OP 确实 介意这一点。那么，一种解决方案是这样做：

procedure TForm6.ApplicationEvents1Hint(Sender: TObject);
begin
  if IsHintFor(Self) then
    StatusBar1.SimpleText := Application.Hint
  else
    StatusBar1.SimpleText := '';
end;

在您的所有表格上。但是只需要定义一次辅助函数

function IsHintFor(AForm: TCustomForm): Boolean;
begin
  Result := False;
  var LCtl := FindDragTarget(Mouse.CursorPos, True);
  if Assigned(LCtl) then
    Result := GetParentForm(LCtl) = AForm;
end;

不幸的是，这确实浪费了一些 CPU 周期，因为每次更改 Application.Hint 时它都会调用 FindDragTarget 多次，从某种意义上说是不必要的，因为 VCL 已经调用了一次。但这不应该被检测到。

更新 2

为了使菜单也能工作（也可以使用键盘进行导航，在这种情况下鼠标光标可能位于屏幕上的任何位置），我认为以下添加就足够了：

在IsHintFor 辅助函数旁边声明一个全局变量：

var
  GCurrentMenuWindow: HWND;

function IsHintFor(AForm: TCustomForm): Boolean;

并像这样扩展这个函数：

function IsHintFor(AForm: TCustomForm): Boolean;
begin
  if GCurrentMenuWindow <> 0 then
    Result := Assigned(AForm) and (GCurrentMenuWindow = AForm.Handle)
  else
  begin
    Result := False;
    var LCtl := FindDragTarget(Mouse.CursorPos, True);
    if Assigned(LCtl) then
      Result := GetParentForm(LCtl) = AForm;
  end;
end;

然后，要使菜单栏正常工作，请将以下内容添加到每个带有菜单栏的表单类中：

    procedure WMEnterMenuLoop(var Message: TWMEnterMenuLoop); message WM_ENTERMENULOOP;
    procedure WMExitMenuLoop(var Message: TWMExitMenuLoop); message WM_EXITMENULOOP;
  end;

implementation

procedure TForm6.WMEnterMenuLoop(var Message: TWMEnterMenuLoop);
begin
  inherited;
  GCurrentMenuWindow := Handle;
end;

procedure TForm6.WMExitMenuLoop(var Message: TWMExitMenuLoop);
begin
  inherited;
  GCurrentMenuWindow := 0;
end;

最后，要使上下文菜单起作用，请使用辅助函数将以下内容添加到单元中：

type
  TPopupListEx = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

{ TPopupListEx }

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_INITMENUPOPUP:
      for var LMenu in PopupList do
        if TObject(LMenu) is TPopupMenu then
          if TPopupMenu(LMenu).Handle = Message.WParam then
          begin
            var LComponent := TPopupMenu(LMenu).PopupComponent;
            if LComponent is TControl then
            begin
              var LForm := GetParentForm(TControl(LComponent));
              if Assigned(LForm) then
                GCurrentMenuWindow := LForm.Handle;
            end;
            Break;
          end;
    WM_EXITMENULOOP:
      GCurrentMenuWindow := 0;
  end;
end;

initialization
  FreeAndNil(PopupList);
  PopupList := TPopupListEx.Create;

end.

结果：

免责声明：未经过全面测试。

Answer 2

我将给出一个部分答案，因为我对这个主题的研究已经产生了一些适用于一种形式但不适用于另一种形式的东西。

关于我的解决方案的工作形式，有一个TDBGrid 以及一些按钮；网格有一个明确的提示。这种形式的解决方法如下：

    uses
      Controls;

    type
     TMyForm = class (TForm)
     ...
     public
      Procedure CMMouseEnter (var msg: TMessage); message CM_MouseEnter;
      Procedure CMMouseLeave (var msg: TMessage); message CM_MouseLeave
     end;

    Procedure TMyForm.CMMouseEnter (var msg: TMessage); 
    begin
     inherited;
     if msg.lparam = integer (dbGrid1)
      then sb.simpletext:= dbGrid1.Hint
    end;

    Procedure TMyForm.CMMouseLeave(var msg: TMessage); 
    begin
     inherited;
     if msg.lparam = integer (dbGrid1)
      then sb.simpletext:= ''
    end;

虽然这段代码有效，但我不喜欢 integer (dbGrid1) 演员；有更好的方法吗？

这段代码在哪里不起作用？另一个表单有一个页面控件，其中包含两个标签页；在一个标签页上有带有提示的速度按钮，在另一个标签页上有一个带有提示的 dbgrid。编写与上述类似的代码不起作用 - 输入 CMMouseEnter 时 msg.lparam 的值似乎是转换页面控件的值（可能是它的句柄？）。那么如何使用已定义的提示访问控件呢？