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月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 (グーグルクローム) ブラウザを起動してウエブページを表示
copy code
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 .
HTML のソースコードの取得と文字列検索の例です.
文字列の検索は,フレームに対応してますが,ソースコード等は,フレームごとに指定する必要があります.
dcef-r306 では,DOM の操作,つまりドキュメントの操作は,VisitDomProc メソッドでコールバック関数を指定して,そのコールバックの中で取得します.ここでは,Delphi 2009 から使用可能となった無名メソッド (無名関数) でコールバック関数を記述しています.
図5
設計時画面
図6
Button1 クリック
図7
Button2 クリック
上の図と同じくソースコードの表示だが,ダイアログでの表示
図8
Button3 クリック
図9
Button4クリック
文字列の逐次検索
ボタンをクリックすると,次検索
フレームで構成されたウェブページにも対応
copy code
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 コード
copy code
<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 クリック
copy code
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 はありません.
copy code
// =============================================================================
// [登録]ボタンをコードでクリック
// 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 値で指定することができます.
copy code
// =============================================================================
// [登録]ボタンをコードでクリック
// [登録]ボタンの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 は,与えられたタグ名を持つ要素のリストを返すメソッドです.
copy code
// =============================================================================
// [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 ;
ここではマウスカーソル下のタグの情報を取得します.マウスカーソル位置に,タグ <a> ~ </a> があった場合,そのリンク先を取得してフォームの Caption に表示します.
イベントも,ドキュメントに対するものとなります.したがって,VisitDomProc メソッドでコールバック関数を指定して,そのコールバックの中でイベント検出用のリスナーを登録します.
図13
設計時画面
図14
マウスカーソル下の情報
Button1 をクリック
フォームの Caption にリンク先のアドレスを表示
ページが変わったら再度 Button1 をクリックする
リスト5
イベントの検出のサンプル
マウスカーソル下のリンク先 URL を取得して表示
フレーム対応動作
copy code
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 .
既に,ウェブページのボタンクリックのサンプルで,ExecuteJavaScript 関数を使用していますが,それは,実行時に JavaScript のコードを生成して,それを実行するものでした.
本項のサンプルは,HTML コード内の JavaScript 関数を実行します.
実行する JavaScript 関数は,指定の値の間の乱数を発生するものです.ボタンをクリックすると関数を実行してその値をページに表示します.
テストに使用した HTML コードは以下のようになっています.
リスト6
実行する JavaScript 関数とHTMLコード
copy code
<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 で指定した値の間の乱数を発生
結果はブラウザに表示
copy code
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
copy code
<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 イベントで受け取る
copy code
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 イベントで受け取る
copy code
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 でマウスイベントリスナーを実装
copy code
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 .
実行時に 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 の関数を作成して実行する例
copy code
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 の文字列に変換
copy code
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] で実行した結果
印刷のテストプログラムです.Print メソッドを使用します.現在のところ,印刷プレビューに関するメソッド類はないようです.
用紙サイズ,印刷の方向,ヘッダ,フッタ,余白の設定はイベント内で設定できます.余白を指定しなければデフォルトの値となりますが,ヘッダ,フッタのデフォルトの値はありません.イベント内で設定しないと印刷されません.
図30
設計時画面
図31
[印刷] ボタンクリック
リスト14
印刷のテストプログラム
ヘッダ,フッタ,印刷の余白はイベントで設定する
copy code
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 のみ
copy code
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 を使用する場合のプロジェクトのソースコード例
copy code
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 操作の例
copy code
// -----------------------------------------------------------------------------
//
// 【動作確認環境】
//
// 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! での検索結果は,知恵袋等の内容も考慮した内容となっています.