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

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

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

关于我的解决方案工作的形式，有一个 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 的值似乎是转换页面控件（可能是它的句柄？）的值。那么如何使用已定义提示的控件呢？

Answer 2

事实证明，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;

然后，要使菜单栏起作用，请将以下内容添加到每个带有菜单栏的表单 class：

    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.

结果：

免责声明：未完全测试。

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

Displaying hints via a status bar in a non-modal form

delphi

statusbar

hints

non-modal