TEdgeBrowser(WebView2)でタブブラウザを作る ～Delphiソースコード集

TEdgeBrowser(WebView2)でタブブラウザを作る

Delphi 12.1(Community Edition)でTEdgeBrowserを使ってタブブラウザを作成します。
タブブラウザを作るには「新しいウィンドウで開く」イベントを取得して、そのURLを別タブのブラウザで表示します。

（１）はじめに

Windows10の場合はMicrosoft WebView2 ランタイムのインストールを以下のURLを参照してインストールしてください。
https://mam-mam.net/delphi/tedgebrowser.html

「WebView2Loader.dll」は
https://mam-mam.net/delphi/tedgebrowser.html を参照してください。

（２）プロジェクトの作成とフォームの設計

Delphi IDEを起動し、「ファイル」⇒「Windows VCLアプリケーション -Delphi」をクリックします
フォームに TPanel × １個をドラッグ＆ドロップで配置し、その上（Panel1の中）に TButton １個をドラッグ＆ドロップで配置します。
TPageControl × 1個 をドラッグ＆ドロップで配置します。

（３）ソースコードの記述

IDEを「コード」に切り替えて、以下ソースコードをコピー＆ペーストします。

IDEを「デザイン」に切り替えてオブジェクトインスペクタのイベントプロパティに、
Form1.OnCreate に FormCreate を設定
Button1.OnClick に Button1Click を設定します。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls,
  Winapi.WebView2, Winapi.ActiveX, Vcl.Edge, Vcl.StdCtrls{, Vcl.StdCtrls};

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    CacheDir:String;
    procedure CreateNewTab(url:string='');
    procedure UrlKeyPress(Sender: TObject; var Key: Char);
    procedure BackButton(Sender: TObject);
    procedure ForwardButton(Sender: TObject);
    procedure RefreshButton(Sender: TObject);
    procedure NavigationStarting(Sender: TCustomEdgeBrowser;
        Args: TNavigationStartingEventArgs);
    procedure NewWindowRequested(Sender: TCustomEdgeBrowser;
        Args: TNewWindowRequestedEventArgs);
    procedure DocumentTitleChanged(Sender: TCustomEdgeBrowser;
        const ADocumentTitle: string);
    procedure PageControlMouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure DeleteTag(idx:Integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;
const
  UserAgent:String=
    'Mozilla/5.0 (Windows NT 10.0; Win64; x64) '+
    'AppleWebKit/537.36 (KHTML, like Gecko) Chrome/134.0.6998.36 Safari/537.36';

implementation

{$R *.dfm}

uses System.IOUtils;

{ TForm1 }

procedure TForm1.BackButton(Sender: TObject);
var w:TEdgeBrowser;
begin
  w:=TEdgeBrowser(TTabSheet(TButton(Sender).parent.parent).Controls[2]);
  if w.CanGoBack then w.GoBack;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateNewTab();
end;

procedure TForm1.CreateNewTab(url:string='');
var ts:TTabSheet;
    p:TPanel;
    e:TEdit;
    b:TButton;
    w:TEdgeBrowser;
begin
  ts:=TTabSheet.Create(self);
  ts.PageControl:=PageControl1;
  PageControl1.TabIndex:=PageControl1.PageCount-1;

  p:=TPanel.Create(self);
  p.Parent:=ts;
  p.Align:=alTop;
  p.Height:=50;
  e:=TEdit.Create(self);
  e.Parent:=p;
  e.OnKeyPress:=UrlKeyPress;
  e.Align:=alTop;
  if url<>'' then e.Text:=url;

  p:=TPanel.Create(self);
  p.Parent:=ts;
  p.Height:=50;
  p.Top:=51;
  p.Align:=alTop;

  b:=TButton.Create(self);
  b.Parent:=p;
  b.Caption:='←';
  b.Width:=40;
  b.Align:=alLeft;
  b.OnClick:=BackButton;

  b:=TButton.Create(self);
  b.Parent:=p;
  b.Caption:='→';
  b.Width:=40;
  b.Left:=41;
  b.Align:=alLeft;
  b.OnClick:=ForwardButton;

  b:=TButton.Create(self);
  b.Parent:=p;
  b.Caption:='Refresh';
  b.Width:=100;
  b.Left:=81;
  b.Align:=alLeft;
  b.OnClick:=RefreshButton;

  w:=TEdgeBrowser.Create(self);
  w.Align:=alCLient;
  w.Parent:=ts;
  w.UserDataFolder:=CacheDir;
  w.OnDocumentTitleChanged:=DocumentTitleChanged;

  //WebViewが(非同期で)作成されるまで待つ
  if not w.WebViewCreated then
  begin
    w.CreateWebView;
    while not w.WebViewCreated do
    begin
      Application.ProcessMessages;
      Sleep(100);
    end;
  end;
  ICoreWebView2Settings2(w.SettingsInterface).Set_UserAgent(
    PWideChar(@UserAgent[1])
  );
  w.OnNavigationStarting:=NavigationStarting;
  w.OnNewWindowRequested:=NewWindowRequested;
  if url='' then
    w.Navigate('https://www.google.co.jp')
  else
    w.Navigate(url);
end;

procedure TForm1.DeleteTag(idx: Integer);
var tb:TTabSheet;
begin
  tb:=PageControl1.Pages[idx];
  tb.controls[2].Free;
  TPanel(tb.controls[1]).controls[2].Free;
  TPanel(tb.controls[1]).controls[1].Free;
  TPanel(tb.controls[1]).controls[0].Free;
  tb.controls[1].Free;
  TPanel(tb.controls[0]).controls[0].Free;
  tb.controls[0].Free;
  tb.Free;
end;

procedure TForm1.DocumentTitleChanged(Sender: TCustomEdgeBrowser;
  const ADocumentTitle: string);
begin
  TTabSheet(TEdgeBrowser(Sender).Parent).Caption:=
    Chr(9746)+ADocumentTitle.Substring(0,10);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //ブラウザキャッシュのディレクトリ
  CacheDir:=ExtractFilePath(Application.ExeName)+'cache';
  //必要であればブラウザキャッシュを削除
  if DirectoryExists(CacheDir) then
    TDirectory.Delete(CacheDir, True);
  PageControl1.OnMouseDown:=PageControlMouseDown;
  Button1.Align:=alLeft;
  Button1.Font.Height:=-20;
  Button1.Width:=128;
  Panel1.Caption:='';
  Panel1.Height:=64;
  Panel1.Align:=alTop;
  Button1.Caption:='タブを追加';
  PageControl1.Align:=alClient;
  CreateNewTab();
  self.Font.Size:=12;
end;

procedure TForm1.ForwardButton(Sender: TObject);
var w:TEdgeBrowser;
begin
  w:=TEdgeBrowser(TTabSheet(TButton(Sender).parent.parent).Controls[2]);
  if w.CanGoForward then w.GoForward;
end;

procedure TForm1.NavigationStarting(Sender: TCustomEdgeBrowser;
  Args: TNavigationStartingEventArgs);
var puri:PChar;
    uri:String;
begin
  Args.ArgsInterface.Get_uri(puri);
  uri:=puri;
  TEdit(TPanel(TTabSheet(TEdgeBrowser(Sender).Parent).Controls[0]).Controls[0]).Text
    :=uri;
  uri:=StringReplace(uri,'http://','',[]);
  uri:=StringReplace(uri,'https://','',[]);
  TTabSheet(TEdgeBrowser(Sender).Parent).Caption:=Chr(9746)+uri.substring(0,10);
end;

procedure TForm1.NewWindowRequested(Sender: TCustomEdgeBrowser;
  Args: TNewWindowRequestedEventArgs);
var puri:PChar;
begin
  Args.ArgsInterface.Set_Handled(-1);
  Args.ArgsInterface.Get_uri(puri);
  TThread.CreateAnonymousThread(
  procedure
  begin
    TThread.Synchronize(nil,
    procedure
    begin
      CreateNewTab(puri);
    end);
  end).Start;
end;

procedure TForm1.PageControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  TabIndex: Integer;
  TabCaption: string;
  ClickedCharIndex: Integer;
  TextWidth, TextStart, i: Integer;
  TabRect: TRect;
begin
  // クリック位置からタブのインデックスを取得
  TabIndex := PageControl1.IndexOfTabAt(X, Y);
  if TabIndex <> -1 then
  begin
    TabCaption := PageControl1.Pages[TabIndex].Caption;
    // タブの矩形を取得
    TabRect := PageControl1.TabRect(TabIndex);
    // テキストの幅と開始位置を計算（中央揃えの場合）
    TextWidth := PageControl1.Canvas.TextWidth(TabCaption);
    TextStart := TabRect.Left + (TabRect.Width - TextWidth) div 2;
    // クリック位置から文字インデックスを計算
    ClickedCharIndex := -1;
    for i := 1 to Length(TabCaption) do
    begin
      if X <= TextStart + PageControl1.Canvas.TextWidth(Copy(TabCaption, 1, i)) then
      begin
        ClickedCharIndex := i;
        Break;
      end;
    end;
    if ClickedCharIndex <> -1 then
    begin
      if TabCaption[ClickedCharIndex]=Chr(9746) then
        DeleteTag(TabIndex);
    end;
  end;
end;

procedure TForm1.RefreshButton(Sender: TObject);
var w:TEdgeBrowser;
begin
  w:=TEdgeBrowser(TTabSheet(TButton(Sender).parent.parent).Controls[2]);
  w.Refresh;
end;

procedure TForm1.UrlKeyPress(Sender: TObject; var Key: Char);
var w:TEdgeBrowser;
begin
  if Key=#13 then
  begin
    w:=TEdgeBrowser(TTabSheet(TEdit(Sender).parent.parent).Controls[2]);
    w.Navigate(TEdit(Sender).Text);
  end;
end;

end.

（４）「WebView2Loader.dll」ファイルを実行ファイルと同じフォルダ内にコピーする

「ファイル」⇒「すべて保存」でプロジェクトフォルダを作成して、ユニットとプロジェクトファイルを保存します。

「C:\Program Files (x86)\Embarcadero\Studio\23.0\Redist\win32\WebView2Loader.dll」
「C:\Program Files (x86)\Embarcadero\Studio\23.0\Redist\win64\WebView2Loader.dll」
ファイルを、実行ファイルと同じフォルダ内（プロジェクト保存フォルダ\Win32\Debug）にコピーします

（５）実行する

IDEから「実行」⇒「実行」をクリックしてコンパイル＆実行します。
「タブを追加」ボタンをクリックするとタブが増えます。
☒ を押すとタブが削除されます。
<a href="***" target="_blank">をクリックした場合は新しいタブが生成されて表示されます。
リンクを右クリックして「リンクを新しいウィンドウで開く」を押した場合も新しいタブが生成されて表示されます。