PageControlのページを削除するとエラーがでる
解決いつもお世話になっております。
PageControlにブラウザを表示させています。
Webページのリンクをクリックして次の画面を表示させます。
一度リンクで次画面を表示させたページを削除すると、削除時はエラーになりませんが、次にほかのボタン操作をすると次のようなエラーがでます。
「Access violation at address 00000017. Read of address 00000017.」
ページをリンクで次画面など表示させない場合はエラーはでません。
長くなりますがプログラムソースは、下記の通りです、なにか基本的な処理をしていないと思いますが、解決しません。
ご指導をお願いいたします。環境WindowsXP Delphi6 Personalです。
FormにPageControlを貼り付け、ToolBarにComboBox1とNavigate、とページ削除ボタンを付けます。
uses SHDocVw_TLB,OleCtrls;//追加
var
Form1: TForm1;
TabSheet : TTabSheet;
WebBrowser1: TWebBrowser;
・・・・・
procedure TForm1.ToolButton1Click(Sender: TObject);//TWebBrowserを動的に生成する
begin
TabSheet := TTabSheet.Create(PageControl1);
TabSheet.Parent := PageControl1;
TabSheet.PageControl := PageControl1;
WebBrowser1 := TWebBrowser.Create(TabSheet);
TOleControl(WebBrowser1).Parent := TabSheet;
WebBrowser1.Align := alClient;
WebBrowser1.Navigate(ComboBox1.Text);
end;
procedure TForm1.ToolButton2Click(Sender: TObject);//アクティブページの削除
begin
PageControl1.Pages[PageControl1.ActivePageIndex].Free;
end;
よろしくお願いいたしますm(_ _)m
ブラウザの変わりにbuttonを使ってますが要は同じです。
これは理解しやすいように設計しましたが、
私が実装するんでしたら、このような方法は取りません。
ブラウザを配置したTabSheet継承コンポ（クラス）を作成します。
興味あるならサンプル作ります。
procedure TForm1.Button1Click(Sender: TObject);
var
TabSheet : TTabSheet;
button : TButton;
strName : String;
begin
strName := 'N' + inttostr(GetTickCount);
TabSheet := TTabSheet.Create(PageControl1);
TabSheet.Name := strName;
TabSheet.Parent := PageControl1;
TabSheet.PageControl := PageControl1;
TabSheet.Caption := inttostr(TabSheet.TabIndex);
button :=TButton.Create(self);
button.Name := strName + 'b';
button.Parent := TabSheet;
button.Caption := inttostr(TabSheet.TabIndex);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
TabSheet : TTabSheet;
i:Integer;
begin
i:=PageControl1.ActivePageIndex;
if i<0 then exit;
TabSheet := PageControl1.Pages[i];
FindComponent(TabSheet.Name + 'b').Free;
TabSheet.Free;
end;
ママンさん、お返事ありがとうございます。
もう駄目かと諦めかけていたところ藁をつかむ思いで返事を読みました。
レベルが低いためママンさんの述べられていることが理解できませんが私なりに理解した範囲で次のようにしてみました。
type
TTabSheetEx = class(TTabSheet)
public
WebBrowser1: TWebBrowser;
FBack: Boolean;
FForward: Boolean;
UrlText:string;
TitleText:string;
end;
・・・
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
TabSheetEx :=TTabSheetEx.Create(Form1.PageControl1);
TabSheetEx.Parent :=PageControl1;
TabSheetEx.PageControl :=PageControl1;
TabSheetEx.Caption := 'blank';
TabSheetEx.WebBrowser1 :=TWebBrowser.Create(TabSheetEx);
TOleControl(TabSheetEx.WebBrowser1).Parent :=TabSheetEx;
TabSheetEx.WebBrowser1.Align := alClient;
TabSheetEx.WebBrowser1.OnCommandStateChange := WebBrowser1CommandStateChange; //イベントを定義しておく
TabSheetEx.WebBrowser1.Navigate(ComboBox1.Text);
end;
結果は駄目でしたが、どうもこういうことではないのですね。
ただいま、Buttonとブラウザを置き換えていろいろ挑戦しておりますが、未解決です。
できましたら、もう少しご説明していただけないでしょうか。お願いいたします。
ママンさま、その後下記のようにしてみました。
今のところエラーもでなくて動きますが、ママンさんが述べられていたこととは違うのでしょうか。
自分ではもう、何をしているのか理屈もわからずやっている状態ですが。
大変馬鹿なことをやっているかもしれません。何かありましたらご指導ください。
type
TTabSheetEx = class(TTabSheet)
public //private
WebBrowser1: TWebBrowser;
FBack: Boolean;
FForward: Boolean;
FUrlText:string;
FTitleText:string;
end;
・・・・
procedure TForm1.ToolButton1Click(Sender: TObject);//ナビゲート
var
TabSheet : TTabSheet;
button : TButton;
strName : String;
begin
strName := 'N' + inttostr(GetTickCount);
TabSheet := TTabSheet.Create(PageControl1);
TabSheet.Name := strName;
TabSheet.Parent := PageControl1;
TabSheet.PageControl := PageControl1;
TabSheet.Caption := inttostr(TabSheet.TabIndex);
TabSheetEx :=TTabSheetEx.Create(self);
TabSheetEx.Parent :=TabSheet;
TabSheetEx.Caption := inttostr(TabSheet.TabIndex);
TabSheetEx.WebBrowser1 :=TWebBrowser.Create(TabSheetEx);
TOleControl(TabSheetEx.WebBrowser1).Parent :=TabSheetEx;
TabSheetEx.Name:= strName + 'b';
TOleControl(TabSheetEx.WebBrowser1).Parent :=TabSheet;
TabSheetEx.WebBrowser1.Align := alClient;
PageControl1.ActivePageIndex:=PageControl1.PageCount-1;
TabSheetEx.WebBrowser1.Navigate(ComboBox1.Text);
end;
procedure TForm1.ToolButton2Click(Sender: TObject);//削除
var
i:Integer;
begin
i:=PageControl1.ActivePageIndex;
if i<0 then exit;
TabSheet := PageControl1.Pages[i];
FindComponent(TabSheet.Name + 'b').Free;
TabSheet.Free;
end;
よろしく尾長言い足します。
ちょっと上見てませんが、こんな感じです。
D6perへの書き換えはもう知ってますよね。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ExtCtrls, ComCtrls, StdCtrls;
type
TIETabSheet = class(TTabSheet)
private
procedure BrowserNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
public
Browser : TWebBrowser;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TForm1 = class(TForm)
PCBrowser: TPageControl;
Panel1: TPanel;
EditURL: TEdit;
BtnNavigate: TButton;
BtnNewPage: TButton;
BtnClose: TButton;
procedure BtnNavigateClick(Sender: TObject);
procedure BtnNewPageClick(Sender: TObject);
procedure BtnCloseClick(Sender: TObject);
private
{ Private 宣言 }
procedure AddNewPage(URL:String);
procedure ClosePage(Index:Integer);
procedure NavigatePage(Index:Integer; URL:String);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses Math;
{$R *.dfm}
{ TIETabSheet }
procedure TIETabSheet.BrowserNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
//タブのキャプション決定
Caption:= Browser.LocationName;
end;
constructor TIETabSheet.Create(AOwner: TComponent);
begin
inherited;
//タブシートの作成と同時にブラウザ作成
Browser := TWebBrowser.Create(self);
TOleControl(Browser).Parent := Self;
Browser.Align := alClient;
//ナビゲート完了時の処理
Browser.OnNavigateComplete2 := BrowserNavigateComplete2;
end;
destructor TIETabSheet.Destroy;
begin
//タブシートの破棄と同時にブラウザ破棄
Browser.Free;
inherited;
end;
{ TForm1 }
//新規タブ
procedure TForm1.AddNewPage(URL: String);
var
IETab:TIETabSheet;
begin
IETab := TIETabSheet.Create(PCBrowser);
IETab.Parent := PCBrowser;
IETab.PageControl := PCBrowser;
IETab.Browser.Navigate(URL);
PCBrowser.ActivePage := TTabSheet(IETab);
end;
procedure TForm1.BtnNavigateClick(Sender: TObject);
var i:Integer;
begin
i := PCBrowser.ActivePageIndex;
if i<0 then
AddNewPage(EditURL.Text)
else
NavigatePage(i,EditURL.Text);
end;
//タブのURL変更
procedure TForm1.NavigatePage(Index: Integer; URL: String);
var
IETab:TIETabSheet;
begin
IETab := TIETabSheet(PCBrowser.Pages[Index]);
IETab.Browser.Navigate(URL);
end;
procedure TForm1.BtnNewPageClick(Sender: TObject);
begin
AddNewPage(EditURL.Text);
end;
procedure TForm1.BtnCloseClick(Sender: TObject);
begin
ClosePage(PCBrowser.ActivePageIndex);
end;
//タブ削除
procedure TForm1.ClosePage(Index: Integer);
var
IETab:TIETabSheet;
begin
if Index<0 then exit;
IETab := TIETabSheet(PCBrowser.Pages[Index]);
IETab.Free;
end;
end.
ママンさん、詳細なご指導ありがとうございました。
その後、うまくいっております。もちろん私の投稿のコードはいろいろ付属するコードは省略してあります。しかし、とても汚いです。
このお返事をきれいに書く参考に実用的に改良していこうと思います。
ありがとうございました。
ママンさま、ありがとうございました。
本日、ママンさんのコードでテストしていて、すべて正常に作動しているのですが、ただ一つ、わからない箇所があります。
WebBrowserの右クリックイベントのNewWindow2ですが、
procedure TIETabSheet.BrowserNewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
ppDisp := Browser.Application;
end;
ppDispの前でウィンドウを作成しなくてはならないと思いますが、いろいろ試みているのですがエラーがでます。
その他のブラウザに必要なイベントはうまくいきました。
できれば、教えていただけないでしょうか。m(_ _)m。
ママンさま。質問をした後、ようやくエラーがでなくなりました。
今のところ。
NewWindow2のイベントに下記のように書きました。
begin
IETab := TIETabSheet.Create(Form1.PCBrowser);
IETab.Parent := Form1.PCBrowser;
IETab.PageControl := Form1.PCBrowser;
ppDisp := IETab.Browser.Application;
Form1.PCBrowser.ActivePage := TTabSheet(IETab);
end;
正しいかどうかわかりませんが今後もテストをしてみます。
ありがとうございました。m(_ _)m
| ツイート |  |