主要扩展了3D界面、右键菜单、是否显示图片、是否支持JAVA等功能。

代码如下：

  1. unit ExtWebBrowser;
  2. interface
  3. uses
  4. Windows, SysUtils, Classes, Controls, OleCtrls, SHDocVw, ActiveX, Forms, URLMon;
  5. type
  6. TDocHostUIInfo = packed record
  7. cbSize : ULONG;
  8. dwFlags : DWORD;
  9. dwDoubleClick : DWORD;
  10. pchHostCss : polestr;
  11. pchHostNS : polestr;
  12. end;
  13. pDocHostUIInfo = ^TDocHostUIInfo;
  14. IDocHostUIHandler = interface(IUnknown)
  15. ['{BD3F23C0-D43E-11CF-893B-00AA00BDCE1A}']
  16. function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IUnknown; const pdispReserved: IDispatch):HRESULT; stdcall;
  17. function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
  18. function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
  19. function HideUI: HRESULT; stdcall;
  20. function UpdateUI: HRESULT; stdcall;
  21. function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
  22. function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
  23. function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
  24. function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT; stdcall;
  25. function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup:PGUID; const nCmdID: DWORD): HRESULT; stdcall;
  26. function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD):HRESULT; stdcall;
  27. function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
  28. function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
  29. function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT; stdcall;
  30. function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
  31. end;
  32. ICustomDoc = interface (IUnknown)
  33. ['{3050F3F0-98B5-11CF-BB82-00AA00BDCE0B}']
  34. function SetUIHandler (const pUIHandler : IDocHostUIHandler) : HRESULT; stdcall;
  35. end;
  36. TExWebBrowser = class;
  37. TUIProperties = class (TPersistent)
  38. private
  39. fOwner : TExWebBrowser;
  40. fEnableContextMenu: boolean;
  41. fEnableScrollBars: boolean;
  42. fFlatScrollBars: boolean;
  43. fHas3DBorder: boolean;
  44. fOpenLinksInNewWindow: boolean;
  45. fEnableScripting: boolean;
  46. fShowImages: boolean;
  47. fShowActiveX: boolean;
  48. fEnableDownloadActiveX: boolean;
  49. fEnableJava: boolean;
  50. public
  51. constructor Create (AOwner : TExWebBrowser);
  52. published
  53. property EnableContextMenu : boolean read fEnableContextMenu write fEnableContextMenu;
  54. property EnableScrollBars : boolean read fEnableScrollBars write fEnableScrollBars;
  55. property FlatScrollBars : boolean read fFlatScrollBars write fFlatScrollBars;
  56. property Has3DBorder : boolean read fHas3DBorder write fHas3DBorder;
  57. property OpenLinksInNewWindow : boolean read fOpenLinksInNewWindow write fOpenLinksInNewWindow;
  58. property EnableScripting : boolean read fEnableScripting write fEnableScripting;
  59. property EnableJava : boolean read fEnableJava write fEnableJava;
  60. property EnableDownloadActiveX : boolean read fEnableDownloadActiveX write fEnableDownloadActiveX;
  61. property ShowImages : boolean read fShowImages write fShowImages default True;
  62. property ShowActiveX : boolean read fShowActiveX write fShowActiveX default True;
  63. end;
  64. TExWebBrowser = class(TWebBrowser, IDocHostUIHandler, IDispatch)
  65. private
  66. fUIProperties : TUIProperties;
  67. fURL : string;
  68. fInternetSession : IInternetSession;
  69. { IDispatch }
  70. function IDispatch.Invoke = Invoke;
  71. function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  72. { IDocHostUIHandler }
  73. function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; const pcmdtReserved: IUnknown; const pdispReserved: IDispatch):HRESULT; stdcall;
  74. function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
  75. function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
  76. function HideUI: HRESULT; stdcall;
  77. function UpdateUI: HRESULT; stdcall;
  78. function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
  79. function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
  80. function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
  81. function ResizeBorder(const prcBorder: PRECT; const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT; stdcall;
  82. function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup:PGUID; const nCmdID: DWORD): HRESULT; stdcall;
  83. function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD):HRESULT; stdcall;
  84. function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
  85. function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
  86. function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT; stdcall;
  87. function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
  88. function GetURL: string;
  89. procedure SetURL(const Value: string);
  90. protected
  91. procedure Loaded; override;
  92. public
  93. constructor Create (AOwner : TComponent); override;
  94. destructor Destroy; override;
  95. procedure LoadFromString (const st : string);
  96. procedure LoadFromStream (s : TStream; takeOwnership : boolean = false);
  97. published
  98. property UIProperties : TUIProperties read fUIProperties write fUIProperties;
  99. property URL : string read GetURL write SetURL;
  100. end;
  101. implementation
  102. uses ComObj;
  103. const
  104. DOCHOSTUIFLAG_DIALOG = $00000001;
  105. DOCHOSTUIFLAG_DISABLE_HELP_MENU = $00000002;
  106. DOCHOSTUIFLAG_NO3DBORDER = $00000004;
  107. DOCHOSTUIFLAG_SCROLL_NO = $00000008;
  108. DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = $00000010;
  109. DOCHOSTUIFLAG_OPENNEWWIN = $00000020;
  110. DOCHOSTUIFLAG_DISABLE_OFFSCREEN = $00000040;
  111. DOCHOSTUIFLAG_FLAT_SCROLLBAR = $00000080;
  112. DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $00000100;
  113. DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = $00000200;
  114. DOCHOSTUIFLAG_OVERRIDEBEHAVIOURFACTORY = $00000400;
  115. DOCHOSTUIFLAG_CODEPAGELINKEDFONTS = $00000800;
  116. DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 = $00001000;
  117. DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 = $00002000;
  118. DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE = $00004000;
  119. { TExWebBrowser }
  120. constructor TExWebBrowser.Create(AOwner: TComponent);
  121. ///var
  122. //  Factory : IClassFactory;
  123. begin
  124. inherited Create (AOwner);
  125. fUIProperties := TUIProperties.Create (self);
  126. OleCheck (CoInternetGetSession (0, fInternetSession, 0));
  127. if fInternetSession <> Nil then
  128. begin
  129. //    CoGetClassObject(Class_CIDMimeFilter, CLSCTX_SERVER, nil, IClassFactory, Factory);
  130. //    OleCheck (fInternetSession.RegisterMimeFilter(Factory, Class_CIDMimeFilter, 'cid'));
  131. //    OleCheck (fInternetSession.RegisterNameSpace(Factory, CLASS_CIDMIMEFilter, 'cid', 0, nil, 0))
  132. end
  133. end;
  134. destructor TExWebBrowser.Destroy;
  135. begin
  136. fUIProperties.Free;
  137. inherited;
  138. end;
  139. (*----------------------------------------------------------------------*
  140. | TExWebBrowser.EnableModeless                                         |
  141. |                                                                      |
  142. | IE calls this to tell us that our dialogs should be modeless.        |
  143. *----------------------------------------------------------------------*)
  144. function TExWebBrowser.EnableModeless(const fEnable: BOOL): HRESULT;
  145. begin
  146. result := S_OK;
  147. end;
  148. (*----------------------------------------------------------------------*
  149. | TExWebBrowser.FilterDataObject                                       |
  150. |                                                                      |
  151. | IE calls this before putting data objects on the clipboard.  It      |
  152. | allows us to replace them or set them to nil.                        |
  153. |                                                                      |
  154. | The function returns S_FALSE meaning we didn't replace the object    |
  155. *----------------------------------------------------------------------*)
  156. function TExWebBrowser.FilterDataObject(const pDO: IDataObject;
  157. out ppDORet: IDataObject): HRESULT;
  158. begin
  159. ppDORet := Nil;
  160. result := S_FALSE;
  161. end;
  162. (*----------------------------------------------------------------------*
  163. | TExWebBrowser.GetDropTarget                                          |
  164. |                                                                      |
  165. | The IE control calls this when it's used as a drop target so we can  |
  166. | provide a different ppDropTarget if we want.  We don't.              |
  167. |                                                                      |
  168. | Parameters:                                                          |
  169. |   const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget
  170. |                                                                      |
  171. | The function returns HRESULT
  172. *----------------------------------------------------------------------*)
  173. function TExWebBrowser.GetDropTarget(const pDropTarget: IDropTarget;
  174. out ppDropTarget: IDropTarget): HRESULT;
  175. begin
  176. ppDropTarget := Nil;
  177. result := E_NOTIMPL
  178. end;
  179. (*----------------------------------------------------------------------*
  180. | TExWebBrowser.GetExternal                                            |
  181. |                                                                      |
  182. | IE calls this to determine our IDispatch interface.  We don't have   |
  183. | one...                                                               |
  184. *----------------------------------------------------------------------*)
  185. function TExWebBrowser.GetExternal(out ppDispatch: IDispatch): HRESULT;
  186. begin
  187. ppDispatch := Application;
  188. result := S_OK
  189. end;
  190. function TExWebBrowser.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
  191. begin
  192. FillChar (pInfo, SizeOf (pInfo), 0);
  193. pInfo.cbSize := sizeof (TDOCHOSTUIINFO);
  194. pInfo.cbSize := SizeOf(pInfo);
  195. pInfo.dwFlags := 0;
  196. if not UIProperties.EnableScrollBars then
  197. pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_SCROLL_NO;
  198. if UIProperties.FlatScrollBars then
  199. pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_FLAT_SCROLLBAR;
  200. if not UIProperties.Has3DBorder then
  201. pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER;
  202. if UIProperties.OpenLinksInNewWindow then
  203. pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_OPENNEWWIN;
  204. if not UIProperties.EnableScripting then
  205. pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE;
  206. result := S_OK;
  207. end;
  208. function TExWebBrowser.GetOptionKeyPath(var pchKey: POLESTR;
  209. const dw: DWORD): HRESULT;
  210. begin
  211. result := S_FALSE;
  212. end;
  213. function TExWebBrowser.GetURL: string;
  214. begin
  215. if (csDesigning in ComponentState) then
  216. result := fURL
  217. else
  218. result := self.LocationURL
  219. end;
  220. function TExWebBrowser.HideUI: HRESULT;
  221. begin
  222. result := S_OK;
  223. end;
  224. function TExWebBrowser.Invoke(DispID: Integer; const IID: TGUID;
  225. LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  226. ArgErr: Pointer): HResult;
  227. const
  228. DISPID_AMBIENT_DLCONTROL  = -5512;
  229. DLCTL_DLIMAGES            = $00000010;
  230. DLCTL_NO_SCRIPTS          = $00000080;
  231. DLCTL_NO_JAVA             = $00000100;
  232. DLCTL_NO_RUNACTIVEXCTLS   = $00000200;
  233. DLCTL_NO_DLACTIVEXCTLS    = $00000400;
  234. DLCTL_DOWNLOADONLY        = $00000800;
  235. var
  236. ort : HRESULT;
  237. dlc : Integer;
  238. begin
  239. result := inherited Invoke (DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
  240. if (Flags and DISPATCH_PROPERTYGET <> 0) and (VarResult <> nil) then
  241. begin
  242. ort := result;
  243. result := S_OK;
  244. case DispID of
  245. (*
  246. DISPID_AMBIENT_USERMODE:
  247. PVariant(VarResult)^ := True; // not (csDesigning in ComponentState);
  248. *)
  249. DISPID_AMBIENT_DLCONTROL:
  250. begin
  251. if UIProperties.ShowImages then
  252. dlc := DLCTL_DLIMAGES
  253. else
  254. dlc := 0;
  255. if not UIProperties.EnableJava then
  256. dlc := dlc or DLCTL_NO_JAVA;
  257. if not UIProperties.EnableScripting then
  258. dlc := dlc or DLCTL_NO_SCRIPTS;
  259. if not UIProperties.EnableDownloadActiveX then
  260. dlc := dlc or DLCTL_NO_DLACTIVEXCTLS;
  261. if not UIPRoperties.ShowActiveX then
  262. dlc := dlc or DLCTL_NO_RUNACTIVEXCTLS;
  263. PVariant(VarResult)^ := dlc
  264. end;
  265. else
  266. result := ort
  267. end
  268. end
  269. end;
  270. procedure TExWebBrowser.Loaded;
  271. begin
  272. inherited;
  273. if not (csDesigning in ComponentState) then
  274. if fURL = '' then
  275. Navigate ('about:blank')
  276. else
  277. Navigate (fURL);
  278. end;
  279. procedure TExWebBrowser.LoadFromStream(s: TStream; takeOwnership: boolean);
  280. var
  281. ownership : TStreamOwnership;
  282. persistStreamInit : IPersistStreamInit;
  283. adapter : TStreamAdapter;
  284. begin
  285. if Document = Nil then
  286. Navigate ('about:blank');
  287. if Supports (Document, IPersistStreamInit, persistStreamInit) then
  288. begin
  289. if takeOwnership then
  290. ownership := soOwned
  291. else
  292. ownership := soReference;
  293. adapter := TStreamAdapter.Create(s, ownership);
  294. OleCheck (persistStreamInit.InitNew);
  295. OleCheck (persistStreamInit.Load(adapter))
  296. end
  297. end;
  298. procedure TExWebBrowser.LoadFromString(const st: string);
  299. begin
  300. LoadFromStream (TStringStream.Create(st), True);
  301. end;
  302. function TExWebBrowser.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
  303. begin
  304. result := S_OK;
  305. end;
  306. function TExWebBrowser.OnFrameWindowActivate(
  307. const fActivate: BOOL): HRESULT;
  308. begin
  309. result := S_OK;
  310. end;
  311. function TExWebBrowser.ResizeBorder(const prcBorder: PRECT;
  312. const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT;
  313. begin
  314. result := S_OK;
  315. end;
  316. procedure TExWebBrowser.SetURL(const Value: string);
  317. begin
  318. fURL := Value;
  319. if (csLoading in ComponentState) or (csDesigning in ComponentState) then
  320. Exit;
  321. if Value = '' then
  322. Navigate ('about:blank')
  323. else
  324. Navigate (value);
  325. end;
  326. function TExWebBrowser.ShowContextMenu(const dwID: DWORD;
  327. const ppt: PPOINT; const pcmdtReserved: IInterface;
  328. const pdispReserved: IDispatch): HRESULT;
  329. begin
  330. if UIProperties.EnableContextMenu then
  331. result := S_FALSE
  332. else
  333. begin
  334. result := S_OK;
  335. if Assigned (PopupMenu) then
  336. PopupMenu.Popup(ppt.X, ppt.Y)
  337. end;
  338. end;
  339. function TExWebBrowser.ShowUI(const dwID: DWORD;
  340. const pActiveObject: IOleInPlaceActiveObject;
  341. const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
  342. const pDoc: IOleInPlaceUIWindow): HRESULT;
  343. begin
  344. result := S_FALSE;  // IE will display the UI
  345. end;
  346. function TExWebBrowser.TranslateAccelerator(const lpMsg: PMSG;
  347. const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;
  348. begin
  349. result := S_FALSE;
  350. end;
  351. function TExWebBrowser.TranslateUrl(const dwTranslate: DWORD;
  352. const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT;
  353. begin
  354. result := S_FALSE;   // URL was not translated
  355. end;
  356. function TExWebBrowser.UpdateUI: HRESULT;
  357. begin
  358. result := S_FALSE;
  359. end;
  360. { TUIProperties }
  361. constructor TUIProperties.Create(AOwner: TExWebBrowser);
  362. begin
  363. fOwner := AOwner;
  364. fShowImages := True;
  365. fShowActiveX := True;
  366. end;
  367. end.
 
 

http://blog.csdn.net/missmecn/article/details/2292758

Delphi 中TWebBrowser的扩展控件TExWebBrowser的更多相关文章

  1. Delphi中解析Xml的控件-SimDesign NativeXml

    Delphi中解析Xml的控件-SimDesign NativeXml 正在学习,感觉应用很方便.无源代码的版本还是免费的. SimDesign.NativeXml是一个delphi和bcb的XML控 ...

  2. 对delphi中的数据敏感控件的一点探索

    一直对delphi数据敏感控件很好奇,感觉很神奇.只要简单设置一下,就显示和编辑数据,不用写一行代码. 如果不用数据敏感控件,编辑一个表字段数据并保存,我相信应用如下代码. Table1.edit, ...

  3. delphi中使用MSWINSCK.OCX控件

    1.首先是把winsck控件导入到delphi中,就是导入一个ActiveX控件,步骤略过. 2.将导入的winsck控件拖入你的Form中. 3.对winsck进行基本设置(IP,Port). 4. ...

  4. 多年前写的文本框扩展控件(有ValueChanging事件等)，已放github

    本文版权归mephisto和博客园共有,欢迎转载,但须保留此段声明,并给出原文链接,谢谢合作. 文章是哥(mephisto)写的,SourceLink 阅读目录 介绍 起因 代码 使用 GitHub ...

  5. Delphi下使用Oracle Access控件组下TOraSession控件链接

    Delphi下使用Oracle Access控件组下TOraSession控件链接数据库,使用  orsn1.Options.Direct:=true;  orsn1.Server:=IP:Port: ...

  6. 在Winform开发框架中，利用DevExpress控件实现数据的快速录入和选择

    在实际的项目开发过程中,有好的控件或者功能模块,我都是想办法尽可能集成到我的WInform开发框架中,这样后面开发项目起来,就可以节省很多研究时间,并能重复使用,非常高效方便.在我很早之前的一篇博客& ...

  7. JavaFX的扩展控件库ControlsFX介绍

    声明:   本博客文章原创类别的均为个人原创,版权所有.转载请注明出处: http://blog.csdn.net/ml3947,另外本人的个人博客:http://www.wjfxgame.com. ...

  8. WPF自定义控件（三）の扩展控件

    扩展控件,顾名思义就是对已有的控件进行扩展,一般继承于已有的原生控件,不排除继承于自定义的控件,不过这样做意义不大,因为既然都自定义了,为什么不一步到位呢,有些不同的需求也可以通过此来完成,不过类似于 ...

  9. Delphi 10 Seattle 小票打印控件TQ_Printer

    TQ_Printrer控件,是一个为方便需要控制打印命令而设计的跨平台专用控件,已包含标准ESC/POS打印控制的基本指令在内(这些基本指令已能很好的满足多数项目使用). TQ_Printrer控件让 ...

随机推荐

  1. listview滑动

    单击其中的一个item时,让这个item能滚动的listview的顶部.现在用 list.scrollTo(0, item.getTop()); 实现啦 android listview滚动到顶部 转 ...

  2. 基于visual Studio2013解决C语言竞赛题之0708字符串查找

       题目

  3. 基于visual Studio2013解决C语言竞赛题之0704字符串长度

     题目

  4. PredictionIO Open Source Machine Learning Server

    PredictionIO Open Source Machine Learning Server Build Smarter Software with Machine Learning Predic ...

  5. swift 自定义TabBarItem

    1.效果图     2.NewsViewController.swift // // NewsViewController.swift // NavigationDemo // // Created ...

  6. android获取View上某点的颜色

    //根据坐标获取 ImageView imageView = ((ImageView)v); Bitmap bitmap = ((BitmapDrawable)imageView.getDrawabl ...

  7. itextSharp 使用模板(PdfTemplate)不规则分栏(ColumnText)

    public static void Main() { Document document = new Document(); BaseFont bf = BaseFont.createFont(Ba ...

  8. php的var关键字

    public和var的作用差不多 因为 var定义的变量如果没有加protected 或 private则默认为public php4 中一般是用 varphp5 中就一般是用 public了 现在基 ...

  9. KMP算法 KMP模式匹配 一（串）

    A - KMP模式匹配 一(串) Crawling in process... Crawling failed Time Limit:1000MS     Memory Limit:131072KB  ...

  10. c++中一个类所占用的空间

    看到阿里的一道笔试题: #pragma pack(2) class A { int i; union U { char buff[13]; int i; }u; void foo() { } type ...