Как вывести TBalloonHint всегда вниз независимо от положения экрана?

Question

Создайте приложение VCL Forms, поместите TBalloonHint (Имя: balloonhintTest) и TButton (Имя: btnTest) в форме и напишите этот код:

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;

Теперь запустите программу и наведите указатель мыши на кнопку.

Вот как это выглядит, когда окно находится на верхней части экрана:

И вот как это выглядит, когда окно находится на нижней части экрана:

Как вы можете видеть - хотя координаты подсказок всегда одинаковы - подсказка отображается ВНИЗ в первом случае (желаемый результат) и ВВЕРХ во втором случае (очевидно, не желаемый результат), в зависимости от вертикального положения окна на экран.

Итак, как я могу отобразить подсказку в этом случае всегда ВНИЗ независимо от положения экрана?

(Обратите внимание: меня не интересуют другие перегрузки ShowHint Метод - я просто хочу знать, как отображать подсказку всегда вниз в приведенном выше случае, поскольку это только упрощенный сценарий более сложного случая).

Answer 1

Вероятно, самый простой способ - создать свой собственный класс на основе TBalloonHint как

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;

создать как

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

Answer 2

Я думаю, что еще проще, если вы просто примените проверку, находится ли точка отображения в нижней части формы, к которой принадлежит балунхинт, и если да, добавьте, что-то в этом роде. Высота ballHint может быть рассчитана с помощью 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;