Question

我正在使用以下单元通过TWebBrowser显示 - 并打印 - HTML代码，该代码显示在非模态对话框中。在我的生产程序中，以下代码在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代码段，其中显示了“打印”按钮并添加了“onprint”事件。再一次，这在我的开发机器（XP）上运行良好，但在我的客户机器（Win7）上运行不正常，程序冻结了公告外部异常C015D00F（与之前相同的地址）。

在进行了少量的谷歌搜索后，我发现异常代码C015000F是由 “被激活的激活上下文不是最近激活的激活上下文。”这对于一个可怜的Delphi程序员意味着什么？

Answer 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”。

Answer 2

试试这个。

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

Answer 3

每当我遇到WB问题时，它有两个原因：a）文档未满载b）WB组件未完全注册＆＃34;因为它是隐藏的形式等。

对于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错误。

从TWebBrowser打印

3 个答案: