Web画面を左クリックで別タブで開くには。
解決よろしくお願いします。環境はWindowsXP sp3 Delphi6Personalです。
過去ログ「PageControlのページを削除するとエラーがでる」でママンさんが
回答されているタブブラウザの基本を元にタブブラウザを作成しています。
問題なく動くのですが、
どうしても解決できないことがあり質問いたしました。
Web画面のリンクを「左クリック」すると、たいてい同じ画面が更新して開きます。
これを毎回別タブで開きたいのですか、教えていただけないでしょうか。
NewWindow2は、リンクを「右クリック」で「新しいウィンドウで開く」なら別窓で開くのですが。
D６PersonalではTwebBrowserのヘルプ表示をしなくてプロパティにもイベントにもそれらしいのを発見できませんでした。
よろしくお願いします。
ソースコード（FormにPagecontrol１、Edit１、Button１を配置）
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, ExtCtrls, ComCtrls, StdCtrls, SHDocVw_TLB, ImgList;
type
TIETabSheet = class(TTabSheet)
public
WebBrowser1 : TWebBrowser;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TForm1 = class(TForm)
Button1: TButton;
Edit1: TComboBox;
PageControl1: TPageControl;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TIETabSheet }
constructor TIETabSheet.Create(AOwner: TComponent);
begin
inherited;
WebBrowser1 := TWebBrowser.Create(self);//タブシートの作成と同時にブラウザ作成
TOleControl(WebBrowser1).Parent := Self;
WebBrowser1.Align := alClient;
end;
destructor TIETabSheet.Destroy;
begin
WebBrowser1.Free;
inherited;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
IETab:TIETabSheet;
begin
IETab := TIETabSheet.Create(PageControl1);
IETab.Parent := PageControl1;
IETab.PageControl := PageControl1;
PageControl1.ActivePage := TTabSheet(IETab);
IETab.WebBrowser1.Navigate(Edit1.Text);
end;
procedure TIETabSheet.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var
IETab: TIETabSheet;
begin
if (Button1のClickでない場合) then begin
Cancel := True;
with Form1 do begin
IETab := TIETabSheet.Create(PageControl1)
IETab.Parent := PageControl1;
IETab.PageControl := PageControl1;
IETab.PageControl1.ActivePage := TTabSheet(IETab);
IETab.WebBrowser1.Navigate(URL);
end;
end;
end;
これでどう？さん回答有り難うございます。
procedure TForm1.Button1Click(Sender: TObject);
で clickfrag:=true;して
BeforeNavigate2で
procedure TIETabSheet.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var
IETab: TIETabSheet;
begin
if clickfrag=false then
begin
Cancel := True;
with Form1 do
begin
IETab := TIETabSheet.Create(PageControl1);
IETab.Parent := PageControl1;
IETab.PageControl := PageControl1;
PageControl1.ActivePage := TTabSheet(IETab);
WebBrowser1.Navigate(URL);
end;
end;
clickfrag:=false;
end;
としてみましたが
if (Button1のClickでない場合) then begin
をどのような方法でとらえるかがキーになると思いますが
私はまだ解決できませんでした。
1 フラグを1つ用意し、Form1.OnCreateとかのタイミングでFalseに初期化。
2 ボタンクリックで動かすときは、そのフラグをTrueに書き換える。
2 WebBrowser1BeforeNavigate2内では、フラグがFalseのときとTrueのとき
で処理を分岐させる。終わった後は、そのフラグを常にFalseに設定する。
というより、常に左クリックで開きたいなら
procedure TIETabSheet.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var
IETab: TIETabSheet;
begin
Cancel := True;
with Form1 do begin
IETab := TIETabSheet.Create(PageControl1)
IETab.Parent := PageControl1;
IETab.PageControl := PageControl1;
IETab.PageControl1.ActivePage := TTabSheet(IETab);
IETab.WebBrowser1.Navigate(URL);
end;
end;
ボタンを押されたかどうかなんて判別する必要がない。
真琴：「アタシもココの"Button1のClickでない場合"の条件は必要ないと思う、そうでしょ？ おじいちゃん」
勝爺：「ナンだ？ そんなの、オレが分かるワケねぇだろぅ」
真琴：「このBeforeNavigate2のハンドラ設定のタイミングをイツに合わせるのかがミソだと思うの」
勝爺：「そうだよな、ミソはやっぱり合わせ味噌が一番だ、ほら味見してみろ」
真琴：「ウン、美味しいよね、って、ミソが違うでしょ、DocumentCompleteのタイミングに合わせてBeforeNavigate2のハンドラを設定しなくちゃダメってコト…」
procedure TIETabSheet.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
WebBrowser1.OnBeforeNavigate2 := WebBrowser1BeforeNavigate2; //ここでハンドラを設定
TTabSheet(TControl(Sender).Parent).Caption := OleVariant(WebBrowser1.Document).Title;
end;
procedure TIETabSheet.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var
IETab: TIETabSheet;
begin
with Form1 do begin
Cancel := True;
IETab := TIETabSheet.Create(PageControl1);
IETab.Parent := PageControl1;
IETab.PageControl := PageControl1;
IETab.PageControl.ActivePage := TTabSheet(IETab);
IETab.WebBrowser1.Navigate(URL);
end;
end;
勝爺：「最初っから合わせといた方がイイんだよ、両方の味噌の味がなじむから」
真琴：「もう、そのミソじゃないンだってば…、生成時に合わせちゃうと循環呼び出しでスタックがあふれてクラッシュなの」
勝爺：「クラッシュ？ ナンだ？ …そんなコトよかハルコの方が心配だろぅ、何か事故でも…」
真琴：「おじいちゃん、ハルコさんなら大丈夫よ、アタシも心配してソンしちゃった」
勝爺：「ン？ マコト、ドゥいうことだ？」
真琴：「昨日の夜、夢でアタシはアッチを見に行ったの、そぅしたら…」
勝爺：「そしたら？ …ナンだってんだ？
真琴：「ハルコさんのメモがあって、それ見たら、"アタシが高校生だった時代の宇宙を偶然見つけたから、そこでしばらく高校生活を楽しんだ後でソッチに戻るネ" だって」
勝爺：「なんだ、そういうことか、ハルコらしくてノンキなこった」
真琴：「おじいちゃんも似てるトコあるよね？ こんな話で直ぐに納得してくれて」
勝爺：「ドゥいう意味だ？ …ところで、マコト」
真琴：「なぁに？」
勝爺：「マコトの話が本当なら、アッチの民宿にはもう誰も居ねえンだよな？」
真琴：「うん、でも、戸締りと電気、火の始末なんかはチャンとしてきたから…」
勝爺：「そういうことじゃなくて、オレをコッチに運ばないで、お前たちがアッチに戻った方が良かったンじゃねぇのか？」
真琴：「あぁそれ…、アタシもそう言ったんだけど、ハルコさんが猛反対して…」
勝爺：「ハルコが反対？ ナンでだ？」
真琴：「"アッチに戻ると四つも歳を食うからイヤよ" って、でも、おじいちゃんくらいの歳になってしまえばねぇ〜？」
勝爺：「ん？ またまたドゥいう意味だ？」
ａさん、合わせミソ さん有り難うございます。
返事が遅くなりすみません。navigateを検索していたらnavigate2というのが
あり、フラグを１にして新しくウィンドウを作成などと書いてありましたので
Delphiの例ではなかったのでいろいろ挑戦していましたが
navigate2が未定義だとでるので頓挫したところでした。
クリエイトで
WebBrowser1.onBeforeNavigate2 := WebBrowser1BeforeNavigate2;
合わせみそさんの例では追加して
WebBrowser1.OnDownloadComplete := WebBrowser1DownloadComplete;
私のコードにで試したら、どちらもタブが無数にできて
成功しませんでした。
最初書いた私のコードはコピペすれば一応動きますが、その例で
動いたのでしょうか？どこか私の設定が悪いのでしょうか？
すみません。
以上ご報告まで。
タブが無数に出来てクラッシュしてしまう原因は、
TabSheetのCreateの時点で
WebBrowser1.onBeforeNavigate2 := WebBrowser1BeforeNavigate2;
を実行してしまうから。
前の回答をよく読めば分かると思うけど？
ａさん、合わせみそさん、次のように改変してみたら動きました。
最初のURL表示で無数にタブができてしまうので
WebBrowser1DocumentComplete(
WebBrowser1BeforeNavigate2(をコピペして
チェックボックス（何でもいいと思いますが）で別窓で開くときは
チェックしてリンクをクリックするようにしました。
begin
if Form1.CheckBox1.Checked=false then exit;//--追加
with Form1 do begin
Cancel := True;
IETab := TIETabSheet.Create(PageControl1);
IETab.Parent := PageControl1;
IETab.PageControl := PageControl1;
IETab.PageControl.ActivePage := TTabSheet(IETab);
Form1.CheckBox1.Checked:=false; //---追加
IETab.WebBrowser1.Navigate(URL);
end;
end;
別窓で開かず通常で開きたい場合もあると思いますので
何か工夫してみたいと思います。
有り難うございました。
| ツイート |  |