作为单独的进程启动 HTML 帮助

Launch HTML Help as Separate Process

我正在使用 XE7 64,我正在寻找一种策略来解决在我的应用程序中显示 HTMLHelp 文件时遇到的几个问题(我已将 HTMLHelpViewer 添加到我的 uses 子句中)。问题如下: 1) Ctrl-c 不从主题中复制文本; 2) 模态对话框处于活动状态时无法访问帮助查看器。

问题的根源可能是与应用程序在同一进程中的 htmlhelpviewer 运行。有没有办法让内置的 htmlhelpviewer 启动一个新进程?如果没有,那么我是否需要使用 Createprocess 启动 HH.EXE?

根据 David 的评论,他直接调用 HtmlHelp 并且没有遇到上述问题,我尝试了该方法并解决了问题。直接调用HTMLHelp通过id打开主题示例:

HtmlHelp(Application.Handle,'d:\help study\MyHelp.chm', 
         HH_HELP_CONTEXT, 70);

您可以将帮助文件查看器作为一个单独的进程启动,但我认为这会使控制它变得更加复杂。我的猜测是提供的 HTML 帮助查看器代码是问题的根本原因。我一直发现该代码质量极低。

我通过实现附加到 Application 对象的 OnHelp 事件处理程序来处理这个问题。此事件处理程序直接调用 HtmlHelp API。我当然没有遇到您描述的任何问题。

我的代码如下所示:

unit Help;

interface

uses
  SysUtils, Classes, Windows, Messages, Forms;

procedure ShowHelp(HelpContext: THelpContext);
procedure CloseHelpWindow;

implementation

function RegisterShellHookWindow(hWnd: HWND): BOOL; stdcall; external user32;
function DeregisterShellHookWindow(hWnd: HWND): BOOL; stdcall; external user32;

procedure ShowHelp(HelpContext: THelpContext);
begin
  Application.HelpCommand(HELP_CONTEXTPOPUP, HelpContext);
end;

type
  THelpWindowManager = class
  private
    FMessageWindow: HWND;
    FHelpWindow: HWND;
    FHelpWindowLayoutPreference: TFormLayoutPreference;
    function ApplicationHelp(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
  protected
    procedure WndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    procedure RestorePosition;
    procedure StorePosition;
    procedure StorePositionAndClose;
  end;

{ THelpWindowManager }

constructor THelpWindowManager.Create;

  function DefaultRect: TRect;
  var
    i, xMargin, yMargin: Integer;
    Monitor: TMonitor;
  begin
    Result := Rect(20, 20, 1000, 700);
    for i := 0 to Screen.MonitorCount-1 do begin
      Monitor := Screen.Monitors[i];
      if Monitor.Primary then begin
        Result := Monitor.WorkareaRect;
        xMargin := Monitor.Width div 20;
        yMargin := Monitor.Height div 20;
        inc(Result.Left, xMargin);
        dec(Result.Right, xMargin);
        inc(Result.Top, yMargin);
        dec(Result.Bottom, yMargin);
        break;
      end;
    end;
  end;

begin
  inherited;
  FHelpWindowLayoutPreference := TFormLayoutPreference.Create('Help Window', DefaultRect, False);
  FMessageWindow := AllocateHWnd(WndProc);
  RegisterShellHookWindow(FMessageWindow);
  Application.OnHelp := ApplicationHelp;
end;

destructor THelpWindowManager.Destroy;
begin
  StorePositionAndClose;
  Application.OnHelp := nil;
  DeregisterShellHookWindow(FMessageWindow);
  DeallocateHWnd(FMessageWindow);
  FreeAndNil(FHelpWindowLayoutPreference);
  inherited;
end;

function THelpWindowManager.ApplicationHelp(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
var
  hWndCaller: HWND;
  HelpFile: string;
  DoSetPosition: Boolean;
begin
  CallHelp := False;
  Result := True;

  //argh, WinHelp commands
  case Command of
  HELP_CONTEXT,HELP_CONTEXTPOPUP:
    begin
      hWndCaller := GetDesktopWindow;
      HelpFile := Application.HelpFile;

      DoSetPosition := FHelpWindow=0;//i.e. if the window is not currently showing
      FHelpWindow := HtmlHelp(hWndCaller, HelpFile, HH_HELP_CONTEXT, Data);
      if FHelpWindow=0 then begin
        //the topic may not have been found because the help file isn't there...
        if FileExists(HelpFile) then begin
          ReportError('Cannot find help topic for selected item.'+sLineBreak+sLineBreak+'Please report this error message to Orcina.');
        end else begin
          ReportErrorFmt(
            'Cannot find help file (%s).'+sLineBreak+sLineBreak+'Reinstalling the program may fix this problem.  '+
            'If not then please contact Orcina for assistance.',
            [HelpFile]
          );
        end;
      end else begin
        if DoSetPosition then begin
          RestorePosition;
        end;
        HtmlHelp(hWndCaller, HelpFile, HH_DISPLAY_TOC, 0);//ensure that table of contents is showing
      end;
    end;
  end;
end;

procedure THelpWindowManager.RestorePosition;
begin
  if FHelpWindow<>0 then begin
    RestoreWindowPosition(FHelpWindow, FHelpWindowLayoutPreference);
  end;
end;

procedure THelpWindowManager.StorePosition;
begin
  if FHelpWindow<>0 then begin
    StoreWindowPosition(FHelpWindow, FHelpWindowLayoutPreference);
  end;
end;

procedure THelpWindowManager.StorePositionAndClose;
begin
  if FHelpWindow<>0 then begin
    StorePosition;
    SendMessage(FHelpWindow, WM_CLOSE, 0, 0);
    FHelpWindow := 0;
  end;
end;

var
  WM_SHELLHOOKMESSAGE: UINT;

procedure THelpWindowManager.WndProc(var Message: TMessage);
begin
  if (Message.Msg=WM_SHELLHOOKMESSAGE) and (Message.WParam=HSHELL_WINDOWDESTROYED) then begin
    //need cast to HWND to avoid range errors
    if (FHelpWindow<>0) and (HWND(Message.LParam)=FHelpWindow) then begin
      StorePosition;
      FHelpWindow := 0;
    end;
  end;
  Message.Result := DefWindowProc(FMessageWindow, Message.Msg, Message.wParam, Message.lParam);
end;

var
  HelpWindowManager: THelpWindowManager;

procedure CloseHelpWindow;
begin
  HelpWindowManager.StorePositionAndClose;
end;

initialization
  if not ModuleIsPackage then begin
    Application.HelpFile := ChangeFileExt(Application.ExeName, '.chm');
    WM_SHELLHOOKMESSAGE := RegisterWindowMessage('SHELLHOOK');
    HelpWindowManager := THelpWindowManager.Create;
  end;

finalization
  FreeAndNil(HelpWindowManager);

end.

在您的项目中包括该单元,您将被连接起来处理帮助上下文请求。对代码的一些评论:

  1. OnHelp 事件处理程序的实现仅限于我的需要。如果您需要更多功能,则必须自己添加。
  2. 你不会有 TFormLayoutPrefernce。这是我的偏好之一 类 管理每个用户的偏好。它存储 window 的边界矩形,以及 window 是否最大化。这用于确保帮助 window 显示在与上一个会话中显示的位置相同的位置。如果您不想要这样的功能,请将其删除。
  3. ReportErrorReportErrorFmt 是我用来显示错误对话框的辅助函数。您可以将它们替换为对 MessageBox 或类似内容的调用。