| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, SHDocVw, ActiveX, OleServer, OleCtrls;
type
TWebBrowser = class(SHDocVw.TWebBrowser)
protected
procedure InvokeEvent(DispID: TDispID; var Params: TDispParams); override;
end;
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://google.com');
end;
{ TWebBrowser }
procedure TWebBrowser.InvokeEvent(DispID: TDispID;
var Params: TDispParams);
var
URL: WideString;
ParamCount, I: Integer;
VarArray: TVariantArray;
begin
inherited;
{ void NewWindow3(IDispatch **&ppDisp, VARIANT_BOOL *&Cancel,
DWORD dwFlags, BSTR bstrUrlContext, BSTR bstrUrl); }
if DispID = $111 then
begin
ParamCount := Params.cArgs;
SetLength(VarArray, ParamCount);
for I := Low(VarArray) to High(VarArray) do
VarArray[High(VarArray) - I] := OleVariant(Params.rgvarg^[I]);
{ bstrUrl }
URL := VarArray[4];
if URL <> '' then
begin
{ Cancel }
WordBool((TVarData(VarArray[1]).VPointer)^) := True;
Navigate(URL);
end;
end;
end;
end.
|
|
