Delphi中TWebBrowser的使用,实现IDocHostUIHandler接口

Delphi中TWebBrowser控件增强版，增加控制浏览器的滚动条，右键菜单，3D边框属性，可以通过设置属性隐藏TWebBrowser的滚动条，右键菜单，3D边框，使之不可见。控件代码如下：

unit WebBrowserWithUI;

interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  OleCtrls, SHDocVw, COmObj, ActiveX;



type

  TEnhancedWebBrowserUI = class(TPersistent)

  private

  FlatScrollBar: boolean;

  IE3DBorder: boolean;

  RightClickMenu: boolean;

  ScrollBar: boolean;

  public

  constructor Create;

  published

  property EnableScrollBars: boolean read ScrollBar write ScrollBar;

  property EnableFlatScrollBars: boolean read FlatScrollBar write

  FlatScrollBar;

  property EnableContextMenu: boolean read RightClickMenu write

  RightClickMenu;

  property Enable3DBorder: boolean read IE3DBorder write IE3DBorder;

  end;

  pDocHostUIInfo = ^TDocHostUIInfo;

  TDocHostUIInfo = packed record

  cbSize: ULONG;

  dwFlags: DWORD;

  dwDoubleClick: DWORD;

  pchHostCss: polestr;

  pchHostNS: polestr;

  end;

  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;



  TWebBrowserWithUI = class(TWebBrowser, IDocHostUIHandler)

  private

  { Private declarations }

  UIProperties: TEnhancedWebBrowserUI;

  protected

  { Protected declarations }

  public

  { Public declarations }

  constructor Create(AOwner: TComponent); override;

  destructor Destroy; override;

  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;

  published

  { Published declarations }

  property UISettings: TEnhancedWebBrowserUI read UIProperties write

  UIProperties;

  end;

const

  DOCHOSTUIFLAG_DIALOG = $00000001;

  DOCHOSTUIFLAG_DISABLE_HELP_MENU = $00000002;

  DOCHOSTUIFLAG_NO3DBORDER = $00000004;

  DOCHOSTUIFLAG_SCROLL_NO = $00000008;

  DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = $00000010;

  DOCHOSTUIFLAG_OPENNEWWIN = $00000020;

  DOCHOSTUIFLAG_DISABLE_OFFSCREEN = $00000040;

  DOCHOSTUIFLAG_FLAT_SCROLLBAR = $00000080;

  DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $00000100;

  DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = $00000200;

  DOCHOSTUIFLAG_OVERRIDEBEHAVIOURFACTORY = $00000400;

  DOCHOSTUIFLAG_CODEPAGELINKEDFONTS = $00000800;

  DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 = $00001000;

  DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 = $00002000;

  DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE = $00004000;

  IID_IDocHostUIHandler: TGUID = '{bd3f23c0-d43e-11CF-893b-00aa00bdce1a}';



procedure Register;



implementation



procedure Register;

begin

  RegisterComponents('Samples', [TWebBrowserWithUI]);

end;



{ TEnhancedWebBrowserUI }



constructor TEnhancedWebBrowserUI.Create;

begin

  ScrollBar := False;

  FlatScrollBar := False;

  IE3DBorder := False;

  RightClickMenu := False;

end;



{ TWebBrowserWithUI }



constructor TWebBrowserWithUI.Create(AOwner: TComponent);

begin

  inherited;

  UIProperties := TEnhancedWebBrowserUI.Create;

end;



destructor TWebBrowserWithUI.Destroy;

begin

  UIProperties.Free;

  inherited;

end;



function TWebBrowserWithUI.EnableModeless(const fEnable: BOOL): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.FilterDataObject(const pDO: IDataObject;

  out ppDORet: IDataObject): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.GetDropTarget(const pDropTarget: IDropTarget;

  out ppDropTarget: IDropTarget): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.GetExternal(out ppDispatch: IDispatch): HRESULT;

begin

  result := S_OK;

end;



function TWebBrowserWithUI.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;

begin

  pInfo.cbSize := SizeOf(pInfo);

  pInfo.dwFlags := 0;

  if not UIProperties.EnableScrollBars then

  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_SCROLL_NO;

  if UIProperties.EnableFlatScrollBars then

  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_FLAT_SCROLLBAR;

  if not UIProperties.Enable3DBorder then

  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER;

  result := S_OK;

end;



function TWebBrowserWithUI.GetOptionKeyPath(var pchKey: POLESTR;

  const dw: DWORD): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.HideUI: HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.OnDocWindowActivate(

  const fActivate: BOOL): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.OnFrameWindowActivate(

  const fActivate: BOOL): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.ResizeBorder(const prcBorder: PRECT;

  const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.ShowContextMenu(const dwID: DWORD;

  const ppt: PPOINT; const pcmdtReserved: IUnknown;

  const pdispReserved: IDispatch): HRESULT;

begin

  if UIProperties.EnableContextMenu then

  result := S_FALSE

  else

  result := S_OK;

end;



function TWebBrowserWithUI.ShowUI(const dwID: DWORD;

  const pActiveObject: IOleInPlaceActiveObject;

  const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;

  const pDoc: IOleInPlaceUIWindow): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.TranslateAccelerator(const lpMsg: PMSG;

  const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.TranslateUrl(const dwTranslate: DWORD;

  const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT;

begin

  result := S_FALSE;

end;



function TWebBrowserWithUI.UpdateUI: HRESULT;

begin

  result := S_FALSE;

end;

end.

 

将该代码保存为WebBrowserWithUI.pas，在delphi中通过unit安装该控件，在控件属性中新增uisetting属性，控制TWebBrowser的滚动条，右键菜单，3D边框是否可见。

建一个包，加入这个单元，安装就可以了。

转自：http://hi.baidu.com/bycong/blog/item/35d70bec611ce03362d09f49.html

另外也可以参考http://blog.sina.com.cn/s/blog_4b3c1f950102dtqx.html