delphi仿IE浏览器标签页效果演示

最新推荐文章于 2022-06-28 16:31:23 发布

simonhehe

最新推荐文章于 2022-06-28 16:31:23 发布

阅读量4.4k

点赞数 2

分类专栏： web Delphi 文章标签： delphi Delphi DELPHI IE多标签 webbrowser webBrowser WebBrowser

本文链接：https://blog.csdn.net/simonhehe/article/details/8483582

版权

Delphi 同时被 2 个专栏收录

58 篇文章 2 订阅

订阅专栏

web

3 篇文章 0 订阅

订阅专栏

看到有同学提问, 自己试炼了一把, 只为实现标签页效果, 未作细化和完善工作.

路过的同学多多指教

--------------------------------------------------------------

a.html

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>无标题文档</title>
</head>

<body>
<label>btn
<input id="aa" type="button" οnclick="location='http://www.google.com'" name="Submit" value="提交" />
</label>
<a id="bb" href="http://www.baidu.com">ahref</a>
<br />
<label>btn
<input id="aa" type="button" οnclick="" name="Submit" value="提交" />
</label>
<a href="http://so.com" target="_blank">so</a>
</body>
</html>

单元文件

unit Unit11;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, ComCtrls;


type
  TForm11 = class(TForm)
    pgc1: TPageControl;
    procedure FormCreate(Sender: TObject);
    procedure pgc1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    function NewWindow(const URL : string = ''): TWebBrowser;
    procedure MyBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
      var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
      var Cancel: WordBool);
    procedure MyNewWindow2(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure closePage(aTab: TTabSheet);
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form11: TForm11;


implementation


{$R *.dfm}
function TForm11.NewWindow(const URL : string = '') : TWebBrowser;
var
  aTab : TTabSheet;
begin
  aTab := TTabSheet.Create(pgc1);
  aTab.PageControl := pgc1;
  aTab.Caption := 'tab' + IntToStr(pgc1.PageCount);
  pgc1.ActivePage := aTab;
  aTab.Align := alClient;


  result := TWebBrowser.Create(self);
  aTab.InsertControl(result);
  result.Align := alClient;
  result.OnBeforeNavigate2 := MyBeforeNavigate2;
  result.OnNewWindow2 := MyNewWindow2;
  if URL <> '' then
    result.Navigate(url);
end;


procedure TForm11.closePage(aTab : TTabSheet);
var
  i : integer;
begin
  if aTab = nil then Exit;


  for I := aTab.ComponentCount - 1 downto 0 do
  begin
    if aTab.Components[i] is TWebBrowser then
      TWebBrowser(aTab.Components[i]).Stop;
    aTab.Components[i].Free;
  end;


  aTab.Free;
end;


procedure TForm11.pgc1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
Index: Integer;
begin
  //左键点击并且双击
  if (Button = mbLeft) and (ssDouble in Shift) then
  begin
    Index := pgc1.IndexOfTabAt(X, Y);
    if Index >= 0 then
      closePage(pgc1.Pages[Index]);


  end;


end;


procedure TForm11.MyNewWindow2(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
begin
  //新链接事件处理
  ppDisp := NewWindow().DefaultInterface;
end;


procedure TForm11.FormCreate(Sender: TObject);
begin
//  NewWindow('http://news.baidu.com');
  NewWindow(ExtractFilePath(Application.ExeName)+'a.html');
end;


procedure TForm11.MyBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
  var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
  var Cancel: WordBool);
begin
  //Todo 事务处理
end;


end.

界面文件

object Form11: TForm11
  Left = 0
  Top = 0
  Caption = 'Form11'
  ClientHeight = 461
  ClientWidth = 769
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object pgc1: TPageControl
    Left = 0
    Top = 0
    Width = 769
    Height = 461
    Align = alClient
    TabOrder = 0
    ExplicitTop = 56
    ExplicitHeight = 405
  end
end

simonhehe

关注

2
点赞
踩
4

收藏

觉得还不错? 一键收藏
0
评论
delphi仿IE浏览器标签页效果演示

看到有同学提问, 自己试炼了一把, 只为实现标签页效果, 未作细化和完善工作.路过的同学多多指教 --------------------------------------------------------------a.html无标题文档btnahrefbtnso单元文件unit Unit11;
复制链接

扫一扫