added Help to TApplication, disable it with Application.Navigation-[anoF1ForHelp]

git-svn-id: trunk@9281 -

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;

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;

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;
 

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;
+    Result := ShowHelpOrErrorForContext('',Context)=shrSuccess;
-    //HelpSystem.ShowContextHelp(Context, GetCurrentHelpFile);
   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;
+    Result := ShowHelpOrErrorForKeyword('',Keyword)=shrSuccess;
-    //HelpSystem.ShowHelp(Keyword, GetCurrentHelpFile);
   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;

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);
   

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);
+    TControl(AComponent).ShowHelp;
-    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;
   end else begin
     DebugLn('TCustomForm.IntfHelp TODO help for ',DbgSName(AComponent));
   end;

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);

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.