atxwbproc.pas

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

  vaIn, vaOut: Olevariant;
begin
  result := 0;
  if WB_DocumentLoaded(WB) then
  begin
    vaIn := null;
    InvokeCmd(WB, FALSE, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
    result := vaOut;
  end;
end;

//----------------------------------------------------------------------------
procedure WB_SetZoom(WB: TWebBrowser; Size: TWBFontSize);
var
  V: OleVariant;
begin
  if WB_DocumentLoaded(WB) then
  begin
    V := Size;
    WB.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, V);
  end;
end;

//------------------------------------------------------
// Added by AT:

procedure WB_NavigateBlank(WB: TWebbrowser);
begin
  try
    WB.Navigate('about:blank');
    WB_Wait(WB);
  except
    MsgError('Cannot navigate to blank page in WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
procedure WB_NavigateFilename(WB: TWebbrowser; const FileName: WideString; DoWait: Boolean);
begin
  try
    WB.Navigate('file:///' + FileName); //'file:///' prefix in mandatory
    if DoWait then
      WB_Wait(WB);
  except
    MsgError('Cannot navigate in WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
function GetBodyElement(WB: TWebbrowser): IHTMLElement2;
var
  Dispatch: IDispatch;
begin
  Result := nil;
  if WB_DocumentLoaded(WB) then
    try
      Dispatch := (WB.ControlInterface.Document as IHTMLDocument2).Body;
      if Assigned(Dispatch) then
        Dispatch.QueryInterface(IHTMLElement2, Result);
    except
      MsgError('Cannot get body element in WebBrowser control.');
    end;
end;

//----------------------------------------------------------------------------
function WB_GetScrollTop(WB: TWebbrowser): Integer;
var
  Element: IHTMLElement2;
begin
  Result := 0;
  try
    Element := GetBodyElement(WB);
    if Assigned(Element) then
      Result := Element.ScrollTop;
  except
    MsgError('Cannot get scroll state in WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
procedure WB_SetScrollTop(WB: TWebbrowser; Value: Integer);
var
  Element: IHTMLElement2;
begin
  try
    Element := GetBodyElement(WB);
    if Assigned(Element) then
      Element.ScrollTop := Value;
  except
    MsgError('Cannot scroll in WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
function WB_GetScrollHeight(WB: TWebbrowser): Integer;
var
  Element: IHTMLElement2;
begin
  Result := 0;
  try
    Element := GetBodyElement(WB);
    if Assigned(Element) then
      Result := Element.ScrollHeight;
  except
    MsgError('Cannot get scroll state in WebBrowser control.');
  end;
end;

//----------------------------------------------------------------------------
procedure WB_IncreaseFont(WB: TWebbrowser; Increment: Boolean);
var
  N: TWBFontSize;
begin
  N := WB_GetZoom(WB);
  if Increment then
  begin
    if N < High(TWBFontSize) then
      WB_SetZoom(WB, Succ(N));
  end
  else
  begin
    if N > Low(TWBFontSize) then
      WB_SetZoom(WB, Pred(N));
  end;
end;

//----------------------------------------------------------------------------

{$ifdef OFFLINE}

{ Declarations from WinInet.pas }

type
  TInternetConnectedInfo = record
    dwConnectedState: DWORD;
    dwFlags: DWORD;
  end;

const
  INTERNET_STATE_CONNECTED                    = $00000001;  { connected state (mutually exclusive with disconnected) }
  INTERNET_STATE_DISCONNECTED                 = $00000002;  { disconnected from network }
  INTERNET_STATE_DISCONNECTED_BY_USER         = $00000010;  { disconnected by user request }
  INTERNET_STATE_IDLE                         = $00000100;  { no network requests being made (by Wininet) }
  INTERNET_STATE_BUSY                         = $00000200;  { network requests being made (by Wininet) }

  INTERNET_OPTION_CONNECTED_STATE             = 50;
  ISO_FORCE_DISCONNECTED  = $00000001;

type
  HINTERNET = Pointer;

  TInternetSetOption = function (hInet: HINTERNET; dwOption: DWORD;
    lpBuffer: Pointer; dwBufferLength: DWORD): BOOL; stdcall;

  TInternetQueryOption = function (hInet: HINTERNET; dwOption: DWORD;
    lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;

var
  HLib: THandle = 0;
  InternetSetOption: TInternetSetOption = nil;
  InternetQueryOption: TInternetQueryOption = nil;


{ Custom definitions }

type
  TWebOfflineMode = (woUnknown, woOfflineOn, woOfflineOff);

var
  WebInitialOffline: TWebOfflineMode = woUnknown;

function InitWinInetDLL: Boolean;
begin
  Result := False;
  try
    if HLib <> 0 then
      Exit;
    HLib := LoadLibrary('wininet.dll');
    if HLib <> 0 then
    begin
      InternetSetOption := GetProcAddress(HLib, 'InternetSetOptionA');
      InternetQueryOption:= GetProcAddress(HLib, 'InternetQueryOptionA');
    end;
  finally
    Result := (HLib <> 0) and
      Assigned(InternetSetOption) and
      Assigned(InternetQueryOption);
  end;
end;

procedure FreeWinInetDLL;
begin
  if HLib <> 0 then
  begin
    //Restore initial offline status
    if WebInitialOffline <> woUnknown then
      WB_SetGlobalOffline(WebInitialOffline = woOfflineOn);

    //Unload DLL
    FreeLibrary(HLib);
    HLib := 0;
    InternetSetOption := nil;
    InternetQueryOption := nil;
  end;
end;

//----------------------------------------------------------------------------
procedure WB_SetGlobalOffline(AValue: Boolean);
var
  ci: TInternetConnectedInfo;
  dwSize: DWORD;
begin
  //Load DLL
  if not InitWinInetDLL then
    Exit;

  //Remember initial offline status
  if WebInitialOffline = woUnknown then
  begin
    if WB_GetGlobalOffline then
      WebInitialOffline := woOfflineOn
    else
      WebInitialOffline := woOfflineOff;
  end;

  //Set the option
  dwSize := SizeOf(ci);
  if AValue then
  begin
    ci.dwConnectedState := INTERNET_STATE_DISCONNECTED_BY_USER;
    ci.dwFlags := ISO_FORCE_DISCONNECTED;
    InternetSetOption(nil, INTERNET_OPTION_CONNECTED_STATE, @ci, dwSize);
  end
  else
  begin
    ci.dwConnectedState := INTERNET_STATE_CONNECTED;
    ci.dwFlags := 0;
    InternetSetOption(nil, INTERNET_OPTION_CONNECTED_STATE, @ci, dwSize);
  end;
end;

//----------------------------------------------------------------------------
function WB_GetGlobalOffline: Boolean;
var
  dwState: DWORD;
  dwSize: DWORD;
begin
  //Load DLL
  if not InitWinInetDLL then
  begin
    Result := False;
    Exit
  end;

  //Get the option
  dwState := 0;
  dwSize := SizeOf(dwState);
  Result := False;
  if (InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @dwState, dwSize)) then
    if ((dwState and INTERNET_STATE_DISCONNECTED_BY_USER) <> 0) then
      Result := True;
end;

{$endif}


initialization

  OleInitialize(nil);

finalization

  {$ifdef OFFLINE}
  FreeWinInetDLL;
  {$endif}

  OleUninitialize;

end.