<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">Код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ruby'>unit frmMain;
interface
uses
Classes, Controls, Forms, OleCtrls, EmbeddedWB, ComCtrls, StdCtrls,
IEAddress, ExtCtrls, SysUtils;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
Panel1: TPanel;
Button1: TButton;
IEAddress1: TIEAddress;
cbNewTab: TCheckBox;
StatusBar1: TStatusBar;
procedure PageControl1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
procedure DownloadCompleteEvent(Sender: TObject);
function GetActiveEWB: TEmbeddedWB;
procedure UpdateAddress;
procedure UpdateTab;
function CreateNewTabBrowser(Url: string): TTabSheet;
procedure NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
procedure NewWebStatusTextChange(Sender: TObject;
const Text: WideString);
public
{ Public declarations }
end;
var
Form1: TForm1;
DesignTimeWB: TEmbeddedWB;
NewTab: TTabSheet;
i: integer;
implementation
{$R *.dfm}
//--------Private Section---------------------------------------------
procedure TForm1.UpdateTab;
begin
PageControl1.ActivePage := NewTab;
UpdateAddress;
end;
function TForm1.GetActiveEWB: TEmbeddedWB;
var
i: Integer;
begin
Result := nil;
if PageControl1.ActivePage <> nil then
for i := 0 to PageControl1.ActivePage.ControlCount - 1 do
begin
if PageControl1.ActivePage.Controls is TEmbeddedWB then
begin
Result := TEmbeddedWB(PageControl1.ActivePage.Controls);
Exit;
end;
end;
end;
procedure TForm1.UpdateAddress;
var
WB: TEmbeddedWB;
begin
WB := GetActiveEWB;
if Assigned(WB) then
begin
IEAddress1.EmbeddedWB := WB;
IEAddress1.Text := WB.LocationURL;
PageControl1.ActivePage.Caption := WB.LocationName;
end;
end;
procedure TForm1.DownloadCompleteEvent(Sender: TObject);
begin
UpdateAddress;
end;
function TForm1.CreateNewTabBrowser(Url: string): TTabSheet;
begin
NewTab := TTabSheet.Create(PageControl1);
with NewTab do
begin
PageControl := PageControl1;
Parent := PageControl1;
PageIndex := PageControl1.ActivePageIndex;
end;
DesignTimeWB := TEmbeddedWB.Create(NewTab);
TControl(DesignTimeWB).Parent := NewTab;
with DesignTimeWB do
begin
EnableMessageHandler := True;
LoadSettings;
Align := alClient;
OnStatusTextChange := NewWebStatusTextChange;
OnNewWindow2 := NewWindowEvent;
OnDownloadComplete := DownloadCompleteEvent;
if Trim(URL) <> '' then
DesignTimeWB.NavigateWait(URL);
end;
PageControl1.ActivePage := NewTab;
Result := NewTab;
end;
procedure TForm1.NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
CreateNewTabBrowser(DesignTimeWB.LocationURL);
PageControl1.ActivePage := NewTab;
ppdisp := DesignTimeWB.Application;
UpdateTab;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
UpdateAddress;
end;
procedure TForm1.NewWebStatusTextChange(Sender: TObject;
const Text: WideString);
begin
StatusBar1.SimpleText := Text;
end;
//--------End Of Private Section---------------------------------------------
procedure TForm1.FormShow(Sender: TObject);
begin
CreateNewTabBrowser(DesignTimeWB.GetIEHomePage);
UpdateTab;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if cbNewtab.Checked then
begin
CreateNewTabBrowser(IEAddress1.Text);
UpdateTab;
end
else
begin
DesignTimeWB.Go(IEAddress1.Text);
UpdateTab;
end;
end;
end.[/CODE]
Простите прсто вчера деньги кончились на счету,сёдне только положил
<table valign="top" style='margin:0;width:100%;border:1px dashed red;'>[tr]<td align='middle' bgcolor='#ff6060' valign='top' width='1%'>
<FONT color='#ffffff' size='+3'> ! </font>
</td><td align="midle" valign='top' style='background:#fff;'>Спойлер - хорошо, но используйте тег оформления кода, так смотреть удобней.</td>[/tr]</table>