paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 22:39:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: fix the hint behavior after the earlier change.

Browse Source 
git-svn-id: trunk@33082 -
This commit is contained in:
juha 2011-10-25 11:43:00 +00:00
parent b620fb101b
commit dd109fba91
1 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
lcl/include/application.inc
View File

@ -37,16 +37,25 @@ begin
end; end;
function GetHintControl(Control: TControl): TControl; function GetHintControl(Control: TControl): TControl;
var
ParentC: TControl;
begin begin
Result := Control; Result := Control; // Will return the original control to get the correct hint text.
while (Result <> nil) and not Result.ShowHint do begin
// if both ShowHint and ParentShowHint are false -> leave // Show hint only when program is running normally
if not Result.IsParentShowHint then if (Control <> nil) and
exit(Nil); ([csDesigning, csDestroying, csLoading] * Control.ComponentState <> []) then
Result := Result.Parent; exit(nil);
// Iterate parents. If control and its parents don't have ShowHint=True -> no hint
ParentC := Control;
while (ParentC <> nil) and not ParentC.ShowHint do begin
// if both ShowHint and ParentShowHint are false -> no hint
if not ParentC.IsParentShowHint then
exit(nil);
ParentC := ParentC.Parent;
end; end;
if (Result <> nil) and if (ParentC = nil) then
([csDesigning, csDestroying, csLoading] * Result.ComponentState <> []) then
Result := nil; Result := nil;
end; end;
@ -179,8 +188,7 @@ begin
OnGetApplicationName := nil; OnGetApplicationName := nil;
end; end;
procedure TApplication.ActivateHint(CursorPos: TPoint; procedure TApplication.ActivateHint(CursorPos: TPoint; CheckHintControlChange: Boolean);
CheckHintControlChange: Boolean);
var var
Info: THintInfoAtMouse; Info: THintInfoAtMouse;
HintControlChanged: Boolean; HintControlChanged: Boolean;