TWebBrowserとTDBGrid
解決一つのフォームにWebBrowserとDBGridを配置して表示すると、Formを開いた当初は、DBGridをクリックすると、カーソルがその行に行くのに、一度WebBrowserをマウスで操作した後は、DBGridをクリックしても、カーソが移動しなくなりました。(マウスホイールによる行移動は可能です。)
いくつかのプログラムで試しをしましたが、同様になります。
WebBrowserとDBGridの相性なのでしょうか。
プロパティーの変更等で対応できるのでしょうかおわかり方がいらっしゃいましたら教えてください。
環境：Windows7 64bit Delphi XE2です。
TWebBrowserとTStringGridの組み合わせで再現を確認しました。
（Delphi6 Personal、WindowsXP、IE8）
＞プロパティーの変更等で対応できるのでしょうか
何かの設定で直せるものではないと思います。
私の調べた限りでは、下記の「TWebBrowserがActiveControlにならない」という事象に起因する
不具合だと思います。
How to make a TWebBrowser become the active control when clicked - DelphiDabbler.com
http://www.delphidabbler.com/articles?article=19
例示されてるコードやダウンロードできるデモプロジェクトの通りにすれば修正できると思います。
でもこのサンプルは、タイマーでポーリングしてTApplicationEventsのOnMessageで処理、しかも
TWebBrowserは1個に限定！という、かなりアレな感じですけど。
TUIWebBrowserとかTEmbeddedWBとかの利用を検討するのはどうでしょうか。
ただし、これらでIEコンポーネントの不具合がどれだけ解消しているのか知りません。
TChromium（DCEF3）という先進的なものもあります。これは割と良い感触でした。
TWebBrowserの既知の不具合を手軽に修正する方法を研究してましたので、この機会に
今回のT****Gridと絡んだ不具合の修正も加えて完成させてみました。
ただ、、、まだあんまりテストしてません。Windows7や64bitOS環境も未チェックです。
もしよろしければテストしてみてください。
・ActiveControlに関しては、前述のサイトの情報を元に再構築しました。
・textareaとファイル名変更に関しては、古来より伝わるコード？を整頓して使ってます。
※1998年の時点ですでに原型が見られます。
GetClassName function - Experts Exchange（1998/07/28）
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_10067496.html
-------------------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, OleCtrls, SHDocVw_TLB; // ←環境によりSHDocVwになる
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
WebBrowser2: TWebBrowser;
StringGrid1: TStringGrid;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Unit2, // TWebBrowserFix
ActiveX; // OleInitialize, OleUninitialize
procedure TForm1.FormCreate(Sender: TObject);
begin
TWebBrowserFix.Create(WebBrowser1); // Navigateの直前でFixを生成しておく
WebBrowser1.Navigate('https://www.petitmonte.com/bbs/answers?question_id=8026');
WebBrowser2.Navigate('https://www.petitmonte.com/bbs/answers?question_id=973');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TWebBrowserFix.Create(WebBrowser2); // 後から任意の時点でFixを生成してもOk
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.
-------------------------------------------------------------------------------
unit Unit2;
interface
uses
Windows, Messages, Classes, SHDocVw_TLB; // ←環境によりSHDocVwにする
type
TWebBrowserFix = class(TComponent)
private
FIEServerWin: HWND;
FDefOnNavigateComplete2: TWebBrowserNavigateComplete2;
function MakeFixProc(): Boolean;
function GetIEServerWindow(EmbedWin: HWND): HWND;
procedure FirstTimeNaviComp2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure AppEventsMessage(var Msg: TMsg; var Handled: Boolean);
public
constructor Create(AWebBrowser: TWebBrowser); reintroduce;
end;
implementation
uses
AppEvnts, // TApplicationEvents
ActiveX, // IOleInPlaceActiveObject
Forms; // GetParentForm(TControl)
constructor TWebBrowserFix.Create(AWebBrowser: TWebBrowser);
begin
inherited Create(AWebBrowser);
if MakeFixProc() then Exit;
FDefOnNavigateComplete2:=TWebBrowser(Self.Owner).OnNavigateComplete2;
TWebBrowser(Self.Owner).OnNavigateComplete2:=FirstTimeNaviComp2;
end;
function TWebBrowserFix.MakeFixProc(): Boolean;
begin
Result:=False;
FIEServerWin:=GetIEServerWindow(TWebBrowser(Self.Owner).Handle);
if FIEServerWin=0 then Exit;
Result:=True;
TApplicationEvents.Create(Self).OnMessage:=AppEventsMessage;
end;
function TWebBrowserFix.GetIEServerWindow(EmbedWin: HWND): HWND;
var
DocObjWin: HWND;
begin
Result:=0;
if EmbedWin=0 then Exit;
DocObjWin:=FindWindowEx(EmbedWin, 0, 'Shell DocObject View', nil);
if DocObjWin<>0 then
Result:=FindWindowEx(DocObjWin, 0, 'Internet Explorer_Server', nil);
end;
procedure TWebBrowserFix.FirstTimeNaviComp2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Assigned(FDefOnNavigateComplete2) then FDefOnNavigateComplete2(Sender, pDisp, URL);
if not MakeFixProc() then Exit;
TWebBrowser(Self.Owner).OnNavigateComplete2:=FDefOnNavigateComplete2;
end;
procedure TWebBrowserFix.AppEventsMessage(var Msg: TMsg; var Handled: Boolean);
var
Dispatch: IDispatch;
iOIPAO: IOleInPlaceActiveObject;
begin
if Msg.hwnd<>FIEServerWin then Exit;
// ・TWebBrowserがActiveControlにならないため、TStringGrid等で矢印キー移動できない
// …という不具合の修正
case Msg.message of
WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN: begin
GetParentForm(TWebBrowser(Self.Owner)).ActiveControl:=TWebBrowser(Self.Owner);
Exit;
end;
end;
// ・Web表示モード時にtextareaで改行が入力できない
// ・Web表示モード時にtextareaで矢印キー押下でアプリ内の他コントロールに移動してしまう
// ・フォルダ表示モード（Explorerモード？）時にファイル名を変更できない
// …という不具合の修正
Handled:=IsDialogMessage(TWebBrowser(Self.Owner).Handle, Msg);
if Handled and not (TWebBrowser(Self.Owner).Busy or
(((Msg.message=WM_KEYDOWN) or (Msg.message=WM_KEYUP)) and
(Msg.wParam in [VK_BACK, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]))) then begin
Dispatch:=TWebBrowser(Self.Owner).Application;
if Dispatch<>nil then begin
Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
if iOIPAO<>nil then iOIPAO.TranslateAccelerator(Msg);
end;
Dispatch._Release;
end;
end;
end.
Harryさん、ありがとうございました。
ご提示いただいたソースを、自分なりに理解しながら、試してみたいと思います。
まだ、ご報告しますが、しばらくお時間をください。
Harryさんのソースで、試しをしてみました。
Unit2で
procedure FirstTimeNaviComp2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure AppEventsMessage(var Msg: TMsg;
に対して
constructor TWebBrowserFix.Create(AWebBrowser: TWebBrowser)
で
TWebBrowser(Self.Owner).OnNavigateComplete2:=FirstTimeNaviComp2;
としているため、パラメータが足りないとエラーが出ます。
どのようにしたらいいのでしょうか。
本題に入る前にひとつ。
先のソースではCreateの引数をチェックしてませんでしたが、そこくらいは押さえておきたいので、
implementation 〜 コンストラクタまでのコードを以下のように変更します。
-----------------------------------------------------------------------------------------
implementation
uses
SysUtils, // class(Exception);
AppEvnts, // TApplicationEvents
ActiveX, // IOleInPlaceActiveObject
Forms; // GetParentForm(TControl)
type
EArgumentNilException = class(Exception);
constructor TWebBrowserFix.Create(AWebBrowser: TWebBrowser);
begin
if AWebBrowser=nil then
raise EArgumentNilException.Create('Error TWebBrowser not Assigned.');
inherited Create(AWebBrowser);
if MakeFixProc() then Exit;
FDefOnNavigateComplete2:=TWebBrowser(Self.Owner).OnNavigateComplete2;
TWebBrowser(Self.Owner).OnNavigateComplete2:=FirstTimeNaviComp2;
end;
-----------------------------------------------------------------------------------------
テストしていただき、ありがとうございます。 結論から言いますと、
Delphi XE2以降の場合、FirstTimeNaviComp2メソッドのパラメータ、var URL: OleVariant の部分を、
const URL: OleVariant のように、var を const に書き換えてください。
※なお、いま試案中の方法ではOnNavigateComplete2を使わず、このメソッドも不要になる…はず。
以下はチラシの裏です。
-----------------------------------------------------------------------------------------
＞パラメータが足りないとエラーが出ます。
悩みました。考えても分からないので、XE4 トライアル版をインストールしてみました ＼(＾o＾)／
すると…コンパイルエラーが1個発生。
＞[dcc32 エラー] Unit2.pas(50): E2009 型に互換性がありません : パラメータリストが異なります
よくよくOnNavigateComplete2のイベントハンドラ（TWebBrowserNavigateComplete2）を見比べますと…
■Delphi 6 Personal（SHDocVw_TLB.pas）
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
■Delphi XE4（SHDocVw.dcu）
procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);
パラメータが微妙に、var → const に変わってる。 ひどすぎるよ、こんなのってないよ！
そこで、いつから変わったのか調べました。
SHDocVw.TWebBrowserNavigateComplete2 - XE オンラインヘルプ
http://docwiki.embarcadero.com/VCL/XE/ja/SHDocVw.TWebBrowserNavigateComplete2
＞C++ typedef void __fastcall (__closure *TWebBrowserNavigateComplete2)(System::TObject* ASender, const _di_IDispatch pDisp, System::OleVariant &URL);
SHDocVw.TWebBrowserNavigateComplete2 - XE2 オンラインヘルプ
http://docwiki.embarcadero.com/Libraries/XE2/ja/SHDocVw.TWebBrowserNavigateComplete2
＞C++ typedef void __fastcall (__closure *TWebBrowserNavigateComplete2)(System::TObject* ASender, const _di_IDispatch pDisp, const System::OleVariant &URL)
※Delphiのコードはなぜか記載なし。
C++のコードはほとんど理解してませんが、XE2から const が付いたのでそこから変更ではないかと。
D2009以前はどれも var であることを確認、D2010はヘルプが変なので不明ですが、やはり var でしょう。
http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/SHDocVw_TWebBrowserNavigateComplete2.html
http://docwiki.embarcadero.com/VCL/2010/ja/SHDocVw.TWebBrowserNavigateComplete2
もしや…と思ってOnBeforeNavigate2も調べると、やはり const に変わってる。
procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
これじゃURLが書き換えられない…リダイレクトさせたい場合はどうすれば…？
ヘルプの記述「この値を変更すると…」とも矛盾するし、一体全体どうなっているんでしょうね？？
Harryさんありがとうございました。
「const URL: OleVariant」 と、varをconstに書き換えてエラーが発生しなくなりました。
ただ、 マウスをWebBrowser1から移動して最初のDBGrid1のクリックときに、クリックした行からまた、その直前の行に戻ってしまいます。
そこで、DBGridのonMouseEnterを次のように設定して、とりあえず思うような動きが実現しました。
procedure TForm1.DBGrid1MouseEnter(Sender: TObject);
begin
DBGrid1.SetFocus;
end;
開発中のプログラムは、
氏名,住所 のCSVを読み込んで、GoogleMap APIで緯度、経度を取り込み、DBGrid1に氏名、住所、緯度、経度を表示して、
WebBrowserにGoogleMapを表示して、マーカー設定。
DBGrid1をクリックしてInfoWindowを表示
でした。
Harryさんご教授のソースを理解しきった訳ではありませんが、とりあえず期待に近い動きを実現できました。
ソースについては、をもう一度じっくり読んでみたいと思います。
「※なお、いま試案中の方法ではOnNavigateComplete2を使わず、このメソッドも不要になる…はず。」にも興味があります。
とりあえずは解決としますが、また教えてください。
| ツイート |  |