unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, activexcontainer, Forms, Controls, Graphics,
Dialogs, StdCtrls, ExtCtrls, SHDocVw_1_1_TLB;
type
{ TForm1 }
TForm1 = class(TForm)
ActiveXContainer1: TActiveXContainer;
btnTest: TButton;
btnNavigate: TButton;
btnPrint: TButton;
btnBack: TButton;
btnForward: TButton;
brnRefresh: TButton;
btnStop: TButton;
edtUrl: TEdit;
lblStatus: TLabel;
pnlFunctions: TPanel;
pnlStatus: TPanel;
procedure brnRefreshClick(Sender: TObject);
procedure btnBackClick(Sender: TObject);
procedure btnNavigateClick(Sender: TObject);
procedure btnForwardClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure btnTestClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure OnStatusTextChange(Sender: TObject; Text_: WideString);
public
{ public declarations }
end;
var
Form1: TForm1;
Browser: TEvsWebBrowser;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.btnTestClick(Sender: TObject);
var ovMIMEType, ovDocument: Olevariant;
begin
ovDocument := Browser.ComServer.Document;
ovMIMEType := 'text/html';
ovDocument.Open(ovMIMEType);
ovDocument.Write('<html><body><p>Hello World!</p></body></html>');
ovDocument.Close();
end;
procedure TForm1.btnNavigateClick(Sender: TObject);
var ovNull, ovUrl: OleVariant;
begin
ovUrl := Utf8decode(edtUrl.Text);
ovNull := NULL;
Browser.ComServer.Navigate2(ovUrl, ovNull, ovNull, ovNull, ovNull);
end;
procedure TForm1.btnForwardClick(Sender: TObject);
begin
Browser.ComServer.GoForward;
end;
procedure TForm1.btnBackClick(Sender: TObject);
begin
Browser.ComServer.GoBack;
end;
procedure TForm1.brnRefreshClick(Sender: TObject);
begin
Browser.ComServer.Refresh;
end;
procedure TForm1.btnPrintClick(Sender: TObject);
var ovIn, ovOut: OleVariant;
begin
if (Browser.ComServer.QueryStatusWB(OLECMDID_PRINT) and OLECMDF_ENABLED) = 2 then
Browser.ComServer.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, ovIn, ovOut);
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
Browser.ComServer.Stop;
end;
procedure TForm1.FormCreate(Sender: TObject);
var ovUrl, ovNull: Olevariant;
begin
Browser := TEvsWebBrowser.Create(Self);
ActiveXContainer1.ComServer := Browser.ComServer;
ActiveXContainer1.Active := true;
Browser.OnStatusTextChange := @OnStatusTextChange;
ovUrl := Utf8decode('about:blank');
ovNull := NULL;
Browser.ComServer.Navigate2(ovUrl, ovNull, ovNull, ovNull, ovNull);
Browser.ComServer.Silent := true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Browser.Free;
end;
procedure TForm1.OnStatusTextChange(Sender: TObject; Text_: WideString);
begin
lblStatus.Caption:='Browser: '+UTF8Encode(Text_);
end;
end.