paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-15 12:50:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Improve TApplication.ActivateHint. Issue #40820, patch by Alexander (Rouse_) Bagel.

Browse Source
This commit is contained in:
Juha 2024-03-05 16:02:03 +02:00
parent 6d6f4ba027
commit 90dbac6a6f
1 changed files with 37 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lcl/include/application.inc
View File

@ -177,7 +177,26 @@ end;
procedure TApplication.ActivateHint(CursorPos: TPoint; CheckHintControlChange: Boolean); procedure TApplication.ActivateHint(CursorPos: TPoint; CheckHintControlChange: Boolean);
var var
Info: THintInfoAtMouse; Info: THintInfoAtMouse;
HintControlChanged: Boolean; HintControlChanged, MouseLeaveHintRect, WasHintActive: Boolean;
HitControl: TControl;
procedure StartHintTimerWithCustomPause;
var
Pause: Integer;
begin
Pause := IfThen(WasHintActive, 0, HintPause);
if Assigned(FHintControl) then
FHintControl.Perform(CM_HINTSHOWPAUSE, Ord(WasHintActive), LParam(@Pause));
if Pause = 0 then
ShowHintWindow(Info)
else
begin
CancelHint;
FHintControl := Info.Control;
StartHintTimer(Pause, ahttShowHint);
end;
end;
begin begin
Info := GetHintInfoAt(CursorPos); Info := GetHintInfoAt(CursorPos);
@ -187,6 +206,7 @@ begin
HintControlChanged := not CheckHintControlChange or (FHintControl <> Info.Control); HintControlChanged := not CheckHintControlChange or (FHintControl <> Info.Control);
if Info.ControlHasHint then if Info.ControlHasHint then
begin begin
MouseLeaveHintRect := Assigned(FHintControl) and not PtInRect(FHintRect, FHintControl.ScreenToClient(CursorPos));
if HintControlChanged then if HintControlChanged then
begin begin
StopHintTimer; StopHintTimer;
@ -194,28 +214,32 @@ begin
FHintControl := Info.Control; FHintControl := Info.Control;
FHintRect := FHintControl.BoundsRect; FHintRect := FHintControl.BoundsRect;
end else begin end else begin
if not MouseLeaveHintRect then
Exit; Exit;
end; end;
WasHintActive := Assigned(FHintWindow) and FHintWindow.Visible;
case FHintTimerType of case FHintTimerType of
ahttNone, ahttHideHint: ahttNone, ahttHideHint:
//react only if the hint control changed or if the mouse leave the previously set hint rect //react only if the hint control changed or if the mouse leave the previously set hint rect
if HintControlChanged or (not PtInRect(FHintRect, FHintControl.ScreenToClient(Info.MousePos))) then if HintControlChanged or MouseLeaveHintRect then
begin StartHintTimerWithCustomPause;
//if a hint is visible immediately query the app to show a new hint...
if FHintTimerType = ahttHideHint then
ShowHintWindow(Info);
//...if there's no hint window visible at this point then schedule a new query
if (FHintTimerType = ahttNone) or (FHintWindow = nil) or not FHintWindow.Visible then
StartHintTimer(HintPause, ahttShowHint);
end;
ahttShowHint, ahttReshowHint: ahttShowHint, ahttReshowHint:
StartHintTimer(HintPause, ahttShowHint); StartHintTimerWithCustomPause;
end; end;
end end
else else
begin
// THintWindow should not be closed if there is a cursor above it
// Relevant for Linux only
{$IFNDEF MSWINDOWS}
HitControl := FindControlAtPosition(CursorPos, False);
if (HitControl = nil) or not (HitControl is THintWindow) then
{$ENDIF}
CancelHint; CancelHint;
end;
end; end;
procedure TApplication.BringToFront; procedure TApplication.BringToFront;
begin begin
WidgetSet.AppBringToFront; WidgetSet.AppBringToFront;