delphi中TWebBrowser控件增强版

最新推荐文章于 2024-08-10 15:17:20 发布

冷月宫主

最新推荐文章于 2024-08-10 15:17:20 发布

阅读量1.1k

点赞数

分类专栏： Oracle 文章标签： delphi function constructor autocomplete destructor scroll

Oracle 专栏收录该内容

538 篇文章 5 订阅

订阅专栏

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 := True;
FlatScrollBar := False;
IE3DBorder := True;
RightClickMenu := True;
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.