d6onhelpfix.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

  Result := False;
end;


function TWinHelpTester.GetHelpStrings(const ALink: string): TStringList;
begin
  Result := TStringList.Create;
end;


{Used by HelpeViewer 1 for Linux - ignored for now}
function TWinHelpTester.GetHelpPath: string;
begin
  Result := '';
end;

{This will do for now - Not too important if using OnHelp}
function TWinHelpTester.GetDefaultHelpFile: string;
begin
  Result := '';
  if Assigned(HelpViewer) then
    Result := HelpViewer.HelpFile('');
end;


{----------------------------------------------------------------------------}
{ THTMLHelpViewer                                                            }
{----------------------------------------------------------------------------}

constructor THTMLHelpViewer.Create;
begin
  inherited Create;
end;

destructor THTMLHelpViewer.Destroy;
begin
  inherited Destroy;
end;


function THTMLHelpViewer.HelpFile(const Name: String): String;
var
  FileName : String;
begin
  if (Name = '') and Assigned(FHelpManager) then
    FileName := HelpManager.GetHelpFile
  else
    FileName := Name;
  Result := FileName;
end;


{ InternalShut Down is called from unit finalization if the unit is exiting
  and the Help Manager needs to be informed. }

procedure THTMLHelpViewer.InternalShutDown;
begin
  SoftShutDown;
  if Assigned(FHelpManager) then
  begin
    HelpManager.Release(ViewerID);
    if Assigned(FHelpManager) then HelpManager := nil;
  end;
end;

{ Send the HELP_SETPOPUP_POS command
  just before a Context help call. }

procedure THTMLHelpViewer.HelpCommand_HELP_SETPOPUP_POS;
var
  Control: TWinControl;
  Pt: TSmallPoint;

  function ControlHasHelp(const Control: TWinControl) : Boolean;
  begin
    Result := false;
    if (Control.HelpType = htContext) and (Control.HelpContext <> 0)
      then Result := true
    else if (Control.HelpType = htKeyword) and (Control.HelpKeyword <> '') then
      Result := true;
  end;

begin
  {This is not the best - since F1 press could have come from a memu -- no way of telling}
  Control := Screen.ActiveControl;
  while (Control <> nil) and ( not ControlHasHelp(Control)) do
    Control := Control.Parent;
  if Control <> nil then begin
    Pt := PointToSmallPoint(Control.ClientToScreen(Point(0, 0)));
    Application.HelpCommand(HELP_SETPOPUP_POS, Longint(Pt));
  end;
end;


{----------------------------------------------------------------------------}
{ THTMLHelpViewer - ICustomHelpViewer                                        }
{----------------------------------------------------------------------------}

function THTMLHelpViewer.GetViewerName : String;
begin
  Result := ViewerName;
end;

{ UnderstandsKeyword is a querying function that the Help Manager calls to
  determine if the Viewer provide helps on a particular keyword string. }
function THTMLHelpViewer.UnderstandsKeyword(const HelpString: String): Integer;
begin
  Result := 1;
end;

{ GetHelpStrings is used by the Help Manager to display a list of keyword
  matches from which an application's user can select one. It assumes
  that the String List is properly allocated, so this function should
  never return nil. }

function THTMLHelpViewer.GetHelpStrings(const HelpString: String): TStringList;
begin
  Result := TStringList.Create;
  Result.Add(GetViewerName + ': ' + HelpString);
end;


{ CanShowTableOfContents is a querying function that the Help Manager
  calls to determine if the Viewer supports tables of contents. WinHelp
  and HyperHelp both do. }

function THTMLHelpViewer.CanShowTableOfContents : Boolean;
begin
  Result := true;
end;


{ ShowTableOfContents is a command function that the Help Manager uses
  to direct the Viewer to display a table of contents. It is never
  called without being preceded by a call to CanShowTableOfContents. }

procedure THTMLHelpViewer.ShowTableOfContents;
begin
  { The Fix!! - data ignored we set to zero}
  Application.HelpCommand(HELP_CONTENTS, 0);
end;


{ ShowHelp is the function that the Help Manager calls to request that
  a Help Viewer display help for a given keyword. }
procedure THTMLHelpViewer.ShowHelp(const HelpString: String);
var
  HelpCommand: array[0..255] of Char;
begin
  StrLFmt(HelpCommand, SizeOf(HelpCommand) -1, '%s', [HelpString]);

  { The Fix!! }
  Self.HelpCommand_HELP_SETPOPUP_POS;
  Application.HelpCommand(HELP_KEY, Longint(@HelpCommand));
end;


{ NotifyID is called by the Help Manager after a successful registration
  to provide the Help Viewer with a cookie which uniquely identifies the
  Viewer to the Manager, and can be used in communications between the two. }

procedure THTMLHelpViewer.NotifyID(const ViewerID: Integer);
begin
  FViewerID := ViewerID;
end;

{ SoftShutDown is called by the help manager to ask the viewer to
  terminate any externally spawned subsystem without shutting itself down. }

procedure THTMLHelpViewer.SoftShutDown;
begin
  { The Fix!! }
  {rob: Commented this out - caused an error on a user in Win98}
  //Application.HelpCommand(HELP_QUIT, 0);
end;

procedure THTMLHelpViewer.ShutDown;
begin
  SoftShutDown;
  if Assigned(FHelpManager) then HelpManager := nil;
end;

{----------------------------------------------------------------------------}
{ THTMLHelpViewer --- IExtendedHelpViewer                                     }
{----------------------------------------------------------------------------}

{ UnderstandsTopic is called by the Help Manager to ask if the Viewer
  is capable of displaying a topic-based help query for a given topic. }

function THTMLHelpViewer.UnderstandsTopic(const Topic: String): Boolean;
begin
  Result := true;
end;

{ DisplayTopic is called by the Help Manager if a Help Viewer claims
  in its response to UnderstandsTopic to be able to provide Topic-based
  help for a particular keyword. }

procedure THTMLHelpViewer.DisplayTopic(const Topic: String);
var
  HelpCommand: array[0..255] of Char;
begin
  StrLFmt(HelpCommand, SizeOf(HelpCommand) -1, '%s', [Topic + 'zzz']);

  { The Fix!! }
  Self.HelpCommand_HELP_SETPOPUP_POS;
  Application.HelpCommand(HELP_KEY, Longint(@HelpCommand));
end;


{ UnderstandsContext is a querying function called by the Help Manager
  to determine if an Extended Help Viewer is capable of providing
  help for a particular context-ID. }

function THTMLHelpViewer.UnderstandsContext(const ContextID: Integer;
                                           const HelpFileName: String): Boolean;
begin
  Result := true;
end;


{ DisplayHelpByContext is used by the Help Manager to request that a
  Help Viewer display help for a particular Context-ID. }

procedure THTMLHelpViewer.DisplayHelpByContext(const ContextID: Integer; const HelpFileName: String);
var SaveWinHelpTester: IWinHelpTester;
begin
  { The Fix!! }
  Self.HelpCommand_HELP_SETPOPUP_POS;
  { 9-Jan-2003: RWC: Stop recursion when HLP file used, by saving state - Thanks Paul van der Eijk for the fix}
  SaveWinHelpTester := WinHelpViewer.WinHelpTester;
  WinHelpViewer.WinHelpTester := nil;
  Application.HelpCommand(HELP_CONTEXT, ContextID);
  WinHelpViewer.WinHelpTester := SaveWinHelpTester;
end;




//{----------------------------------------------------------------------------}
//{ THTMLHelpViewer --- ISpecialWinHelpViewer                                   }
//{----------------------------------------------------------------------------}
//
//function THTMLHelpViewer.CallWinHelp(Handle: LongInt; const HelpFileName: String;
//                                    Command: Word; Data: LongInt) : Boolean;
//begin
//  Result := false;
//end;


{ Uses this function to enable or disable WinHelpViewer.WinHelpTester.
  WinHelpTester is enabled when you use this module (viewer 2). It
  is used to stop Viewer 1 being favoured by the HelpManager.
  If you need to call a WinHelp function (viewer 1 needed) then
  you would need to disable winhelptester for that call.
  See Delphi source WinHelpViewer.pas for where WinHelpTester is used.

  Note: WinHelpTester is set to Nil by WinHelpViewer cleanup
}
procedure WinHelpTester_Enable(aEnable: Boolean);
begin
  {Enable WinHelpTester - ie. Make HelpManager use this viewer}
  if aEnable then begin
    if not Assigned(WinHelpViewer.WinHelpTester) then
      WinHelpViewer.WinHelpTester := TWinHelpTester.Create;
  end
  {Disable WinHelpTester - ie. Make HelpManager use WinHelpViewer again}
  else begin
    if Assigned(WinHelpViewer.WinHelpTester) then
      WinHelpViewer.WinHelpTester := Nil;
  end;
end;


{============================================================================}

initialization
  WinHelpTester_Enable(true);
  HelpSelector := THelpSelector.Create;                  //set to Nil by HelpIntfs cleanup
  HelpViewer := THTMLHelpViewer.Create;
  Application.HelpSystem.AssignHelpSelector(HelpSelector);
  HelpIntfs.RegisterViewer(HelpViewer {ICustomHelpViewer}, HelpViewer.FHelpManager {IHelpManager});
//  HelpSelector._Release; //16-Jan-2003: RWC - Daniel Waeber added this line - but safer to put up with a tiny memory leak - this fix may not be compatible with V7 or future versions
finalization
  if Assigned(HelpViewer.FHelpManager) then
  begin
    HelpViewer.InternalShutDown;
  end;

  //added by Gerold Veith to prevent Memory Leak (at least I hope so)
  HelpSelector := nil;
end.