112 lines
2.6 KiB
ObjectPascal
112 lines
2.6 KiB
ObjectPascal
unit wbmain;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, SHDocVw, activexcontainer, Forms, Controls,
|
|
Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons, LCLType;
|
|
|
|
type
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
Edit1: TEdit;
|
|
Label1: TLabel;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
SpeedButton1: TSpeedButton;
|
|
SpeedButton2: TSpeedButton;
|
|
WebBrowser1: TWebBrowser;
|
|
procedure Button1Click(Sender: TObject);
|
|
procedure Button2Click(Sender: TObject);
|
|
procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure SpeedButton2Click(Sender: TObject);
|
|
procedure WebBrowser1NavigateError(Sender: TObject; pDisp: IDispatch;
|
|
var URL: OleVariant; var Frame: OleVariant; var StatusCode: OleVariant;
|
|
var Cancel: WordBool);
|
|
procedure WebBrowser1NewProcess(Sender: TObject; lCauseFlag: Integer;
|
|
pWB2: IDispatch; var Cancel: WordBool);
|
|
procedure WebBrowser1ProgressChange(Sender: TObject; Progress: Integer;
|
|
ProgressMax: Integer);
|
|
procedure WebBrowser1Resize(Sender: TObject);
|
|
procedure WebBrowser1StatusTextChange(Sender: TObject; Text_: WideString);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
{ TForm1 }
|
|
|
|
procedure TForm1.WebBrowser1NavigateError(Sender: TObject; pDisp: IDispatch;
|
|
var URL: OleVariant; var Frame: OleVariant; var StatusCode: OleVariant;
|
|
var Cancel: WordBool);
|
|
begin
|
|
StatusCode:=0;
|
|
end;
|
|
|
|
procedure TForm1.WebBrowser1NewProcess(Sender: TObject; lCauseFlag: Integer;
|
|
pWB2: IDispatch; var Cancel: WordBool);
|
|
begin
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress: Integer;
|
|
ProgressMax: Integer);
|
|
begin
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TForm1.WebBrowser1Resize(Sender: TObject);
|
|
begin
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject; Text_: WideString
|
|
);
|
|
begin
|
|
Label1.Caption:=UTF8Encode(Text_);
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TForm1.Button2Click(Sender: TObject);
|
|
begin
|
|
ShowMessage(WebBrowser1.LocationURL);
|
|
end;
|
|
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
begin
|
|
WebBrowser1.Navigate(Edit1.Text);
|
|
end;
|
|
|
|
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
|
|
);
|
|
begin
|
|
if Key=vk_return then Button1Click(self);
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
Button1Click(self);
|
|
end;
|
|
|
|
|
|
procedure TForm1.SpeedButton2Click(Sender: TObject);
|
|
begin
|
|
WebBrowser1.Refresh;
|
|
end;
|
|
|
|
end.
|
|
|