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

Question

Создание VCL Forms Application, поставить TBalloonHint (Имя: balloonhintTest) и TButton (Name: 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; 

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

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

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

Как вы можете видеть - хотя координаты Hint всегда одинаковы - подсказка отображается вниз в первом случае (желаемый результат) и выше во втором случае (очевидно, не дез ired результат), в зависимости от вертикального положения окна на экране.

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

(Обратите внимание: меня не интересуют другие перегрузки метода 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;