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

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;