unit DocHostUIHandler;
 
interface
 
uses
  Windows, Classes, SysUtils, ActiveX, SHDocVw;
 
const
  DOCHOSTUITYPE_BROWSE = 0;
  DOCHOSTUITYPE_AUTHOR = 1;
 
  DOCHOSTUIDBLCLK_DEFAULT = 0;
  DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1;
  DOCHOSTUIDBLCLK_SHOWCODE = 2;
 
  DOCHOSTUIFLAG_DIALOG = 1;
  DOCHOSTUIFLAG_DISABLE_HELP_MENU = 2;
  DOCHOSTUIFLAG_NO3DBORDER = 4;
  DOCHOSTUIFLAG_SCROLL_NO = 8;
  DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = 16;
  DOCHOSTUIFLAG_OPENNEWWIN = 32;
  DOCHOSTUIFLAG_DISABLE_OFFSCREEN = 64;
  DOCHOSTUIFLAG_FLAT_SCROLLBAR = 128;
  DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = 256;
  DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = 512;
 
type
  PDOCHOSTUIINFO = ^TDOCHOSTUIINFO;
 
  TDOCHOSTUIINFO = record
    cbSize: ULONG;
    dwFlags: DWORD;
    dwDoubleClick: DWORD;
  end;
 
  IDocHostShowUI = interface(IUnknown)
    ['{c4d244b0-d43e-11cf-893b-00aa00bdce1a}']
    function ShowMessage(hwnd: THandle; lpstrText: POLESTR;
      lpstrCaption: POLESTR; dwType: longint; lpstrHelpFile: POLESTR;
      dwHelpContext: longint; var plResult: LRESULT): HRESULT; stdcall;
    function ShowHelp(hwnd: THandle; pszHelpFile: POLESTR; uCommand: integer;
      dwData: longint; ptMouse: TPoint; var pDispachObjectHit: IDispatch)
      : HRESULT; stdcall;
  end; // IDocHostShowUI
 
  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; // IDocHostUIHandler
 
  TEnhancedWebBrowserUI = class(TPersistent)
  private
    FScrollBar: Boolean;
    FBorder3D: Boolean;
    FFlatScrollBars: Boolean;
    FContextMenu: Boolean;
  public
    constructor Create;
  published
    property ScrollBars: Boolean read FScrollBar write FScrollBar;
    property FlatScrollBars: Boolean read FFlatScrollBars write FFlatScrollBars;
    property ContextMenu: Boolean read FContextMenu write FContextMenu;
    property Border3D: Boolean read FBorder3D write FBorder3D;
  end;
 
  TWebBrowser = class(SHDocVw.TWebBrowser, IUnknown, IDocHostUIHandler, IDocHostShowUI)
  private
    FRefCount: integer;
    FEnhancedWebBrowserUI: TEnhancedWebBrowserUI;
  protected
    // IUnknown
    function QueryInterface(const IID: TGUID; out Obj): integer; stdcall;
    function _AddRef: longint; virtual; stdcall;
    function _Release: longint; virtual; stdcall;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // IDOcHostUIHandler
    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;
    // IDocHostShowUI
    function ShowMessage(hwnd: THandle; lpstrText: POLESTR;
      lpstrCaption: POLESTR; dwType: longint; lpstrHelpFile: POLESTR;
      dwHelpContext: longint; var plResult: LRESULT): HRESULT; stdcall;
    function ShowHelp(hwnd: THandle; pszHelpFile: POLESTR; uCommand: integer;
      dwData: longint; ptMouse: TPoint; var pDispachObjectHit: IDispatch)
      : HRESULT; stdcall;
    { Public declarations }
  published
    { Published declarations }
    property UI: TEnhancedWebBrowserUI read FEnhancedWebBrowserUI;
  end;
 
implementation
 
function TWebBrowser.ShowMessage(hwnd: THandle; lpstrText: POLESTR;
  lpstrCaption: POLESTR; dwType: longint; lpstrHelpFile: POLESTR;
  dwHelpContext: longint; var plResult: LRESULT): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.ShowHelp(hwnd: THandle; pszHelpFile: POLESTR;
  uCommand: integer; dwData: longint; ptMouse: TPoint;
  var pDispachObjectHit: IDispatch): HRESULT;
begin
  RESULT := S_OK;
end;
 
function TWebBrowser.QueryInterface(const IID: TGUID; out Obj): integer;
begin
  if GetInterface(IID, Obj) then
    RESULT := S_OK
  else
    RESULT := E_NOINTERFACE;
end;
 
function TWebBrowser._AddRef: longint;
begin
  Inc(FRefCount);
  RESULT := FRefCount;
end;
 
function TWebBrowser._Release: longint;
begin
  Dec(FRefCount);
  RESULT := FRefCount;
end;
 
function TWebBrowser.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
  const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT;
begin
  if FEnhancedWebBrowserUI.ContextMenu then
    Result := S_OK
  else
    Result := S_FALSE;
end;
 
function TWebBrowser.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
begin
  pInfo.cbSize := SizeOf(pInfo);
  pInfo.dwFlags := 0;
  if not FEnhancedWebBrowserUI.ScrollBars then
    pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_SCROLL_NO;
  if not FEnhancedWebBrowserUI.FlatScrollBars then
    pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_FLAT_SCROLLBAR;
  if not FEnhancedWebBrowserUI.Border3D then
    pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER;
 
//  pInfo.dwDoubleClick := 0;
  RESULT := S_OK;
end;
 
function TWebBrowser.ShowUI(const dwID: DWORD;
  const pActiveObject: IOleInPlaceActiveObject;
  const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
  const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
  RESULT := S_OK;
end;
 
function TWebBrowser.HideUI: HRESULT;
begin
  RESULT := S_OK;
end;
 
function TWebBrowser.UpdateUI: HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
constructor TWebBrowser.Create(AOwner: TComponent);
begin
  inherited;
 
  FEnhancedWebBrowserUI := TEnhancedWebBrowserUI.Create;
end;
 
destructor TWebBrowser.Destroy;
begin
  FEnhancedWebBrowserUI.Free;
 
  inherited;
end;
 
function TWebBrowser.EnableModeless(const fEnable: BOOL): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.OnFrameWindowActivate(const fActivate: BOOL): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.ResizeBorder(const prcBorder: PRECT;
  const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.TranslateAccelerator(const lpMsg: PMSG;
  const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.GetOptionKeyPath(var pchKey: POLESTR;
  const dw: DWORD): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.GetDropTarget(const pDropTarget: IDropTarget;
  out ppDropTarget: IDropTarget): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.GetExternal(out ppDispatch: IDispatch): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.TranslateUrl(const dwTranslate: DWORD;
  const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
function TWebBrowser.FilterDataObject(const pDO: IDataObject;
  out ppDORet: IDataObject): HRESULT;
begin
  RESULT := E_NotImpl;
end;
 
{ TEnhancedWebBrowserUI }
 
constructor TEnhancedWebBrowserUI.Create;
begin
  FScrollBar := True;
  FFlatScrollBars := False;
  FBorder3D := True;
  FContextMenu := True;
end;