呵呵!是不是想实现Webbrowser扩展COM服务器对象? 有了这个接口,IE上可以玩很多花样喔!
Try it ! Good Luck to you !
unit MYIDocHostUIHandler;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw_TLB, ActiveX;
const
DOCHOSTUITYPE_BROWSE= 0;
DOCHOSTUITYPE_AUTHOR= 1;
DOCHOSTUIDBLCLK_DEFAULT= 0;
DOCHOSTUIDBLCLK_SHOWPROPERTIES= 1;
DOCHOSTUIDBLCLK_SHOWCODE= 2;
DOCHOSTUIFLAG_DIALOG = 1;
DOCHOSTUIFLAG_DISABLE_HELP_MENU = 2;
DOCHOSTUIFLAG_NO3DBORDER = 4;
DOCHOSTUIFLAG_SCROLL_NO = 8;
DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = 16;
DOCHOSTUIFLAG_OPENNEWWIN = 32;
DOCHOSTUIFLAG_DISABLE_OFFSCREEN = 64;
DOCHOSTUIFLAG_FLAT_SCROLLBAR = 128;
DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = 256;
DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = 512;
type
PDOCHOSTUIINFO = ^TDOCHOSTUIINFO;
TDOCHOSTUIINFO = record
cbSize: ULONG;
dwFlags: DWORD;
dwDoubleClick: DWORD;
end;
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 pDispachObjectHit: IDispatch): HRESULT
stdcall;
end
// IDocHostShowUI
IDocHostUIHandler = interface(IUnknown)
['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
function ShowContextMenu(const dwID: DWORD
const ppt: PPOINT;
const pcmdtReserved: IUnknown
const pdispReserved: IDispatch): HRESULT;
stdcall;
function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT
stdcall;
function ShowUI(const dwID: DWORD
const pActiveObject:
IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget
const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HRESULT
stdcall;
function HideUI: HRESULT
stdcall;
function UpdateUI: HRESULT
stdcall;
function EnableModeless(const fEnable: BOOL): HRESULT
stdcall;
function OnDocWindowActivate(const fActivate: BOOL): HRESULT
stdcall;
function OnFrameWindowActivate(const fActivate: BOOL): HRESULT
stdcall;
function ResizeBorder(const prcBorder: PRECT;
const pUIWindow: IOleInPlaceUIWindow;
const fRameWindow: BOOL): HRESULT
stdcall;
function TranslateAccelerator(const lpMsg: PMSG
const pguidCmdGroup: PGUID;
const nCmdID: DWORD): HRESULT
stdcall;
function GetOptionKeyPath(var pchKey: POLESTR
const dw: DWORD): HRESULT;
stdcall;
function GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HRESULT
stdcall;
function GetExternal(out ppDispatch: IDispatch): HRESULT
stdcall;
function TranslateUrl(const dwTranslate: DWORD
const pchURLIn: POLESTR;
var ppchURLOut: POLESTR): HRESULT
stdcall;
function FilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HRESULT
stdcall;
end
// IDocHostUIHandler
TEmbeddedWB = class(TWebBrowser, IUnknown, IDocHostUIHandler, IDocHostShowUI)
private
FRefCount: Integer;
protected
//IUnknown
function QueryInterface(const IID: TGUID
out Obj): Integer
stdcall;
function _AddRef: Longint
virtual
stdcall;
function _Release: Longint
virtual
stdcall;
public
// IDOcHostUIHandler
function ShowContextMenu(const dwID: DWORD
const ppt: PPOINT;
const pcmdtReserved: IUnknown
const pdispReserved: IDispatch): HRESULT;
stdcall;
function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT
stdcall;
function ShowUI(const dwID: DWORD
const pActiveObject:
IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget
const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HRESULT
stdcall;
function HideUI: HRESULT
stdcall;
function UpdateUI: HRESULT
stdcall;
function EnableModeless(const fEnable: BOOL): HRESULT
stdcall;
function OnDocWindowActivate(const fActivate: BOOL): HRESULT
stdcall;
function OnFrameWindowActivate(const fActivate: BOOL): HRESULT
stdcall;
function ResizeBorder(const prcBorder: PRECT;
const pUIWindow: IOleInPlaceUIWindow;
const fRameWindow: BOOL): HRESULT
stdcall;
function TranslateAccelerator(const lpMsg: PMSG
const pguidCmdGroup: PGUID;
const nCmdID: DWORD): HRESULT
stdcall;
function GetOptionKeyPath(var pchKey: POLESTR
const dw: DWORD): HRESULT;
stdcall;
function GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HRESULT
stdcall;
function GetExternal(out ppDispatch: IDispatch): HRESULT
stdcall;
function TranslateUrl(const dwTranslate: DWORD
const pchURLIn: POLESTR;
var ppchURLOut: POLESTR): HRESULT
stdcall;
function FilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HRESULT
stdcall;
// IDocHostShowUI
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 pDispachObjectHit: IDispatch): HRESULT
stdcall;
{ Public declarations }
published
{ Published declarations }
end;
procedure Register;
implementation
function TEmbeddedWB.ShowMessage(hwnd: THandle
lpstrText: POLESTR;
lpstrCaption: POLESTR
dwType: longint;lpstrHelpFile: POLESTR;
dwHelpContext: longint
var plResult: LRESULT): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.ShowHelp(hwnd: THandle
pszHelpFile: POLESTR;
uCommand: integer
dwData: longint
ptMouse: TPoint;
var pDispachObjectHit: IDispatch): HRESULT;
begin
Result := S_OK;
end;
function TEmbeddedWB.QueryInterface(const iid: TGUID
out obj): Integer;
begin
if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
end;
function TEmbeddedWB._AddRef: Longint;
begin
Inc(FRefCount);
Result := FRefCount;
end;
function TEmbeddedWB._Release: Longint;
begin
Dec(FRefCount);
RESULT := FRefCount;
end;
function TEmbeddedWB.ShowContextMenu(const dwID: DWORD
const ppt: PPOINT;
const pcmdtReserved: IUnknown
const pdispReserved: IDispatch): HRESULT;
begin
RESULT := S_OK;
end;
function TEmbeddedWB.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
begin
pinfo.dwFlags := DOCHOSTUIFLAG_NO3DBORDER + DOCHOSTUIFLAG_SCROLL_NO;
pinfo.dwdoubleclick:=0;
RESULT := S_OK;
end;
function TEmbeddedWB.ShowUI(const dwID: DWORD;
const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget
const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
RESULT := S_Ok;
end;
function TEmbeddedWB.HideUI: HRESULT;
begin
RESULT := S_Ok;
end;
function TEmbeddedWB.UpdateUI: HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.EnableModeless(const fEnable: BOOL): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.OnFrameWindowActivate(const fActivate: BOOL): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.ResizeBorder(const prcBorder: PRECT;
const pUIWindow: IOleInPlaceUIWindow
const fRameWindow: BOOL): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.TranslateAccelerator(const lpMsg: PMSG;
const pguidCmdGroup: PGUID
const nCmdID: DWORD): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.GetOptionKeyPath(var pchKey: POLESTR
const dw: DWORD):
HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.GetExternal(out ppDispatch: IDispatch): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.TranslateUrl(const dwTranslate: DWORD;
const pchURLIn: POLESTR
var ppchURLOut: POLESTR): HRESULT;
begin
RESULT := E_NotImpl;
end;
function TEmbeddedWB.FilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HRESULT;
begin
RESULT := E_NotImpl;
end;
procedure Register;
begin
RegisterComponents('ActiveX', [TEmbeddedWB]);
end;
end.