WebBrowserWithUI

23:12
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.