From 336c22deda58b44e5da3b83ab1b9bd36da837e9a Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 13 May 2006 17:07:25 +0000 Subject: [PATCH] added Help to TApplication, disable it with Application.Navigation-[anoF1ForHelp] git-svn-id: trunk@9281 - --- lcl/controls.pp | 2 ++ lcl/forms.pp | 6 ++++-- lcl/helpintfs.pas | 2 ++ lcl/include/application.inc | 19 +++++++++++++------ lcl/include/control.inc | 24 ++++++++++++++++++++++++ lcl/include/customform.inc | 20 +------------------- lcl/lazhelphtml.pas | 7 +++++++ packager/registerlcl.pas | 4 +++- 8 files changed, 56 insertions(+), 28 deletions(-) diff --git a/lcl/controls.pp b/lcl/controls.pp index 3846a800c2..2b99bd174e 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -1174,6 +1174,8 @@ type function ParentDestroyingHandle: boolean; function ParentHandlesAllocated: boolean; virtual; procedure InitiateAction; virtual; + procedure ShowHelp; virtual; + function HasHelp: Boolean; public // Event lists procedure RemoveAllHandlersOfObject(AnObject: TObject); override; diff --git a/lcl/forms.pp b/lcl/forms.pp index 472129685a..0bd064a7dc 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -39,7 +39,7 @@ interface uses Classes, SysUtils, Math, LCLStrConsts, LCLType, LCLProc, LCLIntf, InterfaceBase, LResources, GraphType, Graphics, Menus, LMessages, CustomTimer, - ActnList, ClipBrd, CustApp, LCLClasses, Controls; + ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls; type TProcedure = procedure; @@ -849,7 +849,8 @@ type TApplicationNavigationOption = ( anoTabToSelectNext, anoReturnForDefaultControl, - anoEscapeForCancelControl + anoEscapeForCancelControl, + anoF1ForHelp ); TApplicationNavigationOptions = set of TApplicationNavigationOption; @@ -984,6 +985,7 @@ type function HelpKeyword(Sender: TObject; const Position: TPoint; const Keyword: String): Boolean; function HelpKeyword(const Keyword: String): Boolean; + procedure ShowHelpForObjecct(Sender: TObject); procedure HideAllFormsWithStayOnTop; function IsWaiting: boolean; procedure CancelHint; diff --git a/lcl/helpintfs.pas b/lcl/helpintfs.pas index 2c959b09da..d3616b63ce 100644 --- a/lcl/helpintfs.pas +++ b/lcl/helpintfs.pas @@ -28,6 +28,8 @@ or use the LCL help system in lazhelpintf.pas. The THTMLHelpDatabase and THTMLBrowserHelpViewer in lazhelphtml.pas use the LCL help system. + + To create your own help system, implement a descendant of THelpManager. } unit HelpIntfs; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 12d7e8e0c4..25c07c86c3 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -95,7 +95,7 @@ begin FOnIdle := nil; FIcon := nil; FNavigation := [anoTabToSelectNext,anoReturnForDefaultControl, - anoEscapeForCancelControl]; + anoEscapeForCancelControl,anoF1ForHelp]; ApplicationActionComponent:=Self; OnMenuPopupHandler:=@MenuPopupHandler; @@ -517,7 +517,7 @@ end; ------------------------------------------------------------------------------} function TApplication.ValidateHelpSystem: Boolean; begin - Result:=false; + Result:=HelpManager<>nil; end; {------------------------------------------------------------------------------ @@ -924,8 +924,7 @@ function TApplication.HelpContext(Sender: TObject; const Position: TPoint; Context: THelpContext): Boolean; begin if ValidateHelpSystem then begin - Result := true; - //HelpSystem.ShowContextHelp(Context, GetCurrentHelpFile); + Result := ShowHelpOrErrorForContext('',Context)=shrSuccess; end else Result := false; end; @@ -942,8 +941,7 @@ function TApplication.HelpKeyword(Sender: TObject; const Position: TPoint; const Keyword: String): Boolean; begin if ValidateHelpSystem then begin - Result := true; - //HelpSystem.ShowHelp(Keyword, GetCurrentHelpFile); + Result := ShowHelpOrErrorForKeyword('',Keyword)=shrSuccess; end else Result := false; end; @@ -956,6 +954,13 @@ begin Result:=HelpKeyword(nil,Point(0,0),Keyword); end; +procedure TApplication.ShowHelpForObjecct(Sender: TObject); +begin + if Sender is TControl then begin + TControl(Sender).ShowHelp; + end; +end; + {------------------------------------------------------------------------------ procedure TApplication.HideAllFormsWithStayOnTop; ------------------------------------------------------------------------------} @@ -1257,6 +1262,8 @@ begin i:=FApplicationHandlers[ahtKeyDownAfter].Count; while FApplicationHandlers[ahtKeyDownAfter].NextDownIndex(i) do TKeyEvent(FApplicationHandlers[ahtKeyDownAfter][i])(Sender,Key,Shift); + if (Shift=[]) and (Key=VK_F1) then + ShowHelpForObjecct(Sender); end; procedure TApplication.ControlKeyDown(Sender: TObject; var Key: Word; diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 9846017f8a..1282daa553 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -3055,6 +3055,30 @@ begin if ActionLink <> nil then ActionLink.Update; end; +procedure TControl.ShowHelp; +begin + if HelpType=htContext then begin + if HelpContext<>0 then begin + Application.HelpContext(Self,ClientToScreen(Point(0,0)),HelpContext); + exit; + end; + end else begin + if HelpKeyword<>'' then begin + Application.HelpKeyword(Self,ClientToScreen(Point(0,0)),HelpKeyword); + exit; + end; + end; + if Parent<>nil then Parent.ShowHelp; +end; + +function TControl.HasHelp: Boolean; +begin + if HelpType=htContext then + Result:=HelpContext<>0 + else + Result:=HelpKeyword<>''; +end; + {------------------------------------------------------------------------------ procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect); diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index e1dd00be67..a16769e83d 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -1673,29 +1673,11 @@ end; This function is called by the interface. ------------------------------------------------------------------------------} procedure TCustomForm.IntfHelp(AComponent: TComponent); -var - AControl: TControl; begin if csDesigning in ComponentState then exit; if AComponent is TControl then begin - AControl:=TControl(AComponent); - repeat - if AControl.HelpType=htContext then begin - if AControl.HelpContext<>0 then begin - Application.HelpContext(Self,AControl.ClientToScreen(Point(0,0)), - AControl.HelpContext); - exit; - end; - end else begin - if AControl.HelpKeyword<>'' then begin - Application.HelpKeyword(Self,AControl.ClientToScreen(Point(0,0)), - AControl.HelpKeyword); - exit; - end; - end; - AControl:=AControl.Parent; - until AControl=nil; + TControl(AComponent).ShowHelp; end else begin DebugLn('TCustomForm.IntfHelp TODO help for ',DbgSName(AComponent)); end; diff --git a/lcl/lazhelphtml.pas b/lcl/lazhelphtml.pas index cc77301284..becebaa985 100644 --- a/lcl/lazhelphtml.pas +++ b/lcl/lazhelphtml.pas @@ -79,9 +79,16 @@ type property BrowserParams: string read FBrowserParams write SetBrowserParams; end; + +procedure Register; implementation +procedure Register; +begin + RegisterComponents('System',[THTMLHelpDatabase,THTMLBrowserHelpViewer]); +end; + { THTMLHelpDatabase } procedure THTMLHelpDatabase.SetBaseURL(const AValue: string); diff --git a/packager/registerlcl.pas b/packager/registerlcl.pas index 04d2026a35..40d9c2925c 100644 --- a/packager/registerlcl.pas +++ b/packager/registerlcl.pas @@ -42,7 +42,8 @@ uses Menus, Buttons, StdCtrls, ExtCtrls, ComCtrls, Forms, Grids, Controls, Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst, PairSplitter, ExtDlgs, StdActns, DBCtrls, DBGrids, DBActns, EditBtn, ActnList, FileCtrl, ButtonPanel, - LResources, XMLPropStorage, IniPropStorage, Graphics, Chart, ColorBox; + LResources, XMLPropStorage, IniPropStorage, Graphics, Chart, ColorBox, + LazHelpHTML; procedure Register; @@ -80,6 +81,7 @@ begin RegisterUnit('ColorBox',@ColorBox.Register); RegisterUnit('ButtonPanel',@ButtonPanel.Register); RegisterUnit('LResources',@LResources.Register); + RegisterUnit('LazHelpHTML',@LazHelpHTML.Register); end; end.