从TWebBrowser打印

Question

我使用以下单元通过TWebBrowser显示和打印HTML代码，该代码显示在一个非模态对话框中。在我的生产程序中，以下代码在Windows下工作，但在Windows7中失败(错误消息总是外部异常C015D00F)。为了隔离这个问题，我编写了一个简单的测试程序，其中也有一个包含TWebBrowser的非模态对话框；这个测试程序本身可以在Windows7下正常工作，但是当我将测试程序中的非模态对话框插入到生产程序中时，我会得到外部异常。

这大概表明调用程序有问题，而不是被叫的单元，但我看不出是什么问题。HTML代码是手工构建的，但显示正确。

有什么问题吗？打印代码来自Embarcadero 站点

unit Test4;

interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, OleCtrls, SHDocVw, MSHTML;

type
 THTMLPreview = class(TForm)
  web: TWebBrowser;
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure webDocumentComplete(Sender: TObject; const pDisp: IDispatch;
                                var URL: OleVariant);
  private
   options: word;
   fn: string;
   procedure DoPrint;
  public
   Constructor Create (const afn, acapt: string; opts: word);
  end;

implementation

{$R *.dfm}

constructor THTMLPreview.Create (const afn, acapt: string; opts: word);                
begin
 inherited create (nil);
 caption:= acapt;
 fn:= afn;
 options:= opts;
 web.Navigate (fn);
end;

procedure THTMLPreview.webDocumentComplete(Sender: TObject;
                 const pDisp: IDispatch; var URL: OleVariant);
begin
 DoPrint
end;

procedure THTMLPreview.DoPrint;
var
 HTMLDoc: IHTMLDocument2;
 HTMLWnd: IHTMLWindow2;
 HTMLWindow3: IHTMLWindow3;

begin
 if options and 4 = 4 then
  begin
   HTMLDoc:= web.Document as IHTMLDocument2;
   if HTMLDoc <> nil then
    begin
     HTMLWnd:= HTMLDoc.parentWindow;
     HTMLWindow3:= HTMLWnd as IHTMLWindow3;
     HTMLWindow3.print;
    end
  end
end;

procedure THTMLPreview.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if options and 1 = 1 then deletefile (fn);
 action:= caFree
end;

end.

使用语句Web.ControlInterface.ExecWB (OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut)会产生相同的错误。

几天后编辑：

我尝试了一种完全不同的方法来解决这个问题。在HTML代码中，我添加了一个javascript片段，它显示了一个“print”按钮，并添加了一个“onprint”事件。再一次，这在我的开发机器(XP)上工作得很好，但在我的客户机器(Win7)上就不行了，在这里，程序会冻结声明的外部异常C015D00F (与以前相同的地址)。

在大量搜索之后，我发现异常代码C015000F是由“被禁用的激活上下文不是最近激活的上下文”引起的。这对一个糟糕的Delphi程序员意味着什么？

Answer 1

如果我没记错，IHTMLWindow3打印方法会弹出默认的“发送到打印机”系统对话框。您是想要这个吗？对于一个应用程序，我曾经搜索过一种避免这种情况的方法，然后找到了下面的代码。

var
  r:TRect;
  sh,ph:HDC;
begin
  OleInitialize(nil);
  WebBrowser1.Navigate('file://'+HtmlFilePath);
  while WebBrowser1.ReadyState<>READYSTATE_COMPLETE do Application.HandleMessage;

  //Printer.PrinterIndex:=//set selected printer here
  Printer.BeginDoc;
  try
    Printer.Canvas.Lock;
    try
      sh:=GetDC(0);
      ph:=Printer.Canvas.Handle;

      //TODO: make rect a bit smaller for a page margin
      //TODO: get page size from printer settings, assume A4 here (210x297mm)
      r.Left:=0;
      r.Top:=0;
      r.Right:=2100 * GetDeviceCaps(sh,LOGPIXELSX) div 254;
      r.Bottom:=2970 * GetDeviceCaps(sh,LOGPIXELSY) div 254;
      WebBrowser1.BoundsRect:=r;

      SetMapMode(ph,MM_ISOTROPIC);
      SetWindowExtEx(ph,r.Right,r.Bottom,nil);
      SetViewportExtEx(ph,r.Right,r.Bottom,nil);
      r.Right:=GetDeviceCaps(ph,HORZRES)-1;
      r.Bottom:=GetDeviceCaps(ph,VERTRES)-1;

      (WebBrowser1.ControlInterface as IViewObject).Draw(
        DVASPECT_CONTENT,
        1,
        nil,nil,0,ph,@r,nil,nil,0);
    finally
      Printer.Canvas.Unlock;
    end;
    Printer.EndDoc;
  except
    Printer.Abort;
    raise;
  end;

SetWindowExtEx和SetViewportExtEx设置了缩放校正，这样就可以使用HTML中的"mm“单元。

Answer 2

尝尝这个。

var
    vIn, vOut: OleVariant;
begin
    WebBrowser_mail.ControlInterface.ExecWB(OLECMDID_PRINT,
                    OLECMDEXECOPT_PROMPTUSER, vIn, vOut) ;

Answer 3

每当我对WB有问题时，它有两个原因: a)文档没有完全加载，b) WB组件没有“完全注册”，因为它是在隐藏的形式上，等等。

对于a)我使用了很多年这个代码：

var
  CurDispatch: IDispatch;
  DocLoaded: boolean;


procedure TForm3.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
begin
  if (pDisp = CurDispatch) then begin
    CurDispatch := nil; {clear the global variable }
    DocLoaded:=true;
  end;
end;

procedure TForm3.WebBrowser1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
begin
  if CurDispatch = nil then
    CurDispatch := pDisp; { save for comparison }
end;

procedure TForm3.Button1Click(Sender: TObject);
var
  vIn, vOut: OleVariant;

begin
  DocLoaded:=false;
  WebBrowser1.Navigate(EdLink.Text);
  repeat
    Application.ProcessMessages;
  until DocLoaded;

  WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, vIn, vOut)
end;

如果仍然存在问题，请尝试将其提交给FormShow --它解决了b)：

WebBrowser1.HandleNeeded;

世界银行没有问题了。

不要忘记将WebBrowser1.Silent:=true设置为隐藏页面中的JavaScript错误。