interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ActiveX;
type
IDocHostShowUI =
interface
(IUnknown)
[
'{c4d244b0-d43e-11cf-893b-00aa00bdce1a}'
]
function
ShowMessage(hwnd: THandle; lpstrText: POLESTR; lpstrCaption: POLESTR;dwType:
longint
; lpstrHelpfile: POLESTR; dwHelpContext:
longint
;
var
plResult: LRESULT): HRESULT; stdcall;
function
ShowHelp(hwnd: THandle; pszHelpfile: POLESTR; uCommand:
integer
;dwData:
longint
; ptMouse: TPoint;
var
pDispatchObjectHit: IDispatch): HRESULT; stdcall;
end
;
TWebBrowser =
class
(SHDocVw
.
TWebBrowser,IDocHostShowUI)
protected
function
ShowMessage(hwnd: THandle; lpstrText: POLESTR; lpstrCaption: POLESTR;dwType:
longint
; lpstrHelpfile: POLESTR; dwHelpContext:
longint
;
var
plResult: LRESULT): HRESULT; stdcall;
function
ShowHelp(hwnd: THandle; pszHelpfile: POLESTR; uCommand:
integer
;dwData:
longint
; ptMouse: TPoint;
var
pDispatchObjectHit: IDispatch): HRESULT; stdcall;
end
;
type
TForm1 =
class
(TForm)
WebBrowser1: TWebBrowser;
procedure
FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end
;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TWebBrowser }
function
TWebBrowser
.
ShowHelp(hwnd: THandle; pszHelpfile: POLESTR; uCommand,
dwData:
Integer
; ptMouse: TPoint;
var
pDispatchObjectHit: IDispatch): HRESULT;
begin
Result := S_FALSE;
end
;
function
TWebBrowser
.
ShowMessage(hwnd: THandle; lpstrText,
lpstrCaption: POLESTR; dwType:
Integer
; lpstrHelpfile: POLESTR;
dwHelpContext:
Integer
;
var
plResult: LRESULT): HRESULT;
begin
plResult := MessageBoxW(hwnd,PWChar(lpstrText),
'Title'
,
64
);
Result := S_OK;
end
;
procedure
TForm1
.
FormCreate(Sender: TObject);
begin
WebBrowser1
.
Navigate(
'E:/alert.htm'
);
end
;
end
.