How to display TBalloonHint always downwards independently from the screen position?

Question

Create a VCL Forms Application, put a TBalloonHint (Name: balloonhintTest) and a TButton (Name: btnTest) on the form and write this code:

procedure TForm2.FormCreate(Sender: TObject);
begin
  balloonhintTest.HideHint;
  balloonhintTest.Style := bhsStandard;
end;

procedure TForm2.btnTestMouseEnter(Sender: TObject);
begin
  if not balloonhintTest.ShowingHint then
  begin
    balloonhintTest.Title := 'My Title';
    balloonhintTest.Description := 'MyDescription';
    balloonhintTest.ShowHint(Self.ClientToScreen(Point(btnTest.Left + (btnTest.Width div 2), btnTest.Top + btnTest.Height)));
  end;
end;

procedure TForm2.btnTestMouseLeave(Sender: TObject);
begin
  balloonhintTest.HideHint;
end;

Now run the program and hover your mouse pointer over the button.

This is how it looks when the window is on the UPPER PART OF THE SCREEN:

And this is how it looks when the window is on the LOWER PART OF THE SCREEN:

As you can see - although the Hint coordinates are always the same - the hint is displayed DOWNWARDS in the first case (desired result) and UPWARDS in the second case (obviously not the desired result), depending on the vertical position of the window on the screen.

So how can I display the balloon hint in this case always DOWNWARDS independently from the screen position?

(Please note: I am not interested in the other overloadings of the ShowHint method - I just want to know how to display the hint always downwards in the above case, as this is only the simplified scenario of a more complex case).

Answer 1

Probably easiest way is to create your own class based on TBalloonHint as

type
  TMyHint = class(TBalloonHint)
  strict private
    FControl: TControl;
  public
    procedure PaintHint(HintWindow: TCustomHintWindow); override;
    constructor Create(AOwner: TComponent; const AControl: TControl);
  end;

constructor TMyHint.Create(AOwner: TComponent; const AControl: TControl);
begin
  inherited Create(AOwner);
  FControl := AControl;
end;

procedure TMyHint.PaintHint(HintWindow: TCustomHintWindow);
var
  Point: TPoint;
begin
  Point := FControl.Parent.ClientToScreen(TPoint.Create(FControl.Left, FControl.Top + FControl.Height));
  HintWindow.Top := Point.Y;

  inherited;
end;

create it as

procedure TMainForm.FormCreate(Sender: TObject);
begin
  balloonHintTest := TMyHint.Create(Self, btnTest);
  balloonHintTest.Style := bhsStandard;
end;

Answer 2

I think it is even easier if you just apply a check on whether the showing point is on the lower part of the form to which the balloonhint belongs, and if yes add, sth like that. The height of the balloonHint can be calculated via textHeight

 procedure TForm2.FormCreate(Sender: TObject);
    begin
      balloonhintTest.HideHint;
      balloonhintTest.Style := bhsStandard;
    end;
    
    procedure TForm2.btnTestMouseEnter(Sender: TObject);
    begin
      if not balloonhintTest.ShowingHint then
      begin
        balloonhintTest.Title := 'My Title';
        balloonhintTest.Description := 'MyDescription';
        TPoint pointCheck = Self.ClientToScreen(Point(btnTest.Left + (btnTest.Width div 2), btnTest.Top + btnTest.Height)); 
        if(pointCheck.y>0.5*Self.Height)
            int yShift = balloonhintTest.Height; 
            pointCheck.y = pointCheck.y - yShift;  
        end if 
        balloonhintTest.ShowHint(pointCheck);
      end;
    end;
    
    procedure TForm2.btnTestMouseLeave(Sender: TObject);
    begin
      balloonhintTest.HideHint;
    end;