Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2011年05月14日] [更新 2018年04月24日] Delphi サンプルプログラム集
942_TEmbeddedWB コンポーネント
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + IE 8.0
TEmbeddedWB Version 14.70.0
942_TEmbeddedWB.zip [6,730 KB] 2014年03月27日版 (EXE 同梱)



  • 2011年05月15日
  • [03]を追加
  • 2012年02月04日
  • [03]のコードを修正し、記事の見直し
  • 2012年03月23日
  • 実行時の HTML コード挿入、印刷関係のサンプルと ScriptX のサンプルを追加
  • 2012年07月31日
  • Delphi XE2 用 TEmbeddesWB コンポーネントのダウンロードの説明文章を追加
  • 2014年02月20日
  • 開発元のサイトがなくっていることによる記事の修正




TEmbeddedWB コンポーネント


標準の TWebBrowser コンポーネントだけでは実現できない機能があります。機能を拡張するには各種のインターフェイスを実装する必要があります。ネット上を検索すると、これらのサンプルを見つけることができます。
例えば、DelphiDabbler.com には How to customise the TWebBrowser user interface (part 1 of 6) という解説記事があり、サンプルコードもタウンロードできます。
一方、TEmbeddedWB というコンポーネントが以下のリンクから入手できます。このコンポーネントは、IE のオブジェクトを操作するメソッドやプロパティをコンポーネント自身のメソッドやプロパティとして使用できるようになっていて、非常に多くの機能が追加されています。
今回ダウンロードしたのは、ghquant-Delphi-EmbeddedWB-5c2aef2.zip というファイル名になっていました。

ダウンロードしたファイルを解凍したら、[Source] フォルダにパスを通し、[Packages] フォルダ内にある EmbeddedWebBrowser_XE2.dpk を IDE の [ファイル] [開く] から開いて [ビルド] [インストール] します。Delphi XE2 の VCL-32、VCL-64 のどちらでも動作することを確認しました。


図1
Delphi XE2, XE3 対応版
  • Download ZIP をクリックしてダウンロード


[備考]
TEmbeddedWB は 開発元の bsalsa.com というサイトが提供していたコンポーネント群ですが、2014年02月20日現在このサイトは存在しません。


図2
コンポーネント群
図3
添付のデモプログラム群
図4
Mega Demo 設計時画面
  • [Mega Demo] 内のプロジェクトを起動した画面
  • 当然メニュー類は英文なので、日本語に直す必要があるだろう
図5
Mega Demo 実行
  • ほぼ完成されたブラウザになっている




01_64 ビット版アプリにおける浮動小数点演算エラー等の回避方法


TEmbeddedWB コンポーネントでは、DisableErrors プロパティの fpExceptions の設定で浮動小数点演算の例外を無効にできますが、Delphi XE2 版での 64 bit アプリでは無効にできません。
64 bit版のアプリケーションでは、Math.pas 内の SetExceptionMask 関数を使用すると、浮動小数点演算の例外を無視するようにできます。この関数は、32 bit と 64 bit のどちらでも使用可能となっています。

uses に Math を追加して、例えば以下のように使用します。SetExceptionMask による設定は、プロセス内でのみ有効です。システム全体での設定を変更することはできません。最後に、アプリケーションのメインフォームの OnDestroy 等で元の設定に戻しておきます。
この関数は Delphi 6 から実装されています。



  //以下のコードは、ueseにMathが必要
  //TFPUExceptionMaskはMathで定義されている
  //したがって、TFPUExceptionMaskを使用する前のuses部にMathが必要

  var
    SaveFPUMask : TFPUExceptionMask;


  //現在の設定を退避
  SaveFPUMask := Math.GetExceptionMask;

  //全ての浮動小数点演算の例外を無視する
  Math.SetExceptionMask([exInvalidOp,
                         exDenormalized,
                         exZeroDivide,
                         exOverflow,
                         exUnderflow,
                         exPrecision]);

  //各種処理コード

  //元の設定に戻す
  Math.SetExceptionMask(SaveFPUMask);


上の SetExceptionMask を使用しない場合に発生するエラーは、例えば以下のようなものです。

   「プロジェクト plGoogleSearch.exe は例外クラス $C000008E (メッセージ '
    c000008e FLOAT_DIVIDE_BY_ZERO')を送出しました。 」







02_64 ビット版アプリにおける Debug 環境時のエラー


Windows 7 U64 の VCL-64bit の環境でコンパイルして実行すると、筆者の場合、以下のようなエラーが発生します。対処方法については、現在のところ不明です。

   「プロジェクト D:\000\XE2_64\plGoogleSearch.exe が例外により実行を停止しました。'
     c0000005 ACCESS_VIOLATION'再開するにはステップ実行または実行を選択してください。」

当サイトのサンプルプログラムには、この他にも、デバッグ時にはエラーはが発生するが、Release 版あるいは、作成した EXE を直接実行すればエラーが発生しないものがあります。
参照カウンタの問題の修正によりを回避することができるサンプルもありますが、その他についての対応方法、回避方法については、現在のところ不明です。

この現象は、Delphi XE2 の UP4 では修正されているようです。


図6
Debug 環境
  • Debug 環境だと以下の図のようなエラーが発生する
  • Release 環境では発生しない
  • 対処方法は、現在のところ不明






03_TEmbeddedWB コンポーネントの簡単な使用例


TEmbeddedWB コンポーネントには、多くのデモプログラムが添付されていますので、簡単な使用例としてのテストプログラムです。このテストプログラムの機能でも、標準の TWebBrowser だけで実現するとなると、結構面倒なコーディングが必要です。


図7
設計時画面
  • TPopupMenu コンポを配置して図のメニューと OnClick イベントを作成
  • TApplicationEvents コンポを配置してOnMessage イベントハンドラを作成
図8
Button1クリック
  • ローカルな HTML ファイルを表示
  • 独自のポップアップメニューを表示
図9
Button2 クリック
  • [Delphi] (大文字小文字区別なし) という文字を検索して別の色で表示
図10
Button3 クリック
  • HTMLのソースコードを取得して表示
図11
続いて [OK] をクリック
  • テキスト部分 (body部) を取得して表示
図12
Button4 クリック
  • Google で [Delphi]を 検索して表示

リスト1
TEmbeddedWB コンポーネントの簡単な使用例
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB, Menus,
  AppEvnts;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    EmbeddedWB1: TEmbeddedWB;
    PopupMenu1: TPopupMenu;
    ApplicationEvents1: TApplicationEvents;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  TEmbeddedWBを使用してURLを表示
//  TEmbeddedWBはIEオブジェクト関係のメソッドやプロパティをTEmbeddesWBのメソッ
//  ドやプロパティとして実装している他、追加のプロパティ、メソッド、イベントを
//  多く実装している
//
//  UsetInterfaceOptions.DontUse3DBordersをTrue
//  UsetInterfaceOptions.EnableThemesをTrue
//  UsetInterfaceOptions.DisableThemesをFalse
//
//  [注意]
//  TEmbeddedWBでMSHtMLの機能を使用する場合は、MSHTML_EWBを利用する(usesに追加)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AURL : String;
begin
  //指定のURLを表示(ここではローカルなHTMLファイル)
  AURL := ExtractFilePath(ParamStr(0)) + 'Delphi_Oracle.htm';
  EmbeddedWB1.Navigate(AURL);

  //表示完了まで待つ
  EmbeddedWB1.Wait;

  //IEのハンドル値とサイトページのTitleを表示
  //ローカルのHTMLの場合にはLocationNameはファイル名となる
  Self.Caption := IntToStr(EmbeddedWB1.HWND) + '  ' + EmbeddedWB1.LocationName;

  //以下のようにするとタイトルとなる
  //Self.Caption := EmbeddedWB1.Doc2.title;

  //デザインモードにする方法
  //EmbeddedWB1.Doc2.designMode := 'On';
end;

//=============================================================================
//  文字列の検索
//
//  SearchTextメソッドはフレームには未対応
//  (利用するにはフレームのDocumentを指定してEwbToolsの同名関数を使用する)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  EmbeddedWB1.SearchAndHighlight('DELPHI', [], 'red', 'yellow', sivFirstMatch);
end;

//=============================================================================
//  IEドキュメントの操作例
//  HTMLの全ソースや本文のテキスト部分の取得
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin

  if not Assigned(EmbeddedWB1.Document) then exit;

  //HTMLコードを取得
  ShowMessage(EmbeddedWB1.DocumentSource);
  //本文のテキスト部分のみ取得(タグではない<>や半角もそのまま取得できる)
  ShowMessage(EmbeddedWB1.Doc2.body.innerText);
end;

//=============================================================================
//  Googleサーチ
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
  EmbeddedWB1.GoSearchInGoogle('Delphi');
end;

//=============================================================================
//  コンテキストメニューは表示しないで、自前のボップアップメニューを表示
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  APos : TPoint;
begin
  if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONDBLCLK) then
  begin
    if IsChild(EmbeddedWB1.Handle, Msg.hwnd) then
    begin
      GetCursorPos(APos);
      PopupMenu1.Popup(APos.X, APos.Y);
      Handled := True;
    end;
  end;
end;

//=============================================================================
//  ボップアップメニューを表示する時はメニュー項目の使用可否を設定
//  N2は[コピー]
//  N3は[切り取り]
//  実用的なアプリではTActionList等の使用が望ましい
//=============================================================================
procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  Str : String;
begin
  Str := EmbeddedWB1.GetSelectedText();

  N2.Enabled := Str <> '';
  N3.Enabled := Str <> '';
end;

//=============================================================================
//  ボップアップメニューの[全て選択]
//=============================================================================
procedure TForm1.N1Click(Sender: TObject);
begin
  EmbeddedWB1.SelectAll;
end;

//=============================================================================
//  ボップアップメニューの[コピー]
//  本サンプルではテキストだけ対照にしているが、画像も選択すればコピーが可能
//=============================================================================
procedure TForm1.N2Click(Sender: TObject);
begin
  EmbeddedWB1.Copy;
end;

//=============================================================================
//  ボップアップメニューの[切り取り]
//=============================================================================
procedure TForm1.N3Click(Sender: TObject);
begin
  EmbeddedWB1.Cut;
end;

end.


TEmbeddedWB コンポーネントには、クリックイベントが実装されています。
これを使用すると、このイベント内でポップアップメニューも表示できます。また、引数の X, Y から、ElementFromPoint(X, Y) のように、マウスカーソル位置の IHTMLElement インターフェイスのオブジェクトが取得できます。
これから、現在のマウス位置のタグの情報も取得できます。

例えば次のコードでは、マウスカーソルが画像の上にあった場合、その画像名をポップアップメニューの項目として追加表示します。


図13
画像付きのページを表示
図14
画像位置でメニュー表示
  • [画像名...] の項目が追加されている
図15
画像以外の場所でのメニュー

リスト2
OnClick イベントの使用例
implementation

uses MSHTML_EWB, HTTPApp;

{$R *.dfm}

//=============================================================================
//  TEmbeddedWBを使用してURLを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AURL : String;
begin
  //指定のURLを表示(ここではローカルなHTMLファイル)
  AURL := ExtractFilePath(Application.ExeName) + 'Image.htm';
  EmbeddedWB1.Navigate(AURL);
end;

//=============================================================================
//  EmbeddedWB1のOnClickイベント
//
//  マウス位置のタグを調査して、画像のタグ(IMG)だったら、そのパス名を取得
//  IHTMLElementの使用には、usesにMSHTML_EWBが必要
//  UnixPathToDosPathの使用には、usesにHTTPAppが必要
//=============================================================================
procedure TForm1.EmbeddedWB1Click(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  iElement : IHTMLElement;
  Path     : String;
  AITem    : TMenuItem;
  APos     : TPoint;
  StrText  : String;
begin
  if Button = mbRight then begin

    //マウス位置のIHTMLElementを取得
    //そのタグがIMGだったら画像のsrc属性の値を取得
    iElement := EmbeddedWB1.Doc2.elementFromPoint(X, Y);
    if iElement.tagName = 'IMG' then begin
      Path := UnixPathToDosPath(iElement.getAttribute('src', 0));

      //ポップアップメニューの項目に画像の名前を追加
      AITem := TMenuItem.Create(Self);
      AITem.Caption := '画像名 ' + ExtractFileName(Path);
      PopupMenu1.Items.Add(AITem);
    end;


    //テキストが選択されていない時は、コピーと切り取りの機能は使用不可とする
    StrText := EmbeddedWB1.GetSelectedText();
    N2.Enabled := StrText <> '';
    N3.Enabled := StrText <> '';

    //ポップアップメニューを表示
    GetCursorPos(APos);
    PopupMenu1.Popup(APos.X, APos.Y);
  end;

  if Assigned(AITem) then FreeAndNil(AITem);
end;

//=============================================================================
//  ボップアップメニューの[全て選択]
//=============================================================================
procedure TForm1.N1Click(Sender: TObject);
begin
  EmbeddedWB1.SelectAll;
end;

//=============================================================================
//  ボップアップメニューの[コピー]
//  本サンプルではテキストだけ対照にしているが、画像も選択すればコピーが可能
//=============================================================================
procedure TForm1.N2Click(Sender: TObject);
begin
  EmbeddedWB1.Copy;
end;

//=============================================================================
//  ボップアップメニューの[切り取り]
//=============================================================================
procedure TForm1.N3Click(Sender: TObject);
begin
  EmbeddedWB1.Cut;
end;

end.




04_[ お気に入りの追加 ] ダイアログをモーダル表示


TEmbeddedWB コンポーネントの AddToFavorites メソッドで、[お気に入りの追加] ダイアログを表示できますが、ダイアログはモードレスで表示されます。
メソッドの説明ページにあるように、IE が表示しているページのコンテナのハンドルに対して、コマンドを送るとモーダル表示できます。このテストです。

TEmbeddedWB コンポーネントでは、OnShowDialog イベントを使用すると、表示するダイアログの表示位置を制御することができます。以下のサンプルでは、このテストコードも追加しています。
このダイアログの表示位置は、システムやダイアログの種類によっては制御できない場合もあります。


図16
設計時画面
図17
ダイアログ表示
  • モーダル表示なので [お気に入りの追加] ダイアログを閉じないとForm1 にフォーカス移動できない

リスト3
[お気に入りの追加] ダイアログをモーダル表示する
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    EmbeddedWB1: TEmbeddedWB;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure EmbeddedWB1ShowDialog(Sender: TObject; h: Cardinal;
      StyleEx: Integer; OldCaption: string; var NewCaption: WideString;
      var Cancel: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IEConst;

{$R *.dfm}

//=============================================================================
//  [Webページ表示]ボタン
//  URLを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AURL : String;
begin
  //指定のURLを表示
  AURL := 'http://www.embarcadero.com/jp/';
  EmbeddedWB1.Navigate(AURL);
end;

//=============================================================================
//  [お気に入りの追加]ダイアログをモーダル表示
//
//  http://www.bsalsa.com/ewb_methods1.html
//  の定数値の一覧を参照
//  この定数値の使用には、usesにIEConstが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  IEHandle : HWND;
begin
  //ページを表示しているウィンドウハンドルを取得
  IEHandle := EmbeddedWB1.GetIEHandle(EmbeddedWB1, 'Internet Explorer_Server');
  //お気に入りに追加のダイアログをモーダル表示
  SendMessage(IEHandle, WM_COMMAND, ID_IE_CONTEXTMENU_ADDFAV, 0);
end;

//=============================================================================
//  OnShowDialogイベント処理
//  http://www.bsalsa.com/ewb_on_show_dlg.html参照
//=============================================================================
procedure TForm1.EmbeddedWB1ShowDialog(Sender: TObject; h: Cardinal;
  StyleEx: Integer; OldCaption: string; var NewCaption: WideString;
  var Cancel: Boolean);
begin
  //ダイアログの表示位置を変更
  SetWindowPos(h, 0, Self.Left, Self.Top + 50, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
end;

end.


クラス名が 'Internet Explorer_Server' のウィンドウは、ウェブページを表示しているウィンドウのことです。起動中のウィンドウの階層を調べてみると以下の図のようになっています。
IE 8では、タブを 2 つ表示しているので、このクラス名のウィンドウが 2 つ表示されています。


図18
本サンプルのウィンドウ階層
  • 本サンプルのクラス名は TForm1
図19
IE 8.0 のウィンドウ階層
  • IE 本体のクラス名は IEFrame
  • タブを2つ表示しているので、クラス名が
    Internet Explorer_Server
    のウィンドウが2つある
  • 最後尾に $ 記号がないのがアクティブなタブ

インターネットのショートカットは、IEのデフォルトの[お気に入り]以外の任意の場所に作成することも可能です。そのコード例です。

リスト4
インターネットのショートカットを任意の場所に作成
//=============================================================================
//  任意の場所にインターネットのショートカットを作成
//
//  aFileName : 保存先のフルパス
//              例: [お気に入り]フォルダのパス名 + 表示名.url
//  aURL      : 登録するURL
//=============================================================================
procedure CreateIntShotCut(aFileName, aURL: PChar);
var
  SL : TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Add('[InternetShortcut]');
    SL.Add('URL=' + aURL);
    SL.SaveToFile(aFileName);
  finally
    FreeAndNil(SL);
  end;
end;




05_実行時の HTML コード挿入


HTML のコードを実行時に追加、挿入するテストです。
任意の位置に挿入できますが、挿入位置を識別する何かが必要です。id や name 属性が定義してあるタグであればそれらを利用できます。
このテストでは <BODY> タグを基準にして挿入しています。
IHTMLDocument2 オブジェクトの createElement メソッドで、特定のタグ要素を設定して挿入する方法もありますが、ここでは、TStringList の文字列を insertAdjacentHTML で挿入しています。


図20
設計時画面
図21
起動時画面
図22
HTML コードを挿入したところ
  • [リンク先へジャンプ] が追加されている

リスト5
実行時に HTML コードを追加
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    EmbeddedWB1: TEmbeddedWB;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MSHTML_EWB;

{$R *.dfm}

//=============================================================================
//  フォーム作成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  AURL : String;
begin
  AURL := ExtractFilePath(ParamStr(0)) + 'TestPage.html';
  EmbeddedWB1.Navigate(AURL);
end;

//=============================================================================
//  HTMLコード内の指定位置にHTMLコードを挿入
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SL          : TStringList;
  iElementCol : IHTMLElementCollection;
  iElement    : IHTMLElement;
begin
  if EmbeddedWB1.Doc3.getElementById('id-link') = nil then begin
    SL := TStringList.Create;
    try
      SL.Add('<a href="http://mrxray.on.coocan.jp/" target="_top" id="id-link">');
      SL.Add('リンク先へジャンプ</a>');
      iElementCol := EmbeddedWB1.Doc3.getElementsByTagName('body');
      iElement    := iElementCol.item(0, 0) as IHTMLElement;
      iElement.insertAdjacentHTML('BeforeEnd', SL.text);
    finally
      FreeAndNil(SL);
    end;
  end;
end;

end.


コード内の EmbeddedWB1.Doc3 の Doc3 は、IHTMLDocument3インターフェイスです。
TWebBrowser では、uses に MSHTML を追加して、次のように取得できます。
ここまでのサンプルで使用している Doc2 も同じようにして取得できます。
TEmbeddedWB で MSHTML と同等の機能を提供しているのは MSHTML_EWB です。MSHTML と MSHTML_EWB を混合して使用するとトラブル発生の元になる可能性があります。


var
  Doc2 : IHTMLDocument2;
  Doc3 : IHTMLDocument3;
begin
  Doc2 := WebBrowser1.Document as IHTMLDocument2;
  Doc3 := WebBrowser1.Document as IHTMLDocument3;




06_印刷や印刷プレビュー等


TEmbeddedWB コンポーネントには印刷関係のメソッド類が用意されています。そのテストです。


図23
設計時画面
図24
プレビュー画面
  • [ページ設定] ダイアログの設定に基づいて表示される

リスト6
TEmbeddedWB コンポの印刷関係メソッドとページ設定関係プロパティのテスト
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    EmbeddedWB1: TEmbeddedWB;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム作成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  URL : String;
begin
  URL := 'http://mrxray.on.coocan.jp/Delphi/Others/';
  Edit1.Text := URL;
  Button1Click(nil);
end;

//=============================================================================
//  他のページで動作確認できるように...
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  EmbeddedWB1.Navigate(Trim(Edit1.Text));
end;

//=============================================================================
//  [ページ設定]
//  PageSetupメソッド
//  PrintOptions.EnabledをTrueにしてPageSetupの引数をTrueにして実行すれば
//  オプションの値がダイアログに反映される
//  IE8以降ではヘッダとフッタの設定は無効となる
//  これは、IE7形式のページ設定ダイアログの遠隔操作をしているため
//
//  PageSetupダイアログで表示される用紙の[サイズ]と[給紙方法]は、プリンタによ
//  って異なるので、遠隔操作の場合は注意が必要
//  IE6,7とそれ以降では設定項目と設定方法が違うので、これも注意
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  EmbeddedWB1.PrintOptions.Enabled        := True;
  EmbeddedWB1.PrintOptions.Margins.Left   := 28;
  EmbeddedWB1.PrintOptions.Margins.Top    := 25;
  EmbeddedWB1.PrintOptions.Margins.Right  := 20;
  EmbeddedWB1.PrintOptions.Margins.Bottom := 25;
  EmbeddedWB1.PrintOptions.Orientation    := TPrintOrientationOption.poPortrait;
  EmbeddedWB1.PrintOptions.Header         := '&ヘッダ文字列&b&p/&P ページ&';
  EmbeddedWB1.PrintOptions.Footer         := 'フッタ文字列';

  EmbeddedWB1.PageSetup(True);
end;

//=============================================================================
//  [プレビュー]
//  PrintPreviewメソッド
//  PrintOptionsの値は、あらかじめPageSetupで設定した値が使用される
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  EmbeddedWB1.PrintPreview;
end;

//=============================================================================
//  [印刷]
//  Printメソッド
//  PrintOptions.EnabledをFalseにすればHeaderとFooterの値だけが有効となる
//  (IE8でも有効)
//  他のPrintOptionsの値はTrueにしてもFalseにしても無効で、PageSetupメソッドで
//  設定した値が使用される
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
  EmbeddedWB1.PrintOptions.Enabled := False;
  EmbeddedWB1.PrintOptions.Header  := '&印刷メソッドヘッダ&b&p/&P ページ&';
  EmbeddedWB1.PrintOptions.Footer  := '印刷メソッドフッタ';

  //HideSetupをTrueにすると、プリンタの選択ダイアログを表示しない
  EmbeddedWB1.PrintOptions.HideSetup := True;

  EmbeddedWB1.Print;
end;

end.


PageSetup メソッドで[ページ設定]ダイアログを表示する際、あらかじめ PrintOptions プロパティに値を設定しておくと、その値で [ページ設定] ダイアログを表示しますが、IE 8 以降ではヘッダとフッタの文字列は設定されません。

TEmbeddedWB コンポでは、ダイアログを表示する際、ダイアログの遠隔操作でこれらの値を設定しています (Print メソッドのフッタとフッタの設定は別の方法で設定しています)。この動作は IE 7 を基準に作成されています。IE 8 では下図のように、ダイアログの仕様が異なっているのが原因です。また、プリンタと用紙サイズ等の設定はできません。これらは通常使用するプリンタの設定が使用されます。

このような方法は、マイクロソフト自身も使用している方法です。[スクリプトによるWeb ページ印刷のサポート] の「"Captain" の告白」に文章があります。このことから、印刷や印刷プレビュー前に、プリンタや用紙等、ページ設定関係の値を設定するには以下の方法が考えられます、
  • 通常使用するプリンタとその用紙サイズ等を変更し、印刷が終了したら元に戻す
    また余白やヘッダ、フッタはレジストの値を変更し、印刷が終了したら元に戻す
  • [ページ設定] ダイアログを遠隔操作する
  • 印刷の前に表示される [印刷] ダイアログを遠隔操作する
  • サーバの OS が Windows であれば、後述の ScriptX を使用する
TEmbeddedWB コンポのデモプログラム [10 - PrintingOptions_Demo] に [ページ設定] ダイアログの遠隔操作のサンプルがあります。ダイアログは IE (Internet Explorer) のバージョンによっても異なることに注意する必要があります。
ダイアログの遠隔操作時は、PrintOptions の Enabled プロパティの値を False にしておきます。

上の方法のリストに、[印刷] ダイアログの遠隔操作とありますが、印刷プレビュー画面の[印刷]ボタンで表示される [印刷] ダイアログは、グローバルフックを使用しないと操作できません。
ダイアログの遠隔操作は、[016] [06_ダイアログの項目値をコードで選択 (項目値の削除)] 等も参考にしてください。


図25
IE 7 の [ページ設定]
  • 用紙サイズと給紙方法は、プリンによって異なる
図26
IE 8 の [ページ設定]
  • 用紙サイズと給紙方法は、プリンタによって異なる
  • ヘッダとフッタの設定はコンボボックスとなっている

[ページ設定] のヘッダとフッタのコンポボックスで [カスタム] 選択すると、下図のようなダイアログが現れます。このダイアログも遠隔操作しなければヘッダとフッタの設定はできません。


図27
[カスタム] 設定ダイアログ
  • ヘッダとフッタのコンボボックスで[カスタム]を選択すると現れる

レジストリに記録されている印刷のヘッダ、フッタ、余白の設定は下図のようになっています。
この図は IE 8 のものです。これらの値は全て文字列で記録されています。図の下のリストはこれらの値を読み出しまたは書き込む際の参考コードです。
ヘッダ、フッタの書式文字列は、Internet Explorer のヘルプに記述があります。

「通常使用するプリンタ」を変更したり、レジストリの値を書き換える方法は、用紙サイズや他のプロパティも変更できて確実ですが、管理者権限が必要であること、起動中の他のアプリが同じようなことをしていると、元の値が変更されてしまっている状況も考えられます。
一方、[ページ設定] ダイアログの遠隔操作は、プリンタの変更はできません。また用紙サイズのリストの文字列がプリンタドライバによって違いがあるため、選択方法に工夫が必要です。


図28

リスト7
印刷のヘッダ、フッタ、余白の設定のレジストからの読み出しと書き込みの例
//=============================================================================
//  レジストリからIEの印刷のヘッダや余白の設定を読み出す例
//  usesにRegistryが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Reg          : TRegistry;
  AppKey       : String;
  AppItem      : String;
  StrHeader    : String;
  MarginLeftmm : Double;
begin
  Reg := TRegistry.Create;
  try
    Reg.Access  := KEY_READ;
    Reg.RootKey := HKEY_CURRENT_USER;
    AppKey      := 'Software\Microsoft\Internet Explorer\PageSetup';

    if Reg.OpenKey(AppKey, False) then begin
      try
        //ヘッダ文字列の読み出し
        AppItem   := 'header';
        StrHeader := Reg.ReadString(AppItem);
        Memo1.Lines.Add(StrHeader);

        //左マージンを読み出してmm単位に換算
        AppItem      := 'margin_left';
        MarginLeftmm := StrToCurr(Reg.ReadString(AppItem)) * 25.4;
        Memo1.Lines.Add(FormatFloat('#.#', MarginLeftmm));
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    Reg.Free;
  end;
end;

//=============================================================================
//  レジストリにIEの印刷のヘッダや余白の設定を書き込む例
//  usesにRegistryが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  Reg            : TRegistry;
  AppKey         : String;
  AppItem        : String;
  StrHeader      : String;
  MarginLeftInch : Double;
  StrMagin       : String;
begin
  Reg := TRegistry.Create;
  try
    Reg.Access  := KEY_WRITE;
    Reg.RootKey := HKEY_CURRENT_USER;
    AppKey      := 'Software\Microsoft\Internet Explorer\PageSetup';

    if Reg.OpenKey(AppKey, False) then begin
      try
        //ヘッダ文字列の書き込み
        AppItem   := 'header';
        StrHeader := '&左のヘッダ文字列&b&p/&P ページ';
        Reg.WriteString(AppItem, StrHeader);

        //左余白の値の書き込み
        //インチ単位の値を文字列に変換して書き込む
        AppItem        := 'margin_left';
        MarginLeftInch := 22.0 / 25.4;
        StrMagin       := FormatFloat('#0.00000', MarginLeftInch);
        Reg.WriteString(AppItem, StrMagin);
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    Reg.Free;
  end;
end;


TEmbeddedWB コンポに PrintPreviewFromTemplate というメソッドがあります。このメソッドを使用すると独自のカスタム印刷プレビュー画面を作成することができます。
デモプログラム [09 - PrintPreviewFromTemplate_Demo] に使用例があります。下図はこのデモプログラムのボタン表示部分を画像にした例です。


図29
独自プレビュー

このテンプレートのことを考えると、IE も印刷や印刷プレビューの際にテンプレートを使用しているのではないかと予測できます。事実IEでは実行時にテンプレートを作成していると思われます。
テンプレートで使用する API のリストが、MSDN の [Windows Internet Explorer Platform APIs] [Print Template Reference] にあります。ただし、これらのテンプレートの情報が取得できても、実際には制御はできないようです。
これらのプロパティの値のほとんどは読み出し専用となっていて、デフォルト値はなく、ダイアログボックスで設定した値が格納されるとあります。





07_ScriptX を使用した印刷


ScriptX という ActiveX があります。
これは、IE (Internet Explorer) の文書印刷の操作をコントロールするものです。
  • ActiveX なのでサーバーの OS は Windows に限る
  • プリンタ名や用紙サイズ等の設定も可能で、プレビュー画面もカスタマイズ可能
  • フリー版もあるが、利用可能な機能は今回のテストで使用したプロパティのみに限る
  • 初回使用時には、ActiveX のインストール画面が現れる (下図参照)
今回は、[Download the ScriptX Client Resource Kit] のページから [Download smsxc.cab] ボタンでフリー版の ScriptX をダウンロードしました。このファイルをローカルサーバ上に置いてテストしました。


[備考]
2019年08月19日現在、フリー版は提供されていません。代わりに評価版が提供されています。評価版は、上の 2 番目のリンクからダウンロードできます。


図30
ActiveXのインストール

テストの結果です。プレビュー画面上のコントロール関係の表記が英語となっています。正規版では日本語表記となるかは未確認です。プレビューなしで直接印刷する場合は関係ありませんが。
ヘッダ、フッタ、余白と印刷の向きが指定通りになっていることは確認しました。

このサンプルは印刷プレビューですが、印刷メソッドは Print です。最初の引数でプリンタ選択のダイアログを表示するかを指定できますが、フリー版では無視されると書いてあります。


図31
設計時画面
図32
印刷プレビュー画面
  • メニュー類は英語表記
  • 正規版で日本語になるかは不明

ScriptX のサイトのサンプルには、HTML コードの例しかありませんが、以下のコードで Delphi 側から使用できます。
このサンプルコードはこのままでは動作しません。XXXXX の部分を smsx.cap が置いてあるサーバ上のディレクトリ名にし、Version=7,0,0,8 の数値もバージョン番号と同じにします。
2012年03月24日現在、codebase="http://www.meadroid.com/scriptx/smsx.cab#Version=7,0,0,8">
にすると動作します。おそらく ScriptX の Windows サーバに smsx.cab が置いてあるようです。今のうちならこの値にしてテストできるようです。


リスト8
ScriptX を使用した印刷プレビューとページ設定関係のテスト
IDE上で実行する場合、コンパイルの前に[再構築]が必要
コンパイルしたらEXEを直接起動した方がいいだろう
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    EmbeddedWB1: TEmbeddedWB;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MSHTML_EWB;

{$R *.dfm}

//=============================================================================
//  フォーム作成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  AURL : String;
begin
  AURL := 'http://mrxray.on.coocan.jp/Delphi/Others/';
  EmbeddedWB1.Navigate(AURL);
end;

//=============================================================================
//  DelphiからScriptXを使用するコードの例
//  XXXXXの部分をsmsx.capが置いてあるサーバ上のディレクトリにし、Versionも使用
//  するsmsx.capのバージョン番号と同じにする
//  IDE上での実行の場合、コンパイルのたびにプロジェクトの[再構築]が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SL          : TStringList;
  iElementCol : IHTMLElementCollection;
  iElement    : IHTMLElement;
begin

  SL := TStringList.Create;
  try
    if EmbeddedWB1.Doc3.getElementById('factory') = nil then begin
      //ScriptXのオブジェクト生成用のタグコード
      //idの名前は任意だが、プリンタの設定の時のオブジェクト名となる
      SL.Add('<object id=factory style="display:none"');
      SL.Add('classid="clsid:1663ed61-23eb-11d2-b92f-008048fdd814"');
      SL.Add('codebase="http://XXXXX/smsx.cab#Version=7,0,0,8">');
      SL.Add('</object>');

      //HTMLの最初の<BODY>タグの要素オブジェクトを取得
      iElementCol := EmbeddedWB1.Doc3.getElementsByTagName('body');
      iElement    := iElementCol.item(0, 0) as IHTMLElement;

      //そこの先頭部分にコードを挿入
      iElement.insertAdjacentHTML('AfterBegin', SL.text);
    end;

    SL.Clear;
    //ScriptXによるプリンタの設定用JavaScriptコードを作成
    //印刷余白は、日本の場合、デフォルトではmm単位であることに注意
    //Free版で使用できない設定コードがあると印刷もプレビューもしない
    SL.Add('factory.printing.header       = "ヘッダ文字列";');
    SL.Add('factory.printing.footer       = "フッタ文字列";');
    SL.Add('factory.printing.leftMargin   = 30;');
    SL.Add('factory.printing.topMargin    = 25;');
    SL.Add('factory.printing.rightMargin  = 20;');
    SL.Add('factory.printing.bottomMargin = 40;');
    SL.Add('factory.printing.portrait     = true;');
    SL.Add('factory.printing.Preview();');

    //それを実行
    EmbeddedWB1.ExecScript(SL.text, 'JavaScript');
  finally
    FreeAndNil(SL);
  end;
end;

end.


次のコードのように、<OBJECT> タグのオブジェクトに対して操作することもできます。この場合はオブジェクト名を id 属性の値と同じにする必要はありません。
このコードでの codebase の値が、2012年03月24日現在使用できるようです。テスト用なのでしょうか。


リスト9
ScriptX を使用した印刷プレビューとページ設定関係のテスト
IDE 上で実行する場合、コンパイルの前に [再構築] が必要
コンパイルしたらEXEを直接起動した方がいいだろう

procedure TForm1.Button2Click(Sender: TObject);
var
  SL          : TStringList;
  iElementCol : IHTMLElementCollection;
  iElement    : IHTMLElement;
  iObjElement : IHTMLObjectElement;
  ObjScriptX  : OleVariant;
begin
  if not Assigned(EmbeddedWB1.Document) then exit;

  if EmbeddedWB1.Doc3.getElementById('factory') = nil then begin
    SL := TStringList.Create;
    try
      //ScriptXのオブジェクト生成用のタグコード
      //idの名前は任意だが、プリンタの設定の時のオブジェクト名となる
      SL.Add('<object id=factory style="display:none"');
      SL.Add('classid="clsid:1663ed61-23eb-11d2-b92f-008048fdd814"');
      SL.Add('codebase="http://www.meadroid.com/scriptx/smsx.cab#Version=7,0,0,8">');
      SL.Add('</object>');

      //HTMLの最初の<BODY>タグの要素オブジェクトを取得
      iElementCol := EmbeddedWB1.Doc3.getElementsByTagName('body');
      iElement    := iElementCol.item(0, 0) as IHTMLElement;

      //そこの先頭部分にコードを挿入
      iElement.insertAdjacentHTML('AfterBegin', SL.text);
    finally
      FreeAndNil(SL);
    end;
  end;

  iElement    := EmbeddedWB1.Doc3.getElementById('factory');
  iObjElement := iElement as IHTMLObjectElement;

  if iObjElement <> nil then begin
    ObjScriptX := OleVariant(iObjElement.object_);

    ObjScriptX.printing.header       := 'ヘッダ文字列';
    ObjScriptX.printing.footer       := 'フッタ文字列';
    ObjScriptX.printing.portrait     := false;
    ObjScriptX.printing.leftMargin   := 25;
    ObjScriptX.printing.topMargin    := 23;
    ObjScriptX.printing.rightMargin  := 20;
    ObjScriptX.printing.bottomMargin := 25;
    ObjScriptX.printing.Preview;
  end;
end;