zoukankan      html  css  js  c++  java
  • Delphi 中TWebBrowser的扩展控件TExWebBrowser

    主要扩展了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

  • 相关阅读:
    Linux IO接口 监控 (iostat)
    linux 防火墙 命令
    _CommandPtr 添加参数 0xC0000005: Access violation writing location 0xcccccccc 错误
    Visual Studio自动关闭
    Linux vsftpd 安装 配置
    linux 挂载外部存储设备 (mount)
    myeclipse 9.0 激活 for win7 redhat mac 亲测
    英文操作系统 Myeclipse Console 乱码问题
    Linux 基本操作命令
    linux 查看系统相关 命令
  • 原文地址:https://www.cnblogs.com/findumars/p/5290032.html
Copyright © 2011-2022 走看看