0

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

    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事件上。

4

2 回答 2

3

事实证明，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 周期，因为FindDragTarget每次更改它都会调用几次Application.Hint，从某种意义上说是不必要的，因为 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.

结果：

录屏

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

于 2022-01-08T16:31:29.437 回答
0

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

关于我的解决方案的工作形式，有一个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。编写与上述类似的代码不起作用 -msg.lparam输入时的值CMMouseEnter似乎是转换页面控件的值（也许是它的句柄？）。那么如何使用已定义的提示来控制控件呢？

于 2022-01-08T10:08:19.047 回答