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

LCL: improve HintControl function more. The control returned is the first parent to contain hint text.

Browse Source 
git-svn-id: trunk@33086 -
This commit is contained in:
juha 2011-10-26 06:50:16 +00:00
parent 56c6f5662e
commit bd7b46c17a
1 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/include/application.inc
View File

@ -37,25 +37,28 @@ begin
end;
function GetHintControl(Control: TControl): TControl;
// Returns control that provides hint text for the specified Control, or nil if no hint.
// Hint is shown if one control in parent chain has ShowHint (and others ParentShowHint).
// Hint text comes from the closest parent that has hint text.
var
ParentC: TControl;
begin
Result := Control; // Will return the original control to get the correct hint text.
// Show hint only when program is running normally
if (Control <> nil) and
([csDesigning, csDestroying, csLoading] * Control.ComponentState <> []) then
exit(nil);
// Iterate parents. If control and its parents don't have ShowHint=True -> no hint
Result := Control; // Will return original control or the nearest parent with hint.
// Iterate parents. No hint if control and its parents don't have ShowHint=True
ParentC := Control;
while (ParentC <> nil) and not ParentC.ShowHint do begin
// if both ShowHint and ParentShowHint are false -> no hint
// No hint if both ShowHint and ParentShowHint are false
if not ParentC.IsParentShowHint then
exit(nil);
ParentC := ParentC.Parent;
ParentC := ParentC.Parent; // A level up in parent tree.
if Result.Hint = '' then // Will return the first control to have a hint text.
Result := ParentC;
end;
if (ParentC = nil) then
if (ParentC = nil) then // No hint if none of parents had ShowHint=True
Result := nil;
// Show hint only when program is running normally
if (Result <> nil) and
([csDesigning, csDestroying, csLoading] * Result.ComponentState <> []) then
Result := nil;
end;