winhelpviewer.pas

这是不可多得的源代码

              LongInt(PChar(HelpCmd)));
    end;
  end;
end;
{$ENDIF}
{$IFDEF LINUX}
procedure TWinHelpViewer.ShowHelp(const HelpString: String);
const
  Macro = 'AL(%0s,3,,%1s)'; 
var
  HelpCmd : String;
  FileName: String;
begin
  HelpCmd := Format(Macro, [HelpString, HyperHelpWindowName]);
  FileName := HelpFile('');
  if (IsNewQuery(twhCommand, HelpCmd, 0)) and (FileName <> '') then
  begin
    FLastCommandType := twhCommand;
    FLastCommand := HelpCmd;
    WinHelp(HelpManager.GetHandle, PChar(FileName), HELP_COMMAND,
            LongInt(Pchar(HelpCmd)));
  end;
end;
{$ENDIF}

{ 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 TWinHelpViewer.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 TWinHelpViewer.SoftShutDown;
begin
  FLastCommandType := twhQuit;
  WinHelp(0, PChar(''), HELP_QUIT, 0);
end;

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

{-----------------------------------------------------------------------------}
{ TWinHelpViewer --- 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. 
  Its default behavior, like all default behaviors in this file, is 
  opposite for Windows than it is for linux. }

function TWinHelpViewer.UnderstandsTopic(const Topic: String): Boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := true;
  {$ENDIF}
  {$IFDEF LINUX}
  Result := false;
  {$ENDIF}
  { after setting the defaults, if there's a Tester, ask it. }
  if Assigned(WinHelpTester) then
    Result := WinHelpTester.CanShowTopic(Topic, HelpFile(''));
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 TWinHelpViewer.DisplayTopic(const Topic: String);
var
  HelpCommand: array[0..255] of Char;
  FileName: String;
begin
  { note that because HelpCommand is of a fixed-size, ridiculously long
    topic strings will result in errors from WinHelp/HyperHelp. }
  StrLFmt(HelpCommand, SizeOf(HelpCommand) -1, 'JumpID("","%s")', [Topic]);

  FileName := HelpFile('');
  if MakeWinHelpHappy then
  begin
    if (IsNewQuery(twhCommand, HelpCommand, 0)) and (FileName <> '') then
    begin
      FLastCommandType := twhCommand;
      FLastCommand := HelpCommand;
      WinHelp(HelpManager.GetHandle, PChar(FileName), HELP_COMMAND,
              Longint(@HelpCommand));
    end;
  end;
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. Like all querying functions in
  this file, the default behavior is opposite --- YES for windows,
  NO for linux --- and the Tester is asked, if available. }
function TWinHelpViewer.UnderstandsContext(const ContextID: Integer;
                                           const HelpFileName: String): Boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := True;
  {$ENDIF}
  {$IFDEF LINUX}
  Result := False;
  {$ENDIF}
  if Assigned(WinHelpTester) then
    Result := WinHelpTester.CanShowContext(ContextID, HelpFile(HelpFileName));
end;

{ DisplayHelpByContext is used by the Help Manager to request that a 
  Help Viewer display help for a particular Context-ID. It is only
  invoked after a successful call to CanShowContext. }
procedure TWinHelpViewer.DisplayHelpByContext(const ContextID: Integer;
                                              const HelpFileName: String);
var
   FileName: String;
begin
   FileName := HelpFile(HelpFileName);
   if MakeWinHelpHappy then
   begin
     if IsNewQuery(twhContext, '', ContextID) and (FileName <> '') then
     begin 
       FLastCommandType := twhContext;
       FLastContext := ContextID;
       WinHelp(HelpManager.GetHandle, PChar(FileName), 
               HELP_CONTEXT, ContextID);
       
     end;
   end;
end;

{----------------------------------------------------------------------------}
{ TWinHelpViewer --- ISpecialWinHelpViewer }

{ CallWinHelp is called by the Help Manager when it recieves WinHelp-style
  help requests from external systems and is not able to deconstruct them
  into something meaningful for non-winhelp specific viewers. These
  get forwarded on to WinHelp in *all* circumstances. HyperHelp may
  not support some of these functions, and will issue an error complaint
  in that case. }
function TWinHelpViewer.CallWinHelp(Handle: LongInt; const HelpFileName: String; 
                                    Command: Word; Data: LongInt) : Boolean;
var
  Calling : Boolean;
begin
  Result := False;
  if MakeWinHelpHappy then
  begin
    if (Command = 258 { HELP_COMMAND }) or
    (Command = 261 { HELP_PARTIALKEY}) or
    (Command = 513 { HELP_MULTIKEY}) or
    (Command = 10 { HELP_CONTEXTMENU}) or
    (Command = 8 { HELP_CONTEXTPOPUP}) or
    (Command = 1 { HELP_CONTEXT }) or
    (Command = 257 { HELP_KEY}) then
      Calling := IsNewQuery(twhCommand, IntToStr(Command), 0)
    else 
      Calling := True;
    if Calling then 
    begin
      FLastCommandType := twhCommand;
      FLastCommand := IntToStr(Command);
      Result := WinHelp(Handle, PChar(HelpFile(HelpFileName)), Command, Data);
    end;
  end;
end;

{----------------------------------------------------------------------------}
{ TWinHelpViewer internal support methods }

{$IFDEF MSWINDOWS}
{ These functions will not work with HyperHelp, because HyperHelp does not
  run under the WINE subsystem. These functions may only be invoked from code
  intended to run under Windows.}
function WindowEnumerationTester(wnd: HWnd; 
                                 var Info: TWinHelpFinder): Bool; stdcall;
var
  Buf: array [Byte] of Char;
begin
  GetClassName(wnd, Buf, sizeof(Buf));
  if (StrIComp(Buf, 'MS_WINHELP') = 0) then
  begin
    Info.HelpWnd := Wnd;
    Info.FoundMainWindow := True;
  end;
  Result := not Info.FoundMainWindow;
end;

function DialogEnumerationTester(wnd: HWnd; 
                                 var Info: TWinHelpFinder): Bool; stdcall;
var
  Buf: Array [Byte] of Char;
begin
  GetClassName(wnd, Buf, sizeof(Buf));
  if (StrComp(Buf, '#32770') = 0) then
  begin
    Info.FoundDialog := True;
    Info.DialogWnd := Wnd;
  end;
  Result := not Info.FoundDialog;
end;
{$ENDIF}

function FindWinHelp: TWinHelpFinder;
begin
{$IFDEF MSWINDOWS}
  Result.FoundMainWindow := False;
  Result.FoundDialog := False;
  Result.HelpWnd := 0;
  EnumWindows(@WindowEnumerationTester, Integer(@Result));
{$ENDIF}
end;


function TWinHelpViewer.IsNewQuery(QueryType: TWHCommandType; Command: String; Context: Integer): Boolean;
var
  WndHelpFinder : TWinHelpFinder;
begin
  Result := True;
  WndHelpFinder := FindWinHelp;
  if WndHelpFinder.FoundMainWindow and (QueryType = FLastCommandType) then
    case QueryType of
      twhCommand:
       Result := (CompareStr(Command, FLastCommand) <> 0);
      twhContext:
       Result := Context <> FLastContext;
    end;
end;

{ Note --- the following two methods will work in Linux but is semantically
  devoid of meaningless. If you find yourself tempted to use them, please
  reconsider, and be sure that the TWinHelpFinder you pass is meaningful.}
function TWinHelpViewer.IsBusyWindow(WndInfo: TWinHelpFinder): Boolean;
begin
  Result := False;{
  if (WndInfo.HelpWnd <> 0) and (not IsWindowVisible(WndInfo.HelpWnd)) then 
    Result := true;}
end;

function TWinHelpViewer.CouldBeUnstableWindow(WndInfo: TWinHelpFinder): Boolean;
begin
  Result := (not WndInfo.FoundDialog);
  { also check here for version number. }
end;


function TWinHelpViewer.MakeWinHelpHappy: Boolean;
{$IFDEF MSWINDOWS}
var
  WndInfo: TWinHelpFinder;
{$ENDIF MSWINDOWS}
begin
{$IFDEF MSWINDOWS}
  Result := False;
  { first pretend we're in C. }
  { if winhelp is up, see if it has a dialog loaded. }
  WndInfo := FindWinHelp;
  if WndInfo.FoundMainWindow then
    EnumThreadWindows(GetWindowThreadProcessId(WndInfo.HelpWnd, nil),
                      @DialogEnumerationTester, Integer(@WndInfo));

  { if the window is busy, silently fail the help request rather
    than harassing WinHelp into failure. }

  if IsBusyWindow(WndInfo) then
    Exit;

  if CouldBeUnstableWindow(WndInfo) then RestartWinHelp;
{$ENDIF}
  Result := True;
end;

procedure TWinHelpViewer.RestartWinHelp;
{$IFDEF MSWINDOWS}
var
  StartTime: LongWord;
  FileName : String;
{$ENDIF MSWINDOWS}
begin
{ WinHelp has an annoying property where if it has an open dialog
  and you send it a new macro, it crashes. In addition, certain older
  versions of WinHelp exhibit similar instabilities at other times.
  This function sends a HELP_QUIT message to winhelp and then waits
  for long enough for the message to be processed and WinHelp to go away.
  WinHelp can then be restarted with a new macro. }
{$IFDEF MSWINDOWS}
  SoftShutDown;
  StartTime := GetTickCount;
  repeat
    //Application.ProcessMessages;
    Sleep(0);
  until ((GetTickCount - StartTime) > 1000);
  FileName := HelpFile('');
  if FileName <> '' then 
    WinHelp(HelpManager.GetHandle, PChar(FileName), HELP_FORCEFILE, 0);
{$ENDIF}
{$IFDEF LINUX}
  { The above code has not been tested with HyperHelp under Linux. It is
    possible that the identical code will work, but it is not guaranteed
    at this time. }
{$ENDIF}
end;

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

constructor TWinHelpViewer.Create;
begin
  inherited Create;
  HelpViewerIntf := Self;
end;

destructor TWinHelpViewer.Destroy;
begin
  HelpViewer := nil;
  inherited Destroy;
end;

initialization
  HelpViewer := TWinHelpViewer.Create;
  HelpIntfs.RegisterViewer(HelpViewerIntf, HelpViewer.FHelpManager);

finalization
  if Assigned(HelpViewer.FHelpManager) then
    HelpViewer.InternalShutDown;
  HelpViewerIntf := nil;
  WinHelpTester := nil;
end.