atxwbproc.pas

ATViewer is a component for Delphi/C++Builder, which allows to view files of various types. There is

//---------------------------------------------------------------- 
// Most of these functions are taken from "Mini Webbrowser Demo",
// which is available on http://torry.net.
// Some functions are added later by AT as stated in the comments.
// The original WBFuncs.pas unit caption is below:
//---------------------------------------------------------------- 

(**************************************************************)
(*                                                            *)
(*  TWebbrowser functions by toms                             *)
(*  Version 1.9                                               *)
(*  E-Mail: [e-mail]                          *)
(*                                                            *)
(*  Contributors: www.swissdelphicenter.ch                    *)
(*                                                            *)
(*                                                            *)
(**************************************************************)

{$I ATViewerOptions.inc} //ATViewer options
{$I Compilers.inc}       //Compiler defines

unit ATxWBProc;

interface

uses
  {$ifdef IE4X} WebBrowser4_TLB {$else} SHDocVw {$endif};

//From WBFuncs.pas:

procedure WB_Wait(WB: TWebbrowser);
procedure WB_SetFocus(WB: TWebbrowser);
procedure WB_Set3DBorderStyle(WB: TWebBrowser; bValue: Boolean);
procedure WB_Copy(WB: TWebbrowser);
procedure WB_SelectAll(WB: TWebbrowser);
procedure WB_ShowPrintDialog(WB: TWebbrowser);
procedure WB_ShowPrintPreview(WB: TWebbrowser);
procedure WB_ShowPageSetup(WB: TWebbrowser);
procedure WB_ShowFindDialog(WB: TWebbrowser);

//Added by AT:

procedure WB_NavigateBlank(WB: TWebbrowser);
procedure WB_NavigateFilename(WB: TWebbrowser; const FileName: WideString; DoWait: Boolean);

procedure WB_SelectNone(WB: TWebbrowser);
function WB_GetScrollTop(WB: TWebbrowser): Integer;
procedure WB_SetScrollTop(WB: TWebbrowser; Value: Integer);
function WB_GetScrollHeight(WB: TWebbrowser): Integer;
procedure WB_IncreaseFont(WB: TWebbrowser; Increment: Boolean);

{$ifdef OFFLINE}
procedure WB_SetGlobalOffline(AValue: Boolean);
function WB_GetGlobalOffline: Boolean;
{$endif}

var
  WB_MessagesEnabled: Boolean = False; //Can be set to True for debugging purposes


implementation

uses
  Windows, SysUtils, {$ifdef COMPILER_6_UP} Variants, {$endif}
  ActiveX, MSHTML, Forms;

type
  TWBFontSize = 0..4;

//----------------------------------------------------------------------------
procedure MsgError(const Msg: string);
begin
  if WB_MessagesEnabled then
    Application.MessageBox(PChar(Msg), 'Error', MB_OK or MB_ICONERROR or MB_TASKMODAL);
end;

//----------------------------------------------------------------------------
function InvokeCMD(WB: TWebbrowser; nCmdID: DWORD): Boolean; overload; forward;
function InvokeCMD(WB: TWebbrowser; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant): Boolean; overload; forward;

const
  CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
  HTMLID_FIND = 1;

function InvokeCMD(WB: TWebbrowser; nCmdID: DWORD): Boolean;
var
  vaIn, vaOut: OleVariant;
begin
  Result := InvokeCMD(WB, True, nCmdID, unassigned, vaIn, vaOut);
end;

function InvokeCMD(WB: TWebbrowser; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant): Boolean;
var
  CmdTarget: IOleCommandTarget;
  PtrGUID: PGUID;
begin
  Result:= False;
  New(PtrGUID);
  if InvokeIE then
    PtrGUID^ := CGID_WebBrowser
  else
    PtrGuid := PGUID(nil);
  if WB.ControlInterface.Document <> nil then
  try
    WB.ControlInterface.Document.QueryInterface(IOleCommandTarget, CmdTarget);
    if CmdTarget <> nil then
    try
      CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut);
      Result:= True;
    finally
      CmdTarget._Release;
    end;
  except
  end;
  Dispose(PtrGUID);
end;

//----------------------------------------------------------------------------
procedure WB_Wait(WB: TWebbrowser);
begin
  while (WB.ReadyState <> READYSTATE_COMPLETE)
    and not (Application.Terminated) do
  begin
    Application.ProcessMessages;
    Sleep(0);
  end;
end;

//----------------------------------------------------------------------------
function WB_DocumentLoaded(WB: TWebbrowser): Boolean;
var
  Doc: IHTMLDocument2;
begin
  Result := False;
  if Assigned(WB) then
    if WB.ControlInterface.Document <> nil then
    begin
      WB.ControlInterface.Document.QueryInterface(IHTMLDocument2, Doc);
      Result := Assigned(Doc);
    end;
end;

//----------------------------------------------------------------------------
procedure WB_SetFocus(WB: TWebbrowser);
begin
  try
    if WB_DocumentLoaded(WB) then
      (WB.ControlInterface.Document as IHTMLDocument2).ParentWindow.Focus;
  except
    MsgError('Cannot focus the WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
procedure WB_Set3DBorderStyle(WB: TWebBrowser; bValue: Boolean);
{
  bValue: True: Show a 3D border style
          False: Show no border
}
var
  Document: IHTMLDocument2;
  Element: IHTMLElement;
  StrBorderStyle: string;
begin
  if Assigned(WB) then
    if WB_DocumentLoaded(WB) then
      try
        Document := WB.ControlInterface.Document as IHTMLDocument2;
        if Assigned(Document) then
        begin
          Element := Document.Body;
          if Element <> nil then
          begin
            case bValue of
              False: StrBorderStyle := 'none';
              True: StrBorderStyle := '';
            end;
            Element.Style.BorderStyle := StrBorderStyle;
          end;
        end;
      except
        MsgError('Cannot change border style for WebBrowser control.');
      end;
end;

//----------------------------------------------------------------------------
procedure WB_Copy(WB: TWebbrowser);
var
  vaIn, vaOut: Olevariant;
begin
  InvokeCmd(WB, FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

//----------------------------------------------------------------------------
procedure WB_SelectAll(WB: TWebbrowser);
var
  vaIn, vaOut: Olevariant;
begin
  InvokeCmd(WB, FALSE, OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

//----------------------------------------------------------------------------
procedure WB_SelectNone(WB: TWebbrowser);
var
  vaIn, vaOut: Olevariant;
begin
  InvokeCmd(WB, FALSE, OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

//----------------------------------------------------------------------------
procedure WB_ShowPrintDialog(WB: TWebbrowser);
var
  OleCommandTarget: IOleCommandTarget;
  Command: TOleCmd;
  Success: HResult;
begin
  if WB_DocumentLoaded(WB) then
  begin
    WB.ControlInterface.Document.QueryInterface(IOleCommandTarget, OleCommandTarget);
    Command.cmdID := OLECMDID_PRINT;
    if OleCommandTarget.QueryStatus(nil, 1, @Command, nil) <> S_OK then
    begin
      //ShowMessage('Nothing to print');
      Exit;
    end;
    if (Command.cmdf and OLECMDF_ENABLED) <> 0 then
    begin
      Success := OleCommandTarget.Exec(nil, OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, EmptyParam, EmptyParam);
      if Success = S_OK then begin end;
      { //AT
      case Success of
        S_OK: ;
        OLECMDERR_E_CANCELED: ShowMessage('Canceled by user');
      else
        ShowMessage('Error while printing');
      end;
      }
    end
  end;
end;

//----------------------------------------------------------------------------
procedure WB_ShowPrintPreview(WB: TWebbrowser);
var
  vaIn, vaOut: OleVariant;
begin
  if WB_DocumentLoaded(WB) then
  try
    // Execute the print preview command.
    WB.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
      OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
  except
    MsgError('Cannot show Print Preview for WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
procedure WB_ShowPageSetup(WB: TWebbrowser);
var
  vaIn, vaOut: OleVariant;
begin
  if WB_DocumentLoaded(WB) then
  try
    // Execute the page setup command.
    WB.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
      vaIn, vaOut);
  except
    MsgError('Cannot show Print Setup for WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
procedure WB_ShowFindDialog(WB: TWebbrowser);
begin
  InvokeCMD(WB, HTMLID_FIND);
end;

//----------------------------------------------------------------------------
function WB_GetZoom(WB: TWebBrowser): TWBFontSize;
var