Hi.
Here is a simple test program, I once made.
I have had it running for over an hour, and everything seems to work, except
the tab-key tabs inside an edit box instead of changing focus.
This project is compiled with Delphi 3, patch #2 (3.02).
IE version 4.01.
If it does'nt work under Delphi 4 (I only have 3.02), I think you should
investigating changes to OLE/ActiveX units from 3.02 -> 4.x.
Regards
Stig Johansen.
--------------- Unit ------------------------------
unit NyWebU;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ToolWin, OleCtrls, SHDocVw_TLB;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
Edit1: TEdit;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
OpenDialog1: TOpenDialog;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
procedure ToolButton1Click(Sender: TObject);
procedure WebBrowser1NavigateComplete2(Sender: TObject;
pDisp: IDispatch; var URL: OleVariant);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure WebBrowser1CommandStateChange(Sender: TObject;
Command: Integer; Enable: WordBool);
procedure WebBrowser1NavigateComplete(Sender: TObject;
const URL: WideString);
procedure WebBrowser1DocumentComplete(Sender: TObject;
pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowser1MenuBar(Sender: TObject; MenuBar: WordBool);
procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
procedure WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
procedure WebBrowser1PropertyChange(Sender: TObject;
const szProperty: WideString);
procedure WebBrowser1StatusBar(Sender: TObject; StatusBar: WordBool);
procedure WebBrowser1StatusTextChange(Sender: TObject;
const Text: WideString);
procedure WebBrowser1TheaterMode(Sender: TObject;
TheaterMode: WordBool);
procedure WebBrowser1TitleChange(Sender: TObject;
const Text: WideString);
procedure WebBrowser1ToolBar(Sender: TObject; ToolBar: WordBool);
procedure WebBrowser1Visible(Sender: TObject; Visible: WordBool);
procedure WebBrowser1FullScreen(Sender: TObject; FullScreen: WordBool);
procedure WebBrowser1Enter(Sender: TObject);
procedure WebBrowser1Exit(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
USES
ShClipU,
ActiveX ;
{$R *.DFM}
procedure TForm1.ToolButton1Click(Sender: TObject);
VAR
url : WideString ;
Flags,
TargetFrameName,
PostData,
Headers: OleVariant;
begin
Flags := Null ;
TargetFrameName := Null ;
PostData := Null ;
Headers := Null ;
url := Edit1.Text ;
// WebBrowser1.Navigate2(url,Flags,TargetFrameName,PostData,Headers);
WebBrowser1.Navigate(Url,Flags,TargetFrameName,PostData,Headers);
end;
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
pDisp: IDispatch; var URL: OleVariant);
begin
Caption := URL ;
WebBrowser1.Silent := FALSE ;
end;
procedure TForm1.ToolButton3Click(Sender: TObject);
VAR
Doc : IDispatch ;
OleCommandTarget : IOleCommandTarget ;
vaIn: OleVariant;
vaOut: OleVariant ;
begin
vaIn:= NULL ;
vaOut:= NULL ;
Doc := WebBrowser1.Document ;
IF Doc.QueryInterface(IOleCommandTarget,OleCommandTarget) = 0 THEN
OleCommandTarget.Exec(NIL,OLECMDID_PRINT,
OLECMDEXECOPT_DONTPROMPTUSER,NULL,vaOut);
end;
procedure TForm1.ToolButton4Click(Sender: TObject);
VAR
url : WideString ;
Flags,
TargetFrameName,
PostData,
Headers: OleVariant;
begin
IF OpenDialog1.Execute THEN BEGIN
Flags := Null ;
TargetFrameName := Null ;
PostData := Null ;
Headers := Null ;
url := OpenDialog1.Filename ;
WebBrowser1.Navigate(Url,Flags,TargetFrameName,PostData,Headers);
//
WebBrowser1.Navigate(OpenDialog1.Filename,Flags,TargetFrameName,PostData,Hea
ders);
END ;
end;
procedure TForm1.ToolButton5Click(Sender: TObject);
VAR
Doc : IDispatch ;
OleCommandTarget : IOleCommandTarget ;
vaIn: OleVariant;
vaOut: OleVariant ;
begin
vaIn:= NULL ;
vaOut:= NULL ;
Doc := WebBrowser1.Document ;
IF Doc.QueryInterface(IOleCommandTarget,OleCommandTarget) = 0 THEN BEGIN
ShowMessage(IntToStr(OleCommandTarget.Exec(NIL,OLECMDID_SELECTALL,
OLECMDEXECOPT_DONTPROMPTUSER,vaIn,vaOut)));
ShowMessage(IntToStr(OleCommandTarget.Exec(NIL,OLECMDID_COPY,
OLECMDEXECOPT_PROMPTUSER,vaIn,vaOut)));
END ;
end;
procedure TForm1.ToolButton6Click(Sender: TObject);
VAR
Doc : IDispatch ;
OleCommandTarget : IOleCommandTarget ;
vaIn: OleVariant;
vaOut: OleVariant ;
begin
vaIn:= NULL ;
vaOut:= NULL ;
Doc := WebBrowser1.Document ;
IF Doc.QueryInterface(IOleCommandTarget,OleCommandTarget) = 0 THEN BEGIN
ShowMessage(IntToStr(OleCommandTarget.Exec(NIL,OLECMDID_PASTE,
OLECMDEXECOPT_PROMPTUSER,vaIn,vaOut)));
END ;
end;
procedure TForm1.ToolButton7Click(Sender: TObject);
VAR
Doc : IDispatch ;
OleCommandTarget : IOleCommandTarget ;
vaIn: OleVariant;
vaOut: OleVariant ;
ShowClip : TShowClip ;
begin
Application.CreateForm(TShowClip, ShowClip);
ShowClip.Show ;
vaIn:= NULL ;
vaOut:= NULL ;
Doc := WebBrowser1.Document ;
IF Doc.QueryInterface(IOleCommandTarget,OleCommandTarget) = 0 THEN BEGIN
ShowMessage(IntToStr(OleCommandTarget.Exec(NIL,OLECMDID_PASTESPECIAL,
OLECMDEXECOPT_PROMPTUSER,vaIn,vaOut)));
END ;
end;
procedure TForm1.WebBrowser1CommandStateChange(Sender: TObject;
Command: Integer; Enable: WordBool);
begin
// ShowMessage('Command state chg ' + IntToStr(Command) + ' ' +
IntToStr(ORD(Enable)));
end;
procedure TForm1.WebBrowser1NavigateComplete(Sender: TObject;
const URL: WideString);
begin
Caption := URL ;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
pDisp: IDispatch; var URL: OleVariant);
begin
Showmessage('Doc complete ' +URL);
end;
procedure TForm1.WebBrowser1MenuBar(Sender: TObject; MenuBar: WordBool);
begin
Showmessage('On menu bar');
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
Showmessage('On new window');
end;
procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
begin
// Showmessage('On progress change');
end;
procedure TForm1.WebBrowser1PropertyChange(Sender: TObject;
const szProperty: WideString);
begin
// Showmessage('On property chg ' + szProperty);
end;
procedure TForm1.WebBrowser1StatusBar(Sender: TObject;
StatusBar: WordBool);
begin
Showmessage('On statusbar');
end;
procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject;
const Text: WideString);
begin
// Showmessage('On status text chg - '+Text);
end;
procedure TForm1.WebBrowser1TheaterMode(Sender: TObject;
TheaterMode: WordBool);
begin
Showmessage('On theater mode');
end;
procedure TForm1.WebBrowser1TitleChange(Sender: TObject;
const Text: WideString);
begin
// Showmessage('On title change ' + Text);
end;
procedure TForm1.WebBrowser1ToolBar(Sender: TObject; ToolBar: WordBool);
begin
Showmessage('On toolbar');
end;
procedure TForm1.WebBrowser1Visible(Sender: TObject; Visible: WordBool);
begin
Showmessage('On visible');
end;
procedure TForm1.WebBrowser1FullScreen(Sender: TObject;
FullScreen: WordBool);
begin
Showmessage('On full screen');
end;
procedure TForm1.WebBrowser1Enter(Sender: TObject);
begin
Showmessage('On enter');
end;
procedure TForm1.WebBrowser1Exit(Sender: TObject);
begin
Showmessage('On exit');
end;
end.
---------------------------- Form ---------------------------------------
object Form1: TForm1
Left = 242
Top = 165
Width = 696
Height = 480
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -10
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object WebBrowser1: TWebBrowser
Left = 0
Top = 33
Width = 688
Height = 420
Align = alClient
TabOrder = 0
OnEnter = WebBrowser1Enter
OnExit = WebBrowser1Exit
OnStatusTextChange = WebBrowser1StatusTextChange
OnProgressChange = WebBrowser1ProgressChange
OnCommandStateChange = WebBrowser1CommandStateChange
OnTitleChange = WebBrowser1TitleChange
OnPropertyChange = WebBrowser1PropertyChange
OnNewWindow2 = WebBrowser1NewWindow2
OnNavigateComplete2 = WebBrowser1NavigateComplete2
OnDocumentComplete = WebBrowser1DocumentComplete
OnVisible = WebBrowser1Visible
OnToolBar = WebBrowser1ToolBar
OnMenuBar = WebBrowser1MenuBar
OnStatusBar = WebBrowser1StatusBar
OnFullScreen = WebBrowser1FullScreen
OnTheaterMode = WebBrowser1TheaterMode
ControlData = {
4C0000001B470000692B00000100000005000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126200000000000000004C0000000114020000000000C000000000000046
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 688
Height = 33
ButtonHeight = 24
ButtonWidth = 52
Flat = True
ShowCaptions = True
TabOrder = 1
object ToolButton1: TToolButton
Left = 0
Top = 0
Width = 42
Height = 21
Hint = 'ToolButton1'
Caption = 'Start'
ImageIndex = 0
OnClick = ToolButton1Click
end
object ToolButton2: TToolButton
Left = 42
Top = 0
Width = 42
Height = 21
Hint = 'ToolButton2'
Caption = 'Stop'
ImageIndex = 1
end
object Edit1: TEdit
Left = 84
Top = 0
Width = 267
Height = 21
TabOrder = 0
Text = 'http://StigsHomePC.DATAgruppen.dk/SjTest/index.htm'
end
object ToolButton3: TToolButton
Left = 351
Top = 0
Width = 42
Height = 21
Hint = 'ToolButton3'
Caption = 'Print'
ImageIndex = 2
OnClick = ToolButton3Click
end
object ToolButton4: TToolButton
Left = 393
Top = 0
Width = 42
Height = 21
Hint = 'ToolButton4'
Caption = 'Browse'
ImageIndex = 3
OnClick = ToolButton4Click
end
object ToolButton5: TToolButton
Left = 435
Top = 0
Width = 42
Height = 21
Hint = 'ToolButton5'
Caption = 'Copy'
ImageIndex = 4
OnClick = ToolButton5Click
end
object ToolButton6: TToolButton
Left = 477
Top = 0
Width = 42
Height = 21
Hint = 'ToolButton6'
Caption = 'Paste'
ImageIndex = 5
OnClick = ToolButton6Click
end
object ToolButton7: TToolButton
Left = 519
Top = 0
Width = 42
Height = 21
Hint = 'ToolButton7'
Caption = 'Past.S.'
ImageIndex = 6
OnClick = ToolButton7Click
end
end
object OpenDialog1: TOpenDialog
Filter = 'HTML documents (*.htm*)|*.htm'
Left = 488
Top = 42
end
end
---------------------------------------------------------------