タブブラウザのタブを素早く削除する方法は

解決


横山  2012-06-03 17:09:07  No: 42413  IP: 192.*.*.*

皆様よろしくお願いします。
環境はWindows7  Delphi6personalです。
過去ログの「PageControlのページを削除するとエラーがでる」の
ママんさんのブラウザのサンプルを元にタブブラウザを作成しています。
タブに多数のサイトを一気に表示するのはうまくいくのですが
完了を待ち一気に削除するのが、とても時間が掛かります。
IE9でもグループで開きグループを閉じる処理に比べ遅いです。
同等ほどとは行かないでしょうが、
知りたいこと:素早くタブを閉じる方法があれば教えてくださいませんか。
下記にテストコードを書きましたが、その部分を簡素にしたものです。
フォームにパネルとボタンを貼り付けてあるだけです。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw_EWB, ExtCtrls, ComCtrls, StdCtrls, SHDocVw_TLB;
type
  TTabSheetEx = class(TTabSheet)
  private
    procedure WebBrowser1TitleChange(Sender: TObject; const Text: WideString);
    procedure WebBrowser1StatusTextChange(Sender: TObject; const Text: WideString);
  public
    WebBrowser1 : TWebBrowser;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    PageControl1: TPageControl;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure TabSheetCreate(style:string);
  public
  end;
var
  Form1: TForm1;
implementation
uses Math;
{$R *.dfm}
//--------------タブ作成クラス-------------------------------------------
{ TTabSheetEx }
constructor TTabSheetEx.Create(AOwner: TComponent);
begin
  inherited;
  WebBrowser1 := TWebBrowser.Create(self);
  TOleControl(WebBrowser1).Parent := Self;
  WebBrowser1.Align               := alClient;
  WebBrowser1.Silent:=true;
  WebBrowser1.OnTitleChange         := WebBrowser1TitleChange;
  WebBrowser1.OnStatusTextChange    := WebBrowser1StatusTextChange;
end;

destructor TTabSheetEx.Destroy;
begin
  WebBrowser1.Free;
  inherited;
end;

procedure TTabSheetEx.WebBrowser1TitleChange(Sender: TObject; const Text: WideString);//タブのキャプション決定
begin
    Caption:=StringReplace(Text, '&', '&&', [rfReplaceAll]);
end;

procedure TTabSheetEx.WebBrowser1StatusTextChange(Sender: TObject;const Text: WideString);
begin
    Form1.Caption:=Text;
end;
//---------------------------------------------------------
{ TForm1 }
procedure TForm1.TabSheetCreate(style:string);//新規タブ作成
var
  TabSheetEx:TTabSheetEx;
begin
  Form1.PageControl1.TabWidth:=50;
  TabSheetEx :=  TTabSheetEx.Create(PageControl1);
  TabSheetEx.Parent       := PageControl1;
  TabSheetEx.PageControl  := PageControl1;
  TabSheetEx.Caption:='■';
  TabSheetEx.WebBrowser1.Navigate(style);
  PageControl1.ActivePage := TTabSheet(TabSheetEx);
end;

procedure TForm1.Button1Click(Sender: TObject);//オープン
begin
TabSheetCreate('ttp://121ware.com/qasearch/1007/app/servlet/relatedqa?QID=011860');
TabSheetCreate('ttp://freesoft.tvbok.com/tips/core_i7_p6t/windows7_desktop.html');
TabSheetCreate('ttp://pc.nikkeibp.co.jp/article/knowhow/20100831/1027218/?set=ml');
TabSheetCreate('ttp://pc.nikkeibp.co.jp/article/knowhow/20101021/1028064/?P=2&set=ml_a');
TabSheetCreate('ttp://stakasaki.at.webry.info/200703/article_5.html');
TabSheetCreate('ttp://support.microsoft.com/kb/910336/ja');
TabSheetCreate('ttp://pc.nikkeibp.co.jp/article/knowhow/20101021/1028064/?P=2&set=ml_a');
TabSheetCreate('ttp://vanilla.xrea.jp/vista/category5/entry41.html');
TabSheetCreate('ttp://windows.microsoft.com/ja-JP/internet-explorer/help/ie-9/how-do-i-install-or-uninstall-internet-explorer-9');
TabSheetCreate('ttp://windows.microsoft.com/ja-JP/windows7/customize-desktop-gadgets');
TabSheetCreate('ttp://www.atmarkit.co.jp/fwin2k/win2ktips/408expopt/expopt.html');
TabSheetCreate('ttp://www.nikkeibp.co.jp/article/news/20100803/239987/');
TabSheetCreate('ttp://www.sakyou.com/ManualShop/Windows/05_UserAccount/08_UAC-OFF/17_Win7Pro/index.html');
TabSheetCreate('ttp://www.yomiuri.co.jp/net/qanda/20100423-OYT8T01107.htm');
TabSheetCreate('ttp://www15.atwiki.jp/win7/pages/15.html#id_b3d51310');
TabSheetCreate('ttp://yakushima-tonbo.com/windows/Windows7/Windows7_qa_01.htm');
TabSheetCreate('ttp://yakushima-tonbo.com/windows/Windows7_tips_files/index.htm');
end;

procedure TForm1.Button2Click(Sender: TObject);//タブ削除
var i:integer;
    TabSheetEx:TTabSheetEx;
begin
    for i:=PageControl1.PageCount-1 Downto 0 do
    begin
        TabSheetEx:= TTabSheetEx(Form1.PageControl1.Pages[i]);
        TabSheetEx.Free;
    end;
end;

end.

編集 削除
横山  2012-06-06 13:21:40  No: 42414  IP: 192.*.*.*

解決とさせていただきます。

編集 削除
monaa  2012-06-06 14:09:01  No: 42415  IP: 192.*.*.*

これ、結構難しいと思います。
そもそもWebBrowserコントロールが非同期処理が組み込まれたリッチコントロールなので
簡単にスレッド化するわけにも行きません。
私が思いつく方法としては、とりあえず非表示にだけして、一気に解放処理しないでコントロールを1つずつ間隔をおいて実行するのはどうでしょうか?
といってもその処理を実装するだけでも結構手間が掛かりそうだし、
できたからといって本当に早く動いているように見える保証はありません。
ちょっと試してみたいところですが、暇が無いっす。

編集 削除
横山  2012-06-08 22:28:09  No: 42416  IP: 192.*.*.*

monaaさん、ありがとうございます。
もうあきらめていたら、レスがついていてびっくりしました。
そうです、とても難しいです。
私もいろいろやりました。
これからも挑戦していきます。
では失礼します。

編集 削除
takana  2012-06-09 09:00:17  No: 42417  IP: 192.*.*.*

すべてのタブのWebBrowserを空白ページにしてから閉じてはどうでしょうか?

WebBrowser1.Navigate('about:blank');

もし最初からすべてのページが空白ページでも、閉じるのが遅いのでしょうか?

編集 削除
横山  2012-06-11 17:43:02  No: 42418  IP: 192.*.*.*

takana さんすみません返事が遅くなって。
趣旨から言って代入をやめて直接'about:blank'で空にしたら
破棄するようにしました。
結果、そうとう早く削除できるようになりました。
なにか弊害がでるかしばらく監視します。
ありがとうございました。
for i:=PageControl1.PageCount-1 Downto 0 do
begin
 ///TabSheetEx:= TTabSheetEx(Form1.PageControl1.Pages[i]);
 TTabSheetEx(Form1.PageControl1.Pages[i])
    .WebBrowser1.Navigate'about:blank');
 TTabSheetEx(Form1.PageControl1.Pages[i]).Free;
end;

編集 削除