Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年03月13日] [更新 2017年01月04日] Delphi サンプルプログラム集
   
932_Google Chrome ブラウザコントロール
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + dcef-r306
932_GoogleChromeControl.zip [9,297 KB] 2017年01月04日版 (EXE 同梱)



  • 2012年03月27日
  • 印刷のテストコードを追加
  • 2012年03月29日
  • 印刷ダイアログの遠隔操作のテストコードを追加
  • 2015年09月08日
  • JavaScript による DOM 操作関係のサンプルを追加
  • 記事とコードの整備




Google Chrome ブラウザと delphichromiumembedded


delphichromiumembedded (TChromium) コンポーネントのテストプログラムです.
これは,Delphi のフォームに配置して,Google Chromw ブラウザの機能を実装するためのコンポーネントです.ActiveX コントロールではなく,TWinControl の派生コンポーネントです.
コンポーネントのクラス名は,TChromium です.TChrominum を使用したアプリケーションは,システムに Google Chromw ブラウザがインストールされていなくても動作します.

The Chromium Embedded Framework (CEF) というのが,chromiumembedded のサイトで配布されています.delphichromiumembedde はこの Delphi 版となっています.ダウンロードのページからダウンロードできます.今回は dcef-r306.7z をダウンロードしてインストールしています.

[bin] [Win32] 内の全てのファイルを,システムフォルダにコピーしてテストしています.
筆者の場合は,64 ビット版の Windows 7 です.下図の選択中のファイルを [Windows] [SysWOW64] フォルダにコピーしました.
32 ビット版の Windows 7 のシステムフォルダは [Windows] [System32] です.


図1
実行に必要なファイル類
  • これらをシステムフォルダ,または,EXE があるフォルダに置く
  • または,ログインユーザにとってシステム的にパスの通った場所に必要


[備考]
以下のリンクにも Delphi Chromium Embeded 3 と言う TChromium コンポーネントがあります.こちらの方が新しいバージョンですが,本ページのサンプルで使用している dcef-r306 とは実装内容が少し異なっています.
本ページのサンプルコードは,そのままでは期待通りに動作しない場合があります.DOM の操作関係は修正が必要です.また,2015年01月30日現在,Delphi Chromium Embeded 3 にはイベントリスナーの機能は実装されていません.
この他にも,中国のサイトにも独自の実装をした TChromium コンポーネントがあります.



図2
コンポーネントのパッケージ構成
  • [src] にパスを通して使用する
  • FMX (Fire Monkey) での使用も可能
  • 今回は DCEF_2010.dpk の名前を
    DCEF_XE.pdk に変更してインストール
図3
デモプログラムの実行例
  • [demos] の [guiclient] 内のプロジェクトをコンパイルして実行した結果
  • EXE は [bin] フォルダ内に出来る
  • [Show Developper tools] は機能しない


以下のページに Microsoft Edge 相当の機能Eを実装するためのコンポーネントの記事を掲載しています.





01_Chrome ブラウザを起動 - CreateComObject では起動できない


FireFoxも Google Chrome も COM (Component Object Model) の実装はしていないようです.
[400] [04_CreateOLEObject 関数で生成可能なオブジェクト] の記事の OLE/COM Object Viewer で確認しました.Delphi 等で作成した通常のアプリケーションと同じということになります.したがって,CreateComObject 関数で新規にブラウザを生成して起動し,そのインスタンスを取得するようなことはできません.

このサンプルでは,ShellExecute 関数で Google Chrome ブラウザを起動します.CreateProcess 関数ではないので,既にブラウザが起動している場合は,新規のタブに表示されます.


図4
ボタンクリックでグーグルクロームブラウザを起動してウェブページを表示

リスト1
Google Chrome (グーグルクローム) ブラウザを起動してウエブページを表示
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

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

var
  Form1: TForm1;

implementation

uses  
  ShellAPI;

{$R *.dfm}

//=============================================================================
//  Google Chromeを起動
//  登録アプリケーションなのでフルパスでなくても起動する
//  既にGoogle Chromeが起動している時は,新しいタブに表示される
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LExeName : String;
  LUrl     : String;
begin
  LExeName := 'chrome.exe';
  LUrl     := 'http://mrxray.on.coocan.jp/';
  ShellExecute(Handle, 'open', PChar(LExeName), PChar(LUrl), nil, SW_SHOW);
end;

end.




02_HTML ページのソースの表示と文字列検索


HTML のソースコードの取得と文字列検索の例です.
文字列の検索は,フレームに対応してますが,ソースコード等は,フレームごとに指定する必要があります.
dcef-r306 では,DOM の操作,つまりドキュメントの操作は,VisitDomProc メソッドでコールバック関数を指定して,そのコールバックの中で取得します.ここでは,Delphi 2009 から使用可能となった無名メソッド (無名関数) でコールバック関数を記述しています.


図5
設計時画面
図6
Button1 クリック
  • エディタでソースコードを表示
図7
Button2 クリック
  • 上の図と同じくソースコードの表示だが,ダイアログでの表示
図8
Button3 クリック
  • テキスト部分のみを取得
図9
Button4クリック
  • 文字列の逐次検索
  • ボタンをクリックすると,次検索
  • フレームで構成されたウェブページにも対応

リスト2
ページのソース取得と文字列の逐次検索
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Chromium1: TChromium;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser;
      const title: ustring; out Result: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ページを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := ExtractFilePath(Application.ExeName) + 'TestPage.html';
  Chromium1.Load(LUrl);

  Edit1.Text := 'フォーム';
end;

//=============================================================================
//  ページのソースをエディタで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  Chromium1.Browser.GetFocusedFrame.ViewSource;
end;

//=============================================================================
//  HTMLのソースコードの取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  ShowMessage( Chromium1.Browser.GetFocusedFrame.Source);
end;

//=============================================================================
//  HTMLのテキスト部分のみを表示
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  Chromium1.Browser.MainFrame.VisitDomProc(
    procedure (const doc: ICefDomDocument)
    begin
      ShowMessage(doc.Body.ElementInnerText);
    end
  );
end;

//=============================================================================
//  表示ページ内の文字列の逐次検索
//  フレームで構成されたウェブページにも対応
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  Chromium1.Browser.Find(Edit1.Text, True, True, False, False);
end;

//=============================================================================
//  TChromiumのOnTitleChangeイベント
//  ページのタイトルが変わったらタイトルを表示
//=============================================================================
procedure TForm1.Chromium1TitleChange(Sender: TObject;
  const browser: ICefBrowser; const title: ustring; out Result: Boolean);
begin
  Self.Caption := title;
end;

end.




03_HTML ページのテキスト入力とボタンクリック


表示しているページのテキスト入力欄への文字列のセットと,ボタンクリックの例です.
ボタンのクリックのコードは,ボタンをクリックした時に実行するコードを書いています.実際の [登録] や [送信] などのボタンというのは,そのボタンをクリックすると,ある動作をするわけですから,このサンプルとしては,これで目的を達していることになります.
実行するコードが JavaScript の関数の場合は,その JavaScript の関数を実行します.

テストに使用した HTML コードは以下のようになっています.

リスト3
文字列のセットとボタンクリックのテスト用 HTML コード
<html>
<head>
<title>テキストのセットとボタンクリックテスト</title>
<meta http-equiv="content-type" content="text/html; charset=shift_jis">
<meta http-equiv="content-style-type" content="text/css">
</head>
<body>
<form method="submit" action="http://mrxray.on.coocan.jp/">
  <td nowrap>お名前</td>
  <td><input type="text" name="name" id="id_name" size="28" value=""></td>
  <br>
  <td nowrap>出身地</td>
  <td><input type="text" name="name" id="id_area" size="28" value=""></td>
  <br>
  <input type="submit" id="id-btn" value="登 録" onClick="#" >
</form>
</body>
</html>




図10
設計時画面
図11
Button1 クリック
  • 文字列をセット
図12
Button2 クリック
  • [登録] ボタンクリックと同じ動作を実行

リスト4
文字列のセットとボタンクリック
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chromium1: TChromium;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ページを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := ExtractFilePath(Application.ExeName) + 'TestFormPage.html';
  Chromium1.Load(LUrl);
end;

//=============================================================================
//  ページの入力欄にテキストをセット  
//  タグのid値を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  Chromium1.Browser.MainFrame.VisitDomProc(
    procedure (const doc: ICefDomDocument)
    var
      LNode : ICefDomNode;
    begin
      LNode := doc.GetElementById('id_name');
      if LNode <> nil then
        doc.GetElementById('id_name').SetElementAttribute('value', '日本 太郎');

      LNode := doc.GetElementById('id_area');
      if LNode <> nil then
        doc.GetElementById('id_area').SetElementAttribute('value', '東京都');
    end
  );
end;

//=============================================================================
//  [登録]ボタンをコードでクリック
//  ページの[登録]ボタンをクリックした時の動作をエミュレート
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  Chromium1.Load('http://mrxray.on.coocan.jp/');
end;

end.


以下のように,ボタンクリックを JavaScript のコードとして実行してしまう方法もあります.
この方法であれば,具体的な実行コードが変わっても,この部分を変更する必要がありません.
form タグが複数ある場合は,何番目かで指定します.下のコードでは 0 になっているので 1 番目ということになります.2 番目の時は forms[1] とします.3 番目の時は forms[2] です.



[備考]
Delphi を使用していると忘れがちですが,JavaScript のコードは,大文字と小文字は区別されます.例えば,getElementById はありますが GetElementById はありません.



//=============================================================================
//  [登録]ボタンをコードでクリック
//  formのsubmitをJavaScriptのコードとして実行
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    LJsText := 'document.forms[0].submit();';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;


今回のサンプルでは,[登録] ボタンの ID 値が HTML コードで設定されています.この場合は,ボタンの ID 値を使用して,次のコードでクリックできます.
ID 値は文字列です.文字列の中に文字列として挿入するには ''' とします.JavaScript の場合は " で囲まれた部分は文字列として認識しますから," でも構いません.
上のコードの forms の場合も,form タグに ID 値が設定されていれば,同じように ID 値で指定することができます.


//=============================================================================
//  [登録]ボタンをコードでクリック
//  [登録]ボタンのID値を使用してJavaScriptのコードとして実行
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LJsText : String;
  LId     : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    //LId := '"id-btn"';でもよい
    LId     := '''id-btn''';
    LJsText := 'document.getElementById(' + Lid + ').click();';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;


タグ名を指定しての操作もできます.
次のコードは Button というタグ名の最初のボタンをクリックします.ID 値はページ内にに 1 つだけしか存在できませんが,タグ名は同じ名前が複数あることがあります.そこで,何番目のタグであるかを指定することになります.
getElementsByTagName は,与えられたタグ名を持つ要素のリストを返すメソッドです.


//=============================================================================
//  [SEND]ボタンをコードでクリック
//  [SEND]ボタンのタグ名を使用してJavaScriptのコードとして実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LJsText  : String;
  LTagName : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    //LTagName := '"button"';でもよい
    LTagName   := '''button''';
    LJsText := 'document.getElementsByTagName(' + LTagName + ')[0].click();';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;




04_イベントリスナー - マウス操作等の検出


ここではマウスカーソル下のタグの情報を取得します.マウスカーソル位置に,タグ <a> ~ </a> があった場合,そのリンク先を取得してフォームの Caption に表示します.

イベントも,ドキュメントに対するものとなります.したがって,VisitDomProc メソッドでコールバック関数を指定して,そのコールバックの中でイベント検出用のリスナーを登録します.



図13
設計時画面
図14
マウスカーソル下の情報
  • Button1 をクリック
  • フォームの Caption にリンク先のアドレスを表示
  • ページが変わったら再度 Button1 をクリックする

リスト5
イベントの検出のサンプル
マウスカーソル下のリンク先 URL を取得して表示
フレーム対応動作
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chromium1: TChromium;
    Panel2: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser;
      const title: ustring; out Result: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ページを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := 'http://mrxray.on.coocan.jp/';
  Chromium1.Load(LUrl);
end;

//-----------------------------------------------------------------------------
//  mouseoverのコールバック関数
//  マウスカーソル下にhref属性の値があればそれを表示.それ以外は空白
//-----------------------------------------------------------------------------
procedure MouseeventCallback(const event: ICefDomEvent);
var
  Lhref : String;
begin
  Form1.Caption := '';

  Lhref := event.Target.GetElementAttribute('href');
  if Lhref = '' then begin
    Lhref := event.Target.Parent.GetElementAttribute('href');
  end;
  Form1.Caption := Lhref;
end;

//=============================================================================
//  イベントリスナーの登録
//  コールバックを呼び出してDocumentオブジェクトに対して操作
//  更にAddEventListenerProcメソッドでコールバック関数を呼び出して登録
//
//  ページが変わったら再度登録する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFrameList : TStringList;
  i          : Integer;
begin
  if not Chromium1.Browser.HasDocument then exit;

  LFrameList := TStringList.Create;
  try
    //フレーム名のリストを作成
    Chromium1.Browser.GetFrameNames(LFrameList);

    //メインページにイベントリスナーを登録
    Chromium1.Browser.MainFrame.VisitDomProc(
      procedure (const doc: ICefDomDocument)
      begin
        doc.Body.AddEventListenerProc('mouseover', True, MouseeventCallback);
      end
    );

    //フレームがあればそのフレームにもイベントリスナーを登録
    for i := 0 to LFrameList.Count - 1 do begin
      Chromium1.Browser.Frame[LFrameList[i]].VisitDomProc(
      procedure (const doc: ICefDomDocument)
      begin
        doc.Body.AddEventListenerProc('mouseover', True, MouseeventCallback);
      end
    );
    end;
  finally
    FreeAndNil(LFrameList);
  end;
end;

//=============================================================================
//  TChromiumのOnTitleChangeイベント
//  ページのタイトルが変わったらタイトルを表示
//=============================================================================
procedure TForm1.Chromium1TitleChange(Sender: TObject;
  const browser: ICefBrowser; const title: ustring; out Result: Boolean);
begin
  Self.Caption := title;
end;

end.




05_JavaScript 関数の実行


既に,ウェブページのボタンクリックのサンプルで,ExecuteJavaScript 関数を使用していますが,それは,実行時に JavaScript のコードを生成して,それを実行するものでした.

本項のサンプルは,HTML コード内の JavaScript 関数を実行します.
実行する JavaScript 関数は,指定の値の間の乱数を発生するものです.ボタンをクリックすると関数を実行してその値をページに表示します.

テストに使用した HTML コードは以下のようになっています.



リスト6
実行する JavaScript 関数とHTMLコード
<html>
<head>
<title>JavaScriptの実行</title>
<meta http-equiv="content-type" content="text/html; charset=shift_jis">
<meta http-equiv="content-style-type" content="text/css">
<script language="javascript">
  function rangeRandom(num1, num2) {
    if((num1 - num2) > 0) {
      var vbig = num1
      var vsmall = num2
    } else  {
      var vbig = num2
      var vsmall = num1
    }
    var range = vbig - vsmall + 1
    var number = Math.floor (Math.random() * range) + vsmall
    document.getElementsByTagName('font')[0].innerText = number
    return (number)
        }
</script>
</head>
<body>
<center>
  乱数発生<br>
  <font size="+4"></font>
</center>
</body>
</html>



図15
設計時画面
図16
[乱数発生]ボタンクリック
  • Edit1 と Edit2 で指定した値の間の乱数を発生
  • 結果はブラウザに表示

リスト7
JavaScript 関数の実行
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chromium1: TChromium;
    Panel2: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ページを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := ExtractFilePath(Application.ExeName) + 'JaveRandom.html';
  Chromium1.Load(LUrl);

  Edit1.Text := '0';
  Edit2.Text := '100';

  Self.Caption := 'JavaScript の実行';
end;

//=============================================================================
//  HTMLページ内のrangeRandomというJavaScript関数(引数が2つ)を実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LJsFunc : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  LJsFunc := 'rangeRandom (' + Edit1.Text + ',' + Edit2.Text + ')';
  Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsFunc, 'about:blank', 0);
end;

end.




06_JavaScript 関数を実行して戻り値を取得


これも JavaSctipt 関数を実行する例ですが,関数の実行結果を Delphi 側で取得する例です.
ExecuteJavaScript 関数の引数を console.log として log メソッドの引数に,実際の関数のコードを渡します.関数の戻り値は,OnConsoleMessage イベントで受け取ります.

以下がテストに使用した HTML コードです.

リスト8
テストに使用したHTMLコード.JavaScript 関数の名前は rangeRandom
<html>
<head>
<title>JavaScriptを実行して戻り値を取得</title>
<meta http-equiv="content-type" content="text/html; charset=shift_jis">
<meta http-equiv="content-style-type" content="text/css">
<script language="javascript">
  function rangeRandom(num1, num2) {
    if((num1 - num2) > 0) {
      var vbig = num1
      var vsmall = num2
    } else  {
      var vbig = num2
      var vsmall = num1
    }
    var range = vbig - vsmall + 1
    var number = Math.floor (Math.random() * range) + vsmall
    return (number)
        }
</script>
</head>
<body>
  JavaScript テストページ
</body>
</html>


図17
設計時画面
図18 Button1 クリック
  • JavaScript の関数が実行される
  • 関数の戻り値を Delphi 側で受け取り,TPanel に表示

リスト9
JavaScript 関数を実行して戻り値を取得する例
関数の戻り値は OnConsoleMessage イベントで受け取る
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chromium1: TChromium;
    Panel2: TPanel;
    Button1: TButton;
    Panel3: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser;
      const title: ustring; out Result: Boolean);
    procedure Chromium1ConsoleMessage(Sender: TObject;
      const browser: ICefBrowser; message, source: ustring; line: Integer;
      out Result: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ページを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := ExtractFilePath(Application.ExeName) + 'JaveRandom.html';
  Chromium1.Load(LUrl);
end;

//=============================================================================
//  HTMLページ内のrangeRandomというJavaScript関数(引数が2つ)を実行
//  関数の戻り値はOnConsoleMessageイベント内で受け取る
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LJsFunc : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  //関数の戻り値をconsoleにする
  LJsFunc := 'console.log(rangeRandom (0, 100))';
  Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsFunc, 'about:blank', 0);
end;

//=============================================================================
//  Chromium1のOnConsoleMessageイベント処理
//  JavaScriptのconsole.logメソッドの結果を受け取る
//=============================================================================
procedure TForm1.Chromium1ConsoleMessage(Sender: TObject;
  const browser: ICefBrowser; message, source: ustring; line: Integer;
  out Result: Boolean);
begin
  if source = 'about:blank' then begin
    Panel3.Caption := message;
  end;
end;

//=============================================================================
//  TChromiumのOnTitleChangeイベント
//  ページのタイトルが変わったらタイトルを表示
//=============================================================================
procedure TForm1.Chromium1TitleChange(Sender: TObject;
  const browser: ICefBrowser; const title: ustring; out Result: Boolean);
begin
  Self.Caption := title;
end;

end.




07_JavaScript による DOM の操作と OnConsoleMessage イベント


JavaScritp のコードを実行時に生成して DOM の操作を行うサンプルです.
既に,ウェブページのボタンクリックのサンプルで,ExecuteJavaScript 関数を使用していますが,それは,1 行だけの javaScript コードでした.ExecuteJavaScript 関数は,複数行の JavaScript のコードも実行できます.

javaScript 内の変数や実行結果は,console オブジェクトの log メソッドの引数として与えれば,OnConsoleMessage イベントで受け取ることができます.
本サンプルの Button1 のコードは,HTML コードのテキスト部分だけを取得して OnConsoleMessage イベントで受け取って,RichEdit1 (TRichEdit) に表示します.
Button2 クリックのコードは,OnConsoleMessage イベントは使用しませんが,複数行の JavaScript の実行例です.入力フォームの入力欄にテキストをセットします.

JavaScript のコードを外部のファイルから読み込む場合は,TStringList 等に読み込み,そのテキストを ExecuteJavaScript 関数の引数にセットします.



[備考]
Delphi を使用していると忘れがちですが,JavaScript のコードは,大文字と小文字は区別されます.例えば,getElementById はありますが GetElementById はありません.
Delphi の大文字と小文字を区別しない仕様は,ある意味便利です.同じ名前の変数や関数,メソッド類の作成を防止できます.




図19
設計時画面
図20
Button1 クリック
  • HTML のテキストだけを取得
  • この値は OnConsoleMessage イベントで受け取っている
図21
Button2 クリック
  • JavaScript の DOM 操作で,入力欄に値をセット

リスト10
JavaScript による DOM の操作操作結果を OnConsoleMessage イベントで受け取る
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    RichEdit1: TRichEdit;
    Chromium1: TChromium;
    Splitter1: TSplitter;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Chromium1ConsoleMessage(Sender: TObject;
      const browser: ICefBrowser; message, source: ustring; line: Integer;
      out Result: Boolean);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ブラウザコンポーネントに指定のHTMLを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := ExtractFilePath(Application.ExeName) + 'TestFormPage.html';
  Chromium1.Load(LUrl);

  RichEdit1.PlainText := True;
  RichEdit1.Lines.Clear;
end;

//=============================================================================
//  JavaScriptのコードを実行して,consoleオブジェクトに出力
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    LJsText := ''
             + 'var LText = document.body.innerText;'
             + 'console.log(LText);';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;

//=============================================================================
//  JavaScriptのDOM操作で入力フォームに値をセット
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    LJsText := ''
             + 'var LiNode = document.getElementById("id_name");'
             + 'if (LiNode) {'
             + '  LiNode.setAttribute("value", "日本 太郎");'
             + '}'
             + ''
             + 'var LiNode = document.getElementById("id_area");'
             + 'if (LiNode) {'
             + '  LiNode.setAttribute("value", "大阪府");'
             + '}';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;

//=============================================================================
//  Chromium1のOnConsoleMessageイベント処理
//  JavaScriptのconsole.logメソッドの結果を受け取る
//=============================================================================
procedure TForm1.Chromium1ConsoleMessage(Sender: TObject;
  const browser: ICefBrowser; message, source: ustring; line: Integer;
  out Result: Boolean);
begin
  RichEdit1.Lines.Clear;
  RichEdit1.Lines.Add(message);
end;

end.




08_JavaScript による DOM の操作でマウスイベントリスナー


これも JavaScritp を実行時に生成して実行する例です.
上の方でテストしたイベントリスナーの機能を JavaScript で実現するサンプルです.ここでは,マウスの移動を検出し,マウスカーソル位置のリンク先を取得して表示します.フレームに対応するコードにしていますが,フレームの実装内容によっては機能しない場合があります.


図22
マウスカーソル下の情報
  • Button1 をクリック
  • Edit1 (TEdit) にリンク先のアドレスを表示
  • ページが変わったら再度 Button1 をクリックする
  • Button2 はリスナー解除

リスト11
JavaScript でマウスイベントリスナーを実装
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Chromium1: TChromium;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Chromium1ConsoleMessage(Sender: TObject;
      const browser: ICefBrowser; message, source: ustring; line: Integer;
      out Result: Boolean);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ブラウザコンポーネントに指定のHTMLを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := 'http://mrxray.on.coocan.jp/';
  Chromium1.Load(LUrl);
end;

//=============================================================================
//  マウスイベントリスナー登録
//  フレーム対応になっているがフレームの構成によっては機能しない場合がある
//
//  [参考]
//  相対URLを取得するにはhrefの代わりにgetAttribute("href")を使用する
//  e.targetの代わりにe.srcElementでも可
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    Chromium1.SetFocus;
    //JavaScriptのコードを生成
    LJsText := ''
             + '/* ------------------------------------------------------------ */'
             + '/* マウスボタンを移動したときに実行される関数 */'
             + '/* ------------------------------------------------------------ */'
             + 'function MouseFunc(e){'
             + '  var LConsolText = "";'
             + '  var Lhref = e.target.href;'
             + '  if (Lhref){'
             + '    LConsolText = Lhref;'
             + '  }'
             + '  var Lhref = e.target.parentNode.href;'
             + '  if (Lhref){'
             + '    LConsolText = Lhref;'
             + '  }'
             + '  console.log(LConsolText);'
             + '}'
             + ''
             + '/* ------------------------------------------------------------ */'
             + '/* イベントリスナー */'
             + '/* ------------------------------------------------------------ */'
             + '/* イベントリスナーに対応している */'
             + 'if(document.addEventListener){'
             + '  /* イベントのリッスンを開始する */'
             + '  document.addEventListener("mousemove", MouseFunc);'
             + '}'
             + ''
             + '/* ------------------------------------------------------------ */'
             + '/* フレームがあればフレームにもイベントリスナー登録 */'
             + '/* ------------------------------------------------------------ */'
             + 'var frames = window.parent.frames;'
             + 'for (var i = 0; i < frames.length; i++) {'
             + '  if(frames[i].document.addEventListener){'
             + '    frames[i].document.addEventListener("mousemove", MouseFunc);'
             + '  }'
             + '}';

    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;

//=============================================================================
//  マウスイベントリスナー解除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    //JavaScriptのコードを生成
    LJsText := ''
             + '/* イベントリスナーに対応している */'
             + 'if(document.removeEventListener){'
             + '  /* ---------------------------------------------------------- */'
             + '  /* イベントのリッスンを終了する */'
             + '  /* ---------------------------------------------------------- */'
             + '  document.removeEventListener("mousemove", MouseFunc);'
             + '}'
             + ''
             + '/* ------------------------------------------------------------ */'
             + '/* フレームのイベントリスナーも終了する */'
             + '/* ------------------------------------------------------------ */'
             + 'var frames = window.frames;'
             + 'for (var i = 0; i < frames.length; i++) {'
             + '  if(frames[i].document.removeEventListener){'
             + '    frames[i].document.removeEventListener("mousemove", MouseFunc);'
             + '  }'
             + '}';

    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;

//=============================================================================
//  Chromium1のOnConsoleMessageイベント処理
//  JavaScriptのconsole.logメソッドの結果を受け取る
//=============================================================================
procedure TForm1.Chromium1ConsoleMessage(Sender: TObject;
  const browser: ICefBrowser; message, source: ustring; line: Integer;
  out Result: Boolean);
begin
  Edit1.Text := '';
  if source = 'about:blank' then begin
    Edit1.Text := message;
  end;
end;

end.




09_JavaScript の関数の生成と実行


実行時に JavaScript の関数のコードを生成して実行する例です.
自作の関数を使用する場合は,まず,その関数のコードをセットして,ExecuteJavaScript でその関数を実行します.本サンプルは,乱数を発生する関数を作成しています.JavaScript の関数は,再定義すると元の定義が上書きされます.

JavaScript のグローバル変数が取得できることもテストしています. JavaScript のグローバル変数は,console.log(変数名) を ExecuteJavaScript で実行すれば,OnConsoleMessage イベントで受け取ることができます.

以下が本サンプルで使用している HTML のコードです.ブラウザに表示する部分が全くありません.オフスクリーン用の TChromiumOSR コンポーネントを使用してもいいかも知れません.



<html>
<body>
</body>
</html>


図23
設計時画面
  • 上が TChromium コンポーネント
  • 下は,JavaScript のコード内の値を受け取って表示する TPanel コンポーネント
図24
実行例
  • Button1 をクリックして JavaScript のコードを生成して設定
  • Button2 クリックで,発生した乱数の値を表示
図25
Button3 をクリック
  • JavaScript のコード内のグローバル変数の値を取得して表示

リスト12
実行時に JavaScript の関数を作成して実行する例
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    Chromium1: TChromium;
    Splitter1: TSplitter;
    Button2: TButton;
    Panel1: TPanel;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Chromium1ConsoleMessage(Sender: TObject;
      const browser: ICefBrowser; message, source: ustring; line: Integer;
      out Result: Boolean);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ブラウザコンポーネントに指定のHTMLを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := ExtractFilePath(Application.ExeName) + 'TestFunc.html';
  Chromium1.Load(LUrl);

  Panel1.Font.Size := 35;
  Panel1.Caption   := '';
end;

//=============================================================================
//  JavaScriptのコードを新規に設定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    LJsText := ''
             + '  var Abc = "テスト文字列";'
             + ''
             + '  function rangeRandom(num1, num2) {'
             + '    if((num1 - num2) > 0) {'
             + '      var vbig = num1;'
             + '      var vsmall = num2;'
             + '    } else  {'
             + '      var vbig = num2;'
             + '      var vsmall = num1;'
             + '    }'
             + '    var range = vbig - vsmall + 1;'
             + '    var number = Math.floor (Math.random() * range) + vsmall;'
             + '    console.log(number);'
             + '  }';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;

//=============================================================================
//  作成したJavaScriptの関数を実行
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    LJsText := 'rangeRandom(1, 100);';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;

//=============================================================================
//  JavaScriptのグローバル変数が取得可能であることを確認
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LJsText : String;
begin
  if not Chromium1.Browser.HasDocument then exit;

  if Assigned(Chromium1.Browser.Mainframe) then begin
    LJsText := 'console.log(Abc);';
    Chromium1.Browser.MainFrame.ExecuteJavaScript(LJsText, 'about:blank', 0);
  end;
end;

//=============================================================================
//  Chromium1のOnConsoleMessageイベント処理
//  JavaScriptのconsole.logメソッドの結果を受け取る
//=============================================================================
procedure TForm1.Chromium1ConsoleMessage(Sender: TObject;
  const browser: ICefBrowser; message, source: ustring; line: Integer;
  out Result: Boolean);
begin
  if source = 'about:blank' then begin
    Panel1.Caption := message;
  end;
end;

end.




10_JavaScript のコードを Delphi の文字列に変換


上のサンプルのように,JavaScritp で DOM の操作を行えば,TChromium コンポーネントに実装されていない機能も実装することができます.
ネット上には,JavaScript のコードが豊富にあります.そこで,それらのコード類を Delphi で利用可能なコード,つまり文字列に変換するサンプルを作成してみました.
単に,テキストを文字列として結合するだけですが,コメントの // を /* */ に,文字列は " で括るようにしています.変換後のコードは,[コピー] ボタンでクリップボードにコピーして,IDE のエディタに貼り付けることができます.

下図は,以下のリンクの記事のコードを,実際にコピーして貼り付けて変換した様子です.



図26
クリップボードから JavaScript のコードをコピーして [貼り付け]
図27
[変換] で Delphi の文字列に変換
  • [コピー] で,表示中のコードをクリップボードにコピー

リスト13
JavaScript のコードを Delphi の文字列に変換
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    RichEdit1: TRichEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils,
  Clipbrd;

{$R *.dfm}

//=============================================================================
//  クリップボードからテキストをRichEdit1に貼り付け
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit1.Lines.Clear;
  RichEdit1.Text := Clipboard.AsText;
end;

//=============================================================================
//  ウェブページにあるJavaScriptのコードをDelphiで使用可能なコードに変換
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSrcStrList : TStringList;
  LDesStrList : TStringList;
  LText       : String;
  LRightChar  : Char;
  LCharSet    : TSysCharSet;
  i           : Integer;
begin
  LSrcStrList := TStringList.Create;
  LDesStrList := TStringList.Create;
  try
    if RichEdit1.Lines.Count > 0 then begin
      LSrcStrList.Text := RichEdit1.Text;

      for i := 0 to RichEdit1.Lines.Count - 1 do begin
        LText := Trim(RichEdit1.Lines[i]);
        //コメントの//はエラーとなるので/* */に変換
        if LeftStr(LText, 2) = '//' then begin
          RichEdit1.Lines[i] := ReplaceStr(RichEdit1.Lines[i], '//', '/*');
          RichEdit1.Lines[i] := RichEdit1.Lines[i] + ' */';
        end else begin
          if LText = '' then begin
            RichEdit1.Lines[i] := LText;
          end else begin
            LRightChar := RightStr(LText, 1)[1];
            LCharSet   := ['{', '}', '(', ')'];
            if not (CharInSet(LRightChar, LCharSet)) then begin
              if LRightChar <> ';' then begin
                RichEdit1.Lines[i] := RichEdit1.Lines[i] + ';';
              end;
            end;
          end;
        end;

        LDesStrList.Add(RichEdit1.Lines[i]);
      end;
      //文字列中の'は"に変換
      LDesStrList.Text := StringReplace(LDesStrList.Text, '''', '"', [rfReplaceAll]);

      LDesStrList.Insert(0, '    LJsText := ''''');
      for i := 1 to LDesStrList.Count - 1 do begin
        LDesStrList[i] := '             + '''  + LDesStrList[i] + '''';
      end;
      LDesStrList[LDesStrList.Count - 1] := LDesStrList[LDesStrList.Count - 1] + ';';
    end;

    RichEdit1.Text := LDesStrList.Text;
  finally
    FreeAndNil(LSrcStrList);
    FreeAndNil(LDesStrList);
  end;
end;

//=============================================================================
//  RichEdit1のテキストをクリップボードへコピー
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  Clipboard.AsText := RichEdit1.Text;
end;

end.




11_Google Chrome の デベロッパーツールのコンソール


上のサンプルプログラムを利用すれば,ネット上のコードが有効利用できますが,目的の動作を実現するにはコードの編集が必要な場合があります.そのような場合,ブラウザに実装されているデベロッパーツールのコンソールを使用すると便利です.
下図のように,入力支援機能がサポートされています.
この図は,上の方のサンプルで使用した,入力フォームのあるウェブページの入力欄に,テキストをセットする以下の JavaScript のコードをテストしたものです.



var LiNode = document.getElementById('id_name');
if (LiNode) {
  LiNode.setAttribute('value', '日本 太郎');
}


このような開発者用のコンソールは,他のブラウザにも実装されています.IE 11 では [F12 開発者ツール] に,FireFox 40.0 には [開発ツール] [Web コンソール] にあります.



図28
[デベロッパーツール] の [コンソール]
  • Google Chrome ブラウザで [F12] で起動できる
  • 起動したら [Console] タブを選択
  • 入力支援機能がある
  • 改行は [Shift] + [Enter]
図29
[Enter] で実行した結果
  • 入力欄にテキストがセットされる




12_印刷関係メソッド


印刷のテストプログラムです.Print メソッドを使用します.現在のところ,印刷プレビューに関するメソッド類はないようです.
用紙サイズ,印刷の方向,ヘッダ,フッタ,余白の設定はイベント内で設定できます.余白を指定しなければデフォルトの値となりますが,ヘッダ,フッタのデフォルトの値はありません.イベント内で設定しないと印刷されません.


図30
設計時画面
図31
[印刷] ボタンクリック
  • [印刷] ダイアログが表示される

リスト14
印刷のテストプログラム
ヘッダ,フッタ,印刷の余白はイベントで設定する
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chromium1: TChromium;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Chromium1TitleChange(Sender: TObject; const browser: ICefBrowser;
      const title: ustring; out Result: Boolean);
    procedure Chromium1PrintHeaderFooter(Sender: TObject;
      const browser: ICefBrowser; const frame: ICefFrame;
      printInfo: PCefPrintInfo; const url, title: ustring; currentPage,
      maxPages: Integer; var topLeft, topCenter, topRight, bottomLeft,
      bottomCenter, bottomRight: ustring; out Result: Boolean);
    procedure Chromium1PrintOptions(Sender: TObject; const browser: ICefBrowser;
      printOptions: PCefPrintOptions; out Result: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://www.useragentstring.com/';
  Button1Click(nil);
end;

//=============================================================================
//  Edit1.TextのURLを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Chromium1.Load(Trim(Edit1.Text));
end;

//=============================================================================
//  印刷
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  Chromium1.Browser.MainFrame.Print;
end;

//=============================================================================
//  TChromiumのOnPrintHeaderFooterイベント処理
//
//  このイベント内でヘッダとフッタを設定する
//  ヘッダはtopXXX,フッタはbottomXXX.ページ(currentPage)ごとに設定可能
//  ここで設定しなければ,ヘッダもフッタも印刷しない
//=============================================================================
procedure TForm1.Chromium1PrintHeaderFooter(Sender: TObject;
  const browser: ICefBrowser; const frame: ICefFrame; printInfo: PCefPrintInfo;
  const url, title: ustring; currentPage, maxPages: Integer; var topLeft,
  topCenter, topRight, bottomLeft, bottomCenter, bottomRight: ustring;
  out Result: Boolean);
begin
  //ヘッダの設定
  topLeft   := 'クロームブラウザの印刷テスト';
  topCenter := '';
  topRight  := '';

  //フッタの設定
  bottomLeft   := '';
  bottomCenter := '';
  bottomRight  := '';
end;

//=============================================================================
//  TChromiumのOnPrintOptionsイベント処理
//
//  このイベント内で用紙サイズ,余白等を設定する
//
//  page_orientation  印刷の方向
//    PORTRAIT   縦(デフォルト)
//    LANDSCAPE  横
//
//  paper_metrics  用紙関係
//    paper_type  用紙タイプ
//      PT_LETTER(デフォルト)
//      PT_LEGAL
//      PT_EXECUTIVE
//      PT_A3
//      PT_A4
//      PT_CUSTOM
//    length      カスタムサイズ用紙の場合の高さ(インチ単位)
//    width       カスタムサイズ用紙の場合の幅(インチ単位)
//
//  paper_margins  印刷の余白(インチ単位)
//    left    左余白
//    right   右余白
//    top     上余白
//    bottom  下余白
//    header  ヘッダ部の余白
//    footer  フッタ部の余白
//=============================================================================
procedure TForm1.Chromium1PrintOptions(Sender: TObject;
  const browser: ICefBrowser; printOptions: PCefPrintOptions;
  out Result: Boolean);
begin
  printOptions.paper_metrics.paper_type := PT_A4;

  printOptions.page_orientation     := PORTRAIT;
  printOptions.paper_margins.left   := 25.0 / 25.4;
  printOptions.paper_margins.top    := 22.0 / 25.4;
  printOptions.paper_margins.right  := 20.0 / 25.4;
  printOptions.paper_margins.bottom := 25.0 / 25.4;

  //Trueにするとオプションの設定が有効となる
  Result := True;
end;

//=============================================================================
//  TChromiumのOnTitleChangeイベント
//
//  ページのタイトルが変わったらタイトルを表示
//=============================================================================
procedure TForm1.Chromium1TitleChange(Sender: TObject;
  const browser: ICefBrowser; const title: ustring; out Result: Boolean);
begin
  Self.Caption := title;
end;

end.




13_印刷ダイアログの遠隔操作 - Windows 7 ではプリンタ名設定可能


印刷の際に表示される,印刷ダイアログの設定を,コードから操作するテストです.
この印刷ダイアログは,ブラウザ特有のものではありません.Windows のシステムのダイアログです.したがって,このサンプルコードは,他のブラウザコントロールでも使用できます.

ダイアログ関係のウィンドウは,WM_ACTIVATE メッセージで処理可能なものが多いのですが,この印刷ダイアログは,まだ他のコントロール類がアクティブなっていないため処理できません.
WM_WINDOWPOSCHANGED メッセージでは,他のコントロールは表示済みですが,SysListView32 のプリンタのリストが完了していません.プリンタの選択操作以外は,このメッセージ内で処理可能です.
そこで,WM_NOTIFY メッセージをローカルフックで処理してみました.

結論を言うと,Windows XP ではプリンタの選択動作に失敗しますが,Windows 7 で成功しています.ただし,これは筆者の環境の場合ですので,他の Windows 7 でプリンタの選択動作を保証するものではありません.
Windows XP では WM_NOTIFY メッセージの処理が完全に終了した後に,希望のプリンタを選択しないと選択操作が完全には行われないようです.しかし,WM_NOTIFY メッセージの終了を捕捉する方法が現在のところ分かりません.一方,Windows 7 ではこの仕様が変更となっているようです.

このテストプログラムでは,[印刷] ボタンをクリックすると,指定したプリンタを自動で選択し,ダイアログの [印刷] ボタンを自動でクリックしますが,Windows XP では常に通常使用するプリンタで印刷することになります.


図32
[印刷] ダイアログ
  • このダイアログのプリンタを自動で選択し,印刷ボタンをクリックすする
図33
設計時画面
  • コンボボックスはプリンタの選択用

リスト15
印刷ダイアログの遠隔操作のテストプログラム
自動でプリンタを選択し,[印刷] ボタンをクリックする.ただし,Windows 7 のみ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chromium1: TChromium;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }

  end;

var
  Form1: TForm1;

implementation

uses
  CommCtrl,
  Printers;

{$R *.dfm}

var
  HookHandle      : HHOOK;
  flgPrintDialog  : Boolean;
  FPrinterNameDlg : String;

//-----------------------------------------------------------------------------
//  ウィンドウハンドルからウィンドウクラス名を取得
//-----------------------------------------------------------------------------
function GetClassNameStr(hWindow: HWND): string;
var
  LBuffer : array[0..MAX_PATH-1] of Char;
  LLen    : Integer;
begin
  FillChar(LBuffer, SizeOf(LBuffer), #0);
  LLen := GetClassName(hWindow, LBuffer, Length(LBuffer));
  if LLen > 0 then Result := LBuffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  ウィンドウのタイトルを取得する関数
//-----------------------------------------------------------------------------
function GetWindowTitleStr(hWindow: HWND): String;
var
  LBuffer : array[0..MAX_PATH-1] of Char;
  LLen    : Integer;
begin
  FillChar(LBuffer, SizeOf(LBuffer), #0);
  LLen := GetWindowText(hWindow, LBuffer, Length(LBuffer));
  if LLen > 0 then Result := LBuffer else Result := '';
end;

//-----------------------------------------------------------------------------
//  EnumChildWindowsのコールバック関数
//  印刷ダイアログのプリンタ一覧のSysListView32のハンドルの取得用
//  FindWindowExやGetWindow関数を使用してもよいが,EnumChildWindowsの方が筆者
//  にとっては手軽なので使用している
//-----------------------------------------------------------------------------
function EnumChildWndProc(hWindow: HWND; lPar: PNativeInt): Boolean; Stdcall;
begin
  Result := True;
  if not IsWindowVisible(hWindow) then exit;

  //クラス名SysListView32が生成されている
  if (GetClassNameStr(hWindow) = 'SysListView32') then begin
    //プリンタのリストが1以上ある場合に限り取得
    //SysListView32が生成されていてもプリンタのリストが生成されていない場合もある
    if ListView_GetItemCount(hWindow) > 0 then begin
      lPar^ := hWindow;
      Result := False;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  WH_CALLWNDPROCRETフックのコールバック関数
//  印刷ダイアログの遠隔操作用
//-----------------------------------------------------------------------------
function RetHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;

  //---------------------------------------------------------------------------
  //  プリンタリスト(クラス名SysListView32)でプリンタを選択するコード
  //  Windows XPでは選択に失敗する.Windows 7 U64では選択可能
  //---------------------------------------------------------------------------
  function SetPrinterOnDialog(PrinterName: String; hWindow: HWND): Boolean;
  var
    LPrnItem : Integer;
    Lplvfi   : TLVFindInfo;
  begin
    Result := False;
    if hWindow = 0 then exit;

    //PrinterNameに該当するリストビューの番号を取得
    Lplvfi.flags := LVFI_STRING;
    Lplvfi.psz   := PChar(PrinterName);
    LPrnItem     := ListView_FindItem(hWindow, 0, Lplvfi);

    if LPrnItem >= 0 then begin
      //見つかったら,それを選択状態にしてフォーカス移動
      ListView_SetItemState (hWindow, LPrnItem, LVIS_SELECTED, LVIS_SELECTED);
      ListView_SetItemState (hWindow, LPrnItem, LVIS_FOCUSED,  LVIS_FOCUSED);
      //見える位置に移動(選択結果の確認用)
      ListView_EnsureVisible(hWindow, LPrnItem, True);
      //これがないとWindows 7でも選択状態が確定しないまま実行されてしまう
      Application.ProcessMessages;
      Result := True;
    end;
  end;
  //---------------------------------------------------------------------------

var
  LTargetWnd   : HWND;
  LRetStruct   : PCWPRETStruct;
  LMsgTarget   : Integer;
  LRectDlg     : TRect;
  LWndListView : HWND;
begin
  if nCode<0 then begin
    Result := CallNextHookEx(HookHandle, nCode, wPar, lPar);
    exit;
  end;

  if nCode = HC_ACTION then begin
    LRetStruct := PCWPRETStruct(lPar);
    LMsgTarget := LRetStruct^.message;
    LTargetWnd := LRetStruct^.hwnd;

    if flgPrintDialog then begin
      if LMsgTarget = WM_NOTIFY then begin
        if GetWindowTitleStr(LTargetWnd) = '印刷' then begin
          //ダイアログの元の位置を記憶しておいて...
          GetWindowRect(LTargetWnd, LRectDlg);
          //ダイアログを事実上見えない位置に移動して操作
          SetWindowPos(LTargetWnd, 0, -10000, 0, 0, 0, SWP_NOSIZE or SWP_NOZORDER);

          //印刷ダイアログの階層下のSysListView32のハンドルを検索
          //LTargetWndは印刷ダイアログのハンドル
          //コールバック関数の戻り値WndListviewはSysListView32のハンドル
          LWndListView := 0;
          EnumChildWindows(LTargetWnd, @EnumChildWndProc, LPARAM(@LWndListView));
          if LWndListView <> 0 then begin
            if not SetPrinterOnDialog(FPrinterNameDlg, LWndListView) then begin
              flgPrintDialog := False;
              //印刷ダイアログの位置を元に戻しておく
              SetWindowPos(LTargetWnd,
                           0,
                           LRectDlg.Left,
                           LRectDlg.Top,
                           0,
                           0,
                           SWP_NOSIZE or SWP_NOZORDER);
              MessageDlg('指定のプリンタが見つかりませんでした.',
                         mtConfirmation, [mbOK], 0);
            end else begin
              flgPrintDialog := False;
              //[印刷]ボタンをクリック
              SendDlgItemMessage(LTargetWnd, 1, BM_CLICK, 0, 0);
            end;
          end;
        end;
      end;
    end;
  end;
  Result := CallNextHookEx(HookHandle, nCode, wPar, lPar);
end;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  flgPrintDialog := False;

  Edit1.Text := 'http://www.useragentstring.com/';
  Button1Click(nil);

  //プリンタのリスト作成(簡易版)
  ComboBox1.Items     := Printer.Printers;
  ComboBox1.ItemIndex := Printer.PrinterIndex;
  FPrinterNameDlg      := Trim(ComboBox1.Text);

  //印刷ダイアログのフックの開始
  HookHandle := SetWindowsHookEx(WH_CALLWNDPROCRET,
                                 @RetHookProc, 0, GetCurrentThreadID);
end;

//=============================================================================
//  印刷ダイアログのフックの終了
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if HookHandle <> 0 then UnhookWindowsHookEx(HookHandle);
end;

//=============================================================================
//  Edit1.TextのURLを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Chromium1.Load(Trim(Edit1.Text));
end;

//=============================================================================
//  印刷
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  //ダイアログ表示のフラグをセット
  flgPrintDialog := True;
  Chromium1.Browser.MainFrame.Print;
end;

//=============================================================================
//  コンボボックスでプリンタを選択したら,印刷ダイアログで自動選択するプリンタ
//  名の変数に値をセット
//=============================================================================
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  FPrinterNameDlg := Trim(ComboBox1.Text);
end;

end.




14_Delphi Chromium Embeded 3 の使用


本ページの最初で述べたもう 1 つの TChromium コンポーネント,Delphi Chromium Embeded 3 を使用するには,以下のような変更が必要です.これらの内容は,[demos] の [guiclient] に具体的な例があります.詳細はそちらを参考にしてください.

ます,プロジェクトのソースコードです.uses に ceflib を追加し,アプリケーションの初期化の前に DLL をロードするようにします.あらかじめ DLL をロードしておかないと,ウェブページの表示に非常に時間がかかってしまいます.


リスト16
Delphi Chromium Embeded 3 を使用する場合のプロジェクトのソースコード例
program Project1;

uses
  ceflib,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  //キャッシュの場所の指定
  //CefCache := 'cache';
  CefSingleProcess := False;
  //DLLのロード
  if not CefLoadLibDefault then exit;

  Application.Initialize;
  //Delphi2007以上
  {$IF CompilerVersion > 18.49}
  Application.MainFormOnTaskbar := True;
  {$IFEND}
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


DOM の操作では,VisitDomProc を直接実行することはできません.TCefRenderProcessHandlerOwn のハンドラを作成して,そこから実行するようにします.
以下のコードは,[03_HTML ページのテキスト入力とボタンクリック] のサンプルの,テキスト入力部分だけを書き換えたものです.

リスト17
ウェブページの入力欄に値をセットする DOM 操作の例
//-----------------------------------------------------------------------------
//
//  【動作確認環境】
//
//  Windows 7 U64(SP1) + Delphi XE(UP1) Pro
//  Delphi Chromium Embedded 3(dcef3/+) [bin] CEF 3.2171.1979
//
//  Presented by Mr.XRAY
//  http://mrxray.on.coocan.jp/
//=============================================================================
unit Unit1;

interface
{$I cef.inc}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ceflib, cefvcl, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chromium1: TChromium;
    Panel2: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  //[demos][guiclient]にあるコードを転記
  TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
  protected
    procedure OnWebKitInitialized; override;
    function OnProcessMessageReceived(const browser: ICefBrowser;
      sourceProcess: TCefProcessId; const message: ICefProcessMessage):
      Boolean; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ページを表示
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LUrl : String;
begin
  LUrl := ExtractFilePath(Application.ExeName) + 'TestPage.html';
  Chromium1.Load(LUrl);
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if CefSingleProcess then Chromium1.Load('about:blank');
  CanClose := True;
end;

//=============================================================================
//  ページの入力欄にテキストをセット  
//  タグのid値を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Chromium1.Browser.HasDocument then exit;

  Chromium1.browser.SendProcessMessage(
    PID_RENDERER, TCefProcessMessageRef.New('visitdom'));
end;

{ TCustomRenderProcessHandler }

//-----------------------------------------------------------------------------
//  TCustomRenderProcessHandlerのOnProcessMessageReceivedメソッド
//  [demos][guiclient]にあるコードを利用
//  DOMの操作例
//
//  {$IFDEF DELPHI14_UP}の使用には{$I cef.inc}が必要
//-----------------------------------------------------------------------------
function TCustomRenderProcessHandler.OnProcessMessageReceived(
  const browser: ICefBrowser; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage): Boolean;
begin
  Result := False;

  {$IFDEF DELPHI14_UP}
  if (message.Name = 'visitdom') then begin
    browser.MainFrame.VisitDomProc(
      procedure(const doc: ICefDomDocument)
      var
        LiNode : ICefDomNode;
      begin
        LiNode := doc.GetElementById('id_name');
        if LiNode <> nil then
          doc.GetElementById('id_name').SetElementAttribute('value', '日本 太郎');

        LiNode := doc.GetElementById('id_area');
        if LiNode <> nil then
          doc.GetElementById('id_area').SetElementAttribute('value', '東京都');
      end
    );
    Result := True;
  end;
  {$ENDIF}
end;

//-----------------------------------------------------------------------------
//  TCustomRenderProcessHandlerのOnWebKitInitializedメソッド
//  [demos][guiclient]にあるコードを利用
//  {$IFDEF DELPHI14_UP}の使用には{$I cef.inc}が必要
//-----------------------------------------------------------------------------
procedure TCustomRenderProcessHandler.OnWebKitInitialized;
begin
{$IFDEF DELPHI14_UP}
//  TCefRTTIExtension.Register('app', TTestExtension);
{$ENDIF}
end;

//-----------------------------------------------------------------------------
//  初期化部
//  [demos][guiclient]にあるコードを利用
//-----------------------------------------------------------------------------
initialization
  CefRemoteDebuggingPort   := 9000;
  CefRenderProcessHandler  := TCustomRenderProcessHandler.Create;
  CefBrowserProcessHandler := TCefBrowserProcessHandlerOwn.Create;
end.




15_Google 検索ページの URL と「Chrome は古いバージョンです」


本ページのサシンプルで使用している TChromium コンポーネントにはデモプログラムが添付されています.その中に guiclient というのがあります.

そのデモプログラムは Google の検索ページを表示するものです.しかし,そのままコンパイルして検索のキーワードを入力しても検索結果を表示してくれません.
デモプログラムで設定している URL は以下となっています.それをその下に示す URL にすれば検索結果を表示するようになります.
Google の検索サービスは 2012年に SSL 化し,検索の仕様も変更しています.その影響と思われますが詳細は不明です.






図34
Google で Delphi を検索した結果
図35
Google で Delphi を検索した結果
  • 検索パラメータに,表示言語を指定する hl がない場合

検索オプションに表示言語の指定である hl がない場合,上の図のように右側に表示言語を選択するメニューが表示されます.
なお,この検索結果の上部に表示されている [ツール] は機能しません.また,Google の検索ページを表示すると,上部に下図のようなバージョンチェックの表示が現れます.これらの現象の回避方法については,現在のところ分かりません.これらの現象は,前述の Delphi Chromium Embeded 3 を使用しても発生します.



図36
バージョンチェックの表示

[備考]
Yahoo! の検索も 2015年 SSL 化されました.2017年1月4日現在,Yahoo! と Google の検索エンジンは同じですが,Yahoo! での検索結果は,知恵袋等の内容も考慮した内容となっています.