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

Question

The canonical method of displaying hints in a status bar is via the following code:

    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;

The above works fine when a program consists of modal forms, but it is problematic when non-modal forms are used (not necessarily MDI). In these cases, a non-modal form is created and Application.OnHint is assigned to a procedure within the non-modal form; the status bar displays hints from the form. But should another non-modal form be created, Application.OnHint is now assigned to the same procedure within the second form. Moving the mouse over the control with a hint in the first, non-active, form causes that hint to be displayed in the status bar of the second form!

How can I cause each non-modal form to display hints that originate only from its own controls? One possibility is removing hints from controls when a form becomes inactive and restoring them when the form becomes active again, but that is very inelegant. The problem is with the Application.OnHint event.

Answer 1

It turns out that the OP simply wants each form's status bar to display all hints from that form (not minding it also displaying hints from other forms as well).

So this is trivial. Just give all your forms a status bar and drop a TApplicationEvents component onto each form. Create a handler for each component's OnHint event:

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

And then everything will just work:

Update

It seems that the OP does mind that. One solution, then, is to do like this:

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

on all your forms. But only one time do you need to define the helper function

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

This unfortunately does waste a few CPU cycles, since it calls FindDragTarget several times each time Application.Hint is changed, in a sense needlessly since the VCL already has called it once. But this shouldn't be detectable.

Update 2

To make this work also for menus (which may also be navigated using the keyboard, in which case the mouse cursor may be anywhere on the screen), I think the following additions will suffice:

Declare a global variable next to the IsHintFor helper function:

var
  GCurrentMenuWindow: HWND;

function IsHintFor(AForm: TCustomForm): Boolean;

and extend this function like so:

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;

Then, to make menu bars work, add the following to each form class with a menu bar:

    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;

Finally, to make context menus work, add the following to the unit with the helper function:

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.

Result:

Disclaimer: Not fully tested.

Answer 2

I'm going to give a partial answer as my researches into this topic have yielded something that works on one form but not on another.

With regard to the form where my solution works, there is a TDBGrid along with some buttons; the grid has a defined hint. The solution for this form is as follows:

    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;

Whilst this code works, I don't like that integer (dbGrid1) cast; is there a better way of doing this?

Where doesn't this code work? Another form has a page control holding two tabsheets; on one tabsheet there are speedbuttons with hints, and on the other tabsheet there is a dbgrid with a hint. Writing similar code to the above doesn't work - the value of msg.lparam upon entering CMMouseEnter would appear to be the value of casting the page control (maybe its handle?). So how does one get to the controls with defined hints?