关于改造WebBrowser控件的一些技巧,大家可以参考MSDN或者蒋晟写的一个东西,里面有讲的很详细的,今天我就说一下这个alter对话框的修改和过滤的方法: 很简单,只要咱们继承IDocHostShowUI这个接口,实现里面的ShowMessage方法就行了。 废话不多说,代码在这里:
unit Unit2;
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;
TForm2 = class(TForm) WebBrowser1: TWebBrowser; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form2: TForm2;
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),'不得闲测试',65); Result := S_OK; end;
procedure TForm2.FormCreate(Sender: TObject); begin self.WebBrowser1.Navigate(Application.ExeName + '\..\test.htm'); end;
end.
|
请发表评论