delphistatusbarhintsnon-modal

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


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.


Solution

  • 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:

    Screen recording.

    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.

    Screen recording

    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:

    Screen recording

    Disclaimer: Not fully tested.