从 TWebBrowser 打印答案

【问题标题】：Printing from TWebBrowser从 TWebBrowser 打印
【发布时间】：2013-03-29 12:11:48
【问题描述】：

我正在使用以下单元通过 TWebBrowser 显示 - 和打印 - HTML 代码，该 TWebBrowser 显示在非模式对话框中。在我的生产程序中，以下代码在 Windows-XP 下工作，但在 Windows-7 下失败（错误消息始终为外部异常 C015D00F）。为了隔离问题，我编写了一个简单的测试程序，它还有一个包含 TWebBrowser 的非模态对话框；就其本身而言，该测试程序可以在 Windows-7 上正常工作，但是当我将测试程序中的非模态对话框插入生产程序时，我得到了外部异常。

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

可能是什么问题？打印代码来自Embarcadero site

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 sn-p，它显示了一个“打印”按钮并添加了一个“onprint”事件。再一次，这在我的开发机器 (XP) 上运行良好，但在我的客户端机器 (Win7) 上运行良好，程序冻结并显示外部异常 C015D00F（与之前的地址相同）。

经过大量的谷歌搜索，我发现异常代码 C015000F 是由 “被停用的激活上下文不是最近激活的。”这对可怜的 Delphi 程序员意味着什么？

【问题讨论】：

哪一行触发了异常？以及如何关闭表格？手动？
@Noam，我不是反对者，但您仍然没有提供足够的信息。请解决我的评论。
@kobik：我认为我提供了足够多的信息。我还发布了一条评论，其中提到了您的评论，但它似乎已经消失了。我不知道“DoPrint”例程中的哪一行触发了异常，但 ControlInterface 行有完全相同的问题。表单将手动关闭，但在关闭之前崩溃。
@Noam，您的代码对我来说看起来不错。但是，我会提供 Application 作为表单的所有者。并在表单显示上执行web.Navigate，而不是 onCreate。
@kobik：我按照你的建议做了，但没有任何改变。我在 DoPrint 过程的每一行之后添加了简单的日志记录语句，包括 HTMLWindow3.print 之后的一行 - 此行出现在日志中。换句话说，HTMLWindow3.print 调用了一些库代码，并且在该外部代码中发生了崩溃。

标签： delphi twebbrowser

【解决方案1】：

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

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/CSS 中使用单位“mm”。

【讨论】：

'and 1 and 1' 位是错字 - 应该是 'options and 1 = 1 then' - 已更正。
网络浏览器包含一些文本、一个表格（包含一些文本）以及表格下方的一些文本。所有的文本都是 UTF-8 编码的，因为它是希伯来语。使用上面的代码，输出中只出现了一个空的 HTML 表格；没有任何文字。
此代码会导致程序在装有 Windows-7 的计算机上崩溃。它适用于 XP，但正如我上面提到的，文本丢失了。所以这不是一个可行的解决方案。
希伯来语？这可能是打印机字体问题吗？您使用的是默认字体还是您知道已定义所有希伯来语字符的特定本地 TTF/OTF 字体？
我从未指定过字体，我认为它不相关。 “选择打印机”对话框不会出现在 Windows-7 下，而在 XP 中会出现（使用我正在使用的代码）。一旦我知道打印了某些东西，我就可以将注意力转移到字体上。您提供的代码使计算机崩溃 - 甚至比我的程序崩溃更糟糕。

【解决方案2】：

试试这个。

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

【讨论】：

我确实在我的帖子中包含了一个变体 - 请阅读到最后。我已经放弃了在 Windows7 下从网络浏览器打印的想法，直到有人可以解释如何避免外部异常 C015D00F。

【解决方案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;

WB 没有问题了。

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

【讨论】：