Вот тебе пример и на уничтожение tab и на перетягивание:
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ComCtrls, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
PageControl1: TPageControl;
procedure Button2Click(Sender: TObject);
procedure WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure PageControlDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure FormCreate(Sender: TObject);
procedure PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
public
{ Public declarations }
end;
var
Form1: TForm1;
i:integer;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
var t:TTabSheet;
begin
t:=TTabSheet.Create(Form1);
t.PageControl:=PageControl1;
t.DragMode:=dmAutomatic;
t.Tag:=integer(TWebBrowser.Create(Form1));
inc(i);
t.Caption:='Untitled '+inttostr(i);
TOleControl(t.Tag).Parent:=t;
TWebBrowser(t.Tag).align:=alClient;
TWebBrowser(t.Tag).Visible:=true;
TWebBrowser(t.Tag).OnNavigateComplete2:=WebBrowser1NavigateComplete2;
TWebBrowser(t.Tag).OnDocumentComplete:=WebBrowser1DocumentComplete;
TWebBrowser(t.Tag).GoHome;
end;
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Edit1.Text:=URL;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if PageControl1.ActivePage=nil then exit;
TWebBrowser(PageControl1.ActivePage.Tag).free;
PageControl1.ActivePage.Free;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if PageControl1.ActivePage=nil then exit;
TWebBrowser(PageControl1.ActivePage.Tag).GoHome;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if PageControl1.ActivePage=nil then exit;
TWebBrowser(PageControl1.ActivePage.Tag).GoBack;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
if PageControl1.ActivePage=nil then exit;
TWebBrowser(PageControl1.ActivePage.Tag).GoForward;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
if PageControl1.ActivePage=nil then exit;
TWebBrowser(PageControl1.ActivePage.Tag).Refresh;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if PageControl1.ActivePage=nil then exit;
TWebBrowser(PageControl1.ActivePage.Tag).Navigate(Edit1.Text);
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
Edit1.Text:=TWebBrowser(PageControl1.ActivePage.Tag).LocationURL;
end;
procedure TForm1.PageControlDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if (Source is TPageControl) and ((PageControl1.ActivePageIndex<>PageControl1.IndexOfTabAt(x,y))) then
begin
PageControl1.ActivePage.PageIndex:=PageControl1.IndexOfTabAt(x,y);
PageControl1.EndDrag(true);
PageControl1.tag:=0;
end;
PageControl1Change(nil);
end;
procedure TForm1.PageControlDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=(Source is TPageControl);
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Edit1.Text:=URL;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
i:=0;
end;
procedure TForm1.PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if PageControl1.tag=1 then
PageControl1.EndDrag(false);
PageControl1.tag:=0;
end;
procedure TForm1.PageControl1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if PageControl1.tag<>1 then
PageControl1.BeginDrag(true);
PageControl1.tag:=1;
end;
end.
|
Форма:
| Код |
object Form1: TForm1
Left = 248
Top = 139
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Shell Dlg 2'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 688
Height = 79
Align = alTop
TabOrder = 0
object Edit1: TEdit
Left = 8
Top = 8
Width = 281
Height = 21
BevelInner = bvNone
BevelKind = bkSoft
BevelOuter = bvNone
TabOrder = 0
end
object Button1: TButton
Left = 296
Top = 8
Width = 75
Height = 25
Caption = 'Navigate'
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 16
Top = 48
Width = 75
Height = 25
Caption = 'New Page'
TabOrder = 2
OnClick = Button2Click
end
object Button3: TButton
Left = 96
Top = 48
Width = 75
Height = 25
Caption = 'Close Page'
TabOrder = 3
OnClick = Button3Click
end
object Button4: TButton
Left = 176
Top = 48
Width = 75
Height = 25
Caption = 'Home'
TabOrder = 4
OnClick = Button4Click
end
object Button5: TButton
Left = 256
Top = 48
Width = 75
Height = 25
Caption = 'Back'
TabOrder = 5
OnClick = Button5Click
end
object Button6: TButton
Left = 336
Top = 48
Width = 75
Height = 25
Caption = 'Forward'
TabOrder = 6
OnClick = Button6Click
end
object Button7: TButton
Left = 416
Top = 48
Width = 75
Height = 25
Caption = 'Refresh'
TabOrder = 7
OnClick = Button7Click
end
end
object PageControl1: TPageControl
Left = 0
Top = 79
Width = 688
Height = 374
Align = alClient
TabOrder = 1
OnDragDrop = PageControlDragDrop
OnDragOver = PageControlDragOver
OnMouseDown = PageControl1MouseDown
OnMouseUp = PageControl1MouseUp
end
end
|
|
Если в DRKB есть статья на тему, можно выложить здесь ее полный вариант?