2

次のユニットを使用して、非モーダル ダイアログに表示される TWebBrowser を介して HTML コードを表示および印刷しています。私の製品プログラムでは、次のコードは Windows-XP では機能しますが、Windows-7 では失敗します (エラー メッセージは常に外部例外 C015D00F です)。問題を特定するために、TWebBrowser を含む非モーダル ダイアログを含む簡単なテスト プログラムを作成しました。このテスト プログラムは、単独では Windows-7 で正しく動作しますが、非モーダル ダイアログをテスト プログラムから実稼働プログラムにプラグインすると、外部例外が発生します。

これはおそらく、呼び出されたユニットではなく、呼び出し元のプログラムに問題があることを示していますが、その問題が何であるかはわかりません。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 コードに、「印刷」ボタンを表示して「onprint」イベントを追加する JavaScript スニペットを追加しました。繰り返しますが、これは私の開発マシン (XP) では正常に動作しますが、クライアントのマシン (Win7) では動作しません。この場合、プログラムは外部例外 C015D00F (以前と同じアドレス) というアナウンスでフリーズします。

少なからずグーグルで調べた結果、例外コード C015000F が「非アクティブ化されているアクティブ化コンテキストが最近アクティブ化されたコンテキストではない」ことが原因であることがわかりました。これは、貧弱な Delphi プログラマーにとって何を意味するのでしょうか?

4

3 に答える 3

3

私の記憶が正しければ、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」を使用できます。

于 2013-03-29T12:32:34.750 に答える
1

これを試して。

var
    vIn, vOut: OleVariant;
begin
    WebBrowser_mail.ControlInterface.ExecWB(OLECMDID_PRINT,
                    OLECMDEXECOPT_PROMPTUSER, vIn, vOut) ;
于 2013-04-01T16:59:28.863 に答える
0

WB で問題が発生するたびに、次の 2 つの理由があります。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はもう問題ありません。

ページ内の JavaScript エラーを非表示にするために、WebBrowser1.Silent:=true を設定することを忘れないでください。

于 2015-02-23T07:47:31.757 に答える