Title / Description
Code { @author(Richard B. Winston <rbwinst@usgs.gov>) The main purpose of @name is to define GetHelpControl which is used to find a control that has help for a control. Contributions to this unit by Richard B. Winston are in the public domain. As of Nov. 2, 2005, this entire unit is by Richard B. Winston. } unit HelpProcessor; interface uses Classes, SysUtils, Controls, StdCtrls, Forms; { @abstract(@name returns @true if it can find a control that has help starting its search with HelpRequestControl. The control that it finds is returned in HasHelpControl.) In its search, the function checks the FocusControl property of TCustomStaticText and TCustomLabel, the Parent property of TControl, and finally Application.MainForm. @name works for both HelpType = htKeyword and HelpType = htContext.} function GetHelpControl(const HelpRequestControl: TControl; out HasHelpControl: TControl): boolean; implementation type TCustomLabelCracker = class(TCustomLabel); function GetHelpControl(const HelpRequestControl: TControl; out HasHelpControl: TControl): boolean; var AControl: TControl; AlreadyTried: TList; begin AControl := HelpRequestControl; HasHelpControl := nil; Result := FALSE; AlreadyTried := TList.Create; try while AControl <> nil do begin // Test if AControl has help. If it does, set HasHelpControl // and exit; case AControl.HelpType of htKeyword: begin if AControl.HelpKeyword <> '' then begin HasHelpControl := AControl; Exit; end; end; htContext: begin if AControl.HelpContext <> 0 then begin HasHelpControl := AControl; Exit; end; end; else Assert(False); end; // AControl does not have help, find the next one to test. { if (AControl is TCustomStaticText) and (TCustomStaticText(AControl).FocusControl <> nil) then begin AControl := TCustomStaticText(AControl).FocusControl; end else } if (AControl is TCustomLabel) and (TCustomLabelCracker(AControl).FocusControl <> nil) then begin AControl := TCustomLabelCracker(AControl).FocusControl; end else if AControl.Parent <> nil then begin AControl := AControl.Parent; end else if (Application <> nil) and (AControl <> Application.MainForm) and (Application.MainForm <> nil) then begin AControl := Application.MainForm; end else begin // nothing left to test so quit. Exit; end; // If the FocusControl of a TCustomStaticText or TCustomLabel // refers back to itself either directly or indirectly the // while loop might never exit. The following prevents that // from happening. if AlreadyTried.IndexOf(AControl) >= 0 then begin Exit; end else begin AlreadyTried.Add(AControl); end; end; finally AlreadyTried.Free; result := HasHelpControl <> nil; end; end; end.
Author
Highlight as C C++ CSS Clojure Delphi ERb Groovy (beta) HAML HTML JSON Java JavaScript PHP Plain text Python Ruby SQL XML YAML diff code