More support for a help system

* Implemented InvokeHelp in TfpgWidget
* implemented InvokeHelp and OnHelp event in TfpgForm
* Implemented HelpConext, HelpKeyword and HelpType in TfpgComponent

3 files changed, 97 insertions, 16 deletions

diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas
index 52a83050..838b43fb 100644
--- a/src/corelib/fpg_base.pas
+++ b/src/corelib/fpg_base.pas
@@ -372,8 +372,19 @@ type
   TfpgComponent = class(TComponent)
   private
     FTagPointer: Pointer;
+    FHelpContext: THelpContext;
+    FHelpKeyword: TfpgString;
+    FHelpType: THelpType;
+  protected
+    procedure   SetHelpContext(const AValue: THelpContext); virtual;
+    procedure   SetHelpKeyword(const AValue: TfpgString); virtual;
   public
+    constructor Create(AOwner: TComponent); override;
     property    TagPointer: Pointer read FTagPointer write FTagPointer;
+  published
+    property    HelpContext: THelpContext read FHelpContext write SetHelpContext default 0;
+    property    HelpKeyword: TfpgString read FHelpKeyword write SetHelpKeyword;
+    property    HelpType: THelpType read FHelpType write FHelpType default htKeyword;
   end;
 
 
@@ -460,16 +471,11 @@ type
   end;
 
 
-  { TfpgApplicationBase }
-
-  TfpgApplicationBase = class(TComponent)
+  TfpgApplicationBase = class(TfpgComponent)
   private
     FMainForm: TfpgWindowBase;
     FTerminated: boolean;
     FCritSect: TCriticalSection;
-    FHelpType: THelpType;
-    FHelpContext: THelpContext;
-    FHelpWord: TfpgString;
     FHelpKey: word;
     FHelpFile: TfpgString;
     function    GetForm(Index: Integer): TfpgWindowBase;
@@ -500,15 +506,13 @@ type
     procedure   Lock;
     procedure   Unlock;
     procedure   InvokeHelp;
-    function    ContextHelp(const HelpContext: THelpContext): Boolean;
-    function    KeywordHelp(const HelpKeyword: string): Boolean;
+    function    ContextHelp(const AHelpContext: THelpContext): Boolean;
+    function    KeywordHelp(const AHelpKeyword: string): Boolean;
     property    FormCount: integer read GetFormCount;
     property    Forms[Index: Integer]: TfpgWindowBase read GetForm;
-    property    HelpContext: THelpContext read FHelpContext write FHelpContext;
+    property    HelpContext: THelpContext read FHelpContext write SetHelpContext;
     property    HelpFile: TfpgString read GetHelpFile write FHelpFile;
     property    HelpKey: word read FHelpKey write FHelpKey default keyF1;
-    property    HelpType: THelpType read FHelpType write FHelpType default htContext;
-    property    HelpWord: TfpgString read FHelpWord write FHelpWord;
     property    IsInitialized: boolean read FIsInitialized;
     property    TopModalForm: TfpgWindowBase read GetTopModalForm;
     property    MainForm: TfpgWindowBase read FMainForm write FMainForm;
@@ -2209,17 +2213,18 @@ end;
 
 procedure TfpgApplicationBase.InvokeHelp;
 begin
+  { TODO -oGraeme -cHelp System : We should probably try ActiveForm and ActiveWidget help first. }
   if HelpType = htKeyword then
-    KeywordHelp(HelpWord)
+    KeywordHelp(HelpKeyword)
   else
     ContextHelp(HelpContext);
 end;
 
-function TfpgApplicationBase.ContextHelp(const HelpContext: THelpContext): Boolean;
+function TfpgApplicationBase.ContextHelp(const AHelpContext: THelpContext): Boolean;
 var
   p: TProcess;
 begin
-  { TODO -oGraeme : Support HelpContext in docview }
+  { TODO -oGraeme -cHelp System : Support AHelpContext in docview }
   p := TProcess.Create(nil);
   try
     if fpgFileExists(HelpFile) then
@@ -2232,11 +2237,11 @@ begin
   end;
 end;
 
-function TfpgApplicationBase.KeywordHelp(const HelpKeyword: string): Boolean;
+function TfpgApplicationBase.KeywordHelp(const AHelpKeyword: string): Boolean;
 var
   p: TProcess;
 begin
-  { TODO -oGraeme : Support HelpKeyword in docview }
+  { TODO -oGraeme -cHelp System : Support AHelpKeyword in docview }
   p := TProcess.Create(nil);
   try
     if fpgFileExists(HelpFile) then
@@ -2559,5 +2564,32 @@ begin
   FEntries := newl;
 end;
 
+{ TfpgComponent }
+
+procedure TfpgComponent.SetHelpContext(const AValue: THelpContext);
+begin
+  if not (csLoading in ComponentState) then
+    FHelpType := htContext;
+  if FHelpContext = AValue then
+    Exit; //==>
+  FHelpContext := AValue;
+end;
+
+procedure TfpgComponent.SetHelpKeyword(const AValue: TfpgString);
+begin
+  if not (csLoading in ComponentState) then
+    FHelpType := htKeyword;
+  if FHelpKeyword = AValue then
+    Exit; //==>
+  FHelpKeyword := AValue;
+end;
+
+constructor TfpgComponent.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FHelpType     := htKeyword;
+  FHelpContext  := 0;
+end;
+
 end.
 
diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas
index 3e786aca..f906b8bc 100644
--- a/src/corelib/fpg_widget.pas
+++ b/src/corelib/fpg_widget.pas
@@ -135,6 +135,7 @@ type
     function    GetClientRect: TfpgRect; virtual;
     function    GetBoundsRect: TfpgRect; virtual;
     function    InDesigner: boolean;
+    procedure   InvokeHelp; virtual;
     procedure   Realign;
     procedure   SetFocus;
     procedure   KillFocus;
@@ -337,6 +338,28 @@ begin
   Result := (FFormDesigner <> nil)
 end;
 
+procedure TfpgWidget.InvokeHelp;
+begin
+  case HelpType of
+    htKeyword:
+      if HelpKeyword <> '' then
+      begin
+        fpgApplication.KeywordHelp(HelpKeyword);
+        Exit; //==>
+      end;
+    htContext:
+      if HelpContext <> 0 then
+      begin
+        fpgApplication.ContextHelp(HelpContext);
+        Exit; //==>
+      end;
+  end;
+  if Parent <> nil then
+    Parent.InvokeHelp
+  else
+    fpgApplication.InvokeHelp;
+end;
+
 procedure TfpgWidget.Realign;
 begin
   HandleAlignments(0, 0);
diff --git a/src/gui/fpg_form.pas b/src/gui/fpg_form.pas
index 8c2545c1..a0a4c342 100644
--- a/src/gui/fpg_form.pas
+++ b/src/gui/fpg_form.pas
@@ -34,6 +34,9 @@ type
   
   TFormCloseEvent = procedure(Sender: TObject; var CloseAction: TCloseAction) of object;
   TFormCloseQueryEvent = procedure(Sender: TObject; var CanClose: boolean) of object;
+  TfpgHelpEvent = function(AHelpType: THelpType; AHelpContext: THelpContext;
+       const AHelpKeyword: String; const AHelpFile: String;
+       var AHandled: Boolean): Boolean of object;
 
 
   TfpgBaseForm = class(TfpgWidget)
@@ -47,6 +50,7 @@ type
     FOnDestroy: TNotifyEvent;
     FOnHide: TNotifyEvent;
     FOnShow: TNotifyEvent;
+    FOnHelp: TfpgHelpEvent;
   protected
     FModalResult: TfpgModalResult;
     FParentForm: TfpgBaseForm;
@@ -67,6 +71,7 @@ type
     procedure   HandleResize(awidth, aheight: TfpgCoord); override;
     procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
     procedure   DoOnClose(var CloseAction: TCloseAction); virtual;
+    function    DoOnHelp(AHelpType: THelpType; AHelpContext: THelpContext; const AHelpKeyword: String; const AHelpFile: String; var AHandled: Boolean): Boolean; virtual;
     // properties
     property    Sizeable: boolean read FSizeable write FSizeable;
     property    ModalResult: TfpgModalResult read FModalResult write FModalResult;
@@ -80,6 +85,7 @@ type
     property    OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
     property    OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
     property    OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
+    property    OnHelp: TfpgHelpEvent read FOnHelp write FOnHelp;
     property    OnHide: TNotifyEvent read FOnHide write FOnHide;
     property    OnShow: TNotifyEvent read FOnShow write FOnShow;
   public
@@ -88,6 +94,7 @@ type
     procedure   AfterConstruction; override;
     procedure   BeforeDestruction; override;
     procedure   AfterCreate; virtual;
+    procedure   InvokeHelp; override;
     procedure   Show;
     procedure   Hide;
     function    ShowModal: integer;
@@ -262,6 +269,18 @@ begin
   // for the user
 end;
 
+procedure TfpgBaseForm.InvokeHelp;
+var
+  lEventHandled: Boolean;
+  lSucceeded: Boolean;
+begin
+  lEventHandled := False;
+  lSucceeded := False;
+  lSucceeded := DoOnHelp(HelpType, HelpContext, HelpKeyword, fpgApplication.HelpFile, lEventHandled);
+  if (not lSucceeded) or (not lEventHandled) then
+    inherited InvokeHelp;
+end;
+
 procedure TfpgBaseForm.Show;
 begin
   FVisible := True;
@@ -388,6 +407,13 @@ begin
     OnClose(self, CloseAction);
 end;
 
+function TfpgBaseForm.DoOnHelp(AHelpType: THelpType; AHelpContext: THelpContext;
+  const AHelpKeyword: String; const AHelpFile: String; var AHandled: Boolean): Boolean;
+begin
+  if Assigned(FOnHelp) then
+    Result := FOnHelp(AHelpType, AHelpContext, AHelpKeyword, AHelpFile, AHandled);
+end;
+
 procedure TfpgBaseForm.Hide;
 begin
   Visible := False;