unit fruReport;

interface

uses
  utuMessage,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, SHDocVw,
  Dialogs, OleCtrls, Menus, AppEvnts, StrUtils, cxuAguarde, ExtCtrls;

type
  TPrintOption = (poShowConfig, poShowPreview, poMinimalMargins, poWithHeader, poWithFooter);
  TPrintOptions = set of TPrintOption;

  TfrReport = class(TFrame)
    WebBrowser: TWebBrowser;
    procedure FrameResize(Sender: TObject);
  private
    fXML: string;
    fXMLField: utField;
    fArquivosTemp : TStringList;
    fHandlerMessage : TMessageEvent;
    fParentFormOnResize: TNotifyEvent;
    fParentFormOnResizeSeted: Boolean;
    procedure CarregarStream(const piStream : TStream);
    function GerarArquivoTemporario: string;
    procedure AguardarProcessamentoWebBrowser(const piExibirJanelaProgresso : Boolean);
  public
    constructor Create(AOwner: TComponent) ; override;
    destructor Destroy; override;
    procedure LoadHTML(const piHtml : string; const piExibirJanelaProgresso : Boolean = True);
    procedure LoadHTMLFile(const piHtmlFileName : string; const piExibirJanelaProgresso : Boolean = True);
    procedure LoadXML(const piXML : string; const piExibirJanelaProgresso : Boolean = True);
    procedure LoadFile(const piFileName : string; const piExibirJanelaProgresso : Boolean = True);
    procedure LoadFromMessage(const piMessage : utField; const piExibirJanelaProgresso : Boolean = True);
    procedure PrintReport(const piOptions : TPrintOptions = []);
    procedure PageSetup;
    property XML: string read fXML write fXML;
    property XMLField: utField read fXMLField write fXMLField;
  end;

implementation

{$R *.dfm}

uses
  ActiveX, UrlMon, MSHtml, Registry;

{ TfrReport }

procedure TfrReport.AguardarProcessamentoWebBrowser(const piExibirJanelaProgresso : Boolean);
var
  lFormAguarde: TcxAguarde;
begin
  if piExibirJanelaProgresso
    then lFormAguarde := TcxAguarde.Create(Application)
    else lFormAguarde := Nil;
  self.WebBrowser.Align := alNone;
  if (not fParentFormOnResizeSeted) then
  begin
    fParentFormOnResize := (GetParentForm(self) as TForm).OnResize;
    (GetParentForm(self) as TForm).OnResize := FrameResize;
    fParentFormOnResizeSeted := True;
    FrameResize(self);
  end
  else
  begin
  end;
  try
    if piExibirJanelaProgresso then lFormAguarde.Show;
    Application.ProcessMessages;
    while WebBrowser.ReadyState <> READYSTATE_COMPLETE do
    begin
      Application.ProcessMessages;
      Sleep(5);
    end;
  finally
    if Assigned(lFormAguarde) then lFormAguarde.Free;
  end;
end;

procedure TfrReport.CarregarStream(const piStream: TStream);
var
  PersistStreamInit: IPersistStreamInit;
  StreamAdapter: IStream;
begin
  if not Assigned(WebBrowser.Document) then
    Exit;
  // Get IPersistStreamInit interface on document object
  if WebBrowser.Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then
  begin
    // Clear document
    if PersistStreamInit.InitNew = S_OK then
    begin
      // Get IStream interface on stream
      StreamAdapter:= TStreamAdapter.Create(piStream);
      // Load data from Stream into WebBrowser
      PersistStreamInit.Load(StreamAdapter);
    end;
  end;
end;

constructor TfrReport.Create(AOwner: TComponent);
begin
  inherited;
  fArquivosTemp:=TStringList.Create;
  fHandlerMessage:=Application.OnMessage;
end;

destructor TfrReport.Destroy;
begin
  while fArquivosTemp.Count > 0 do
  begin
    DeleteFile(fArquivosTemp[0]);
    fArquivosTemp.Delete(0);
  end;
  fArquivosTemp.Free;
  fXMLField.Free;
  inherited;
end;

procedure TfrReport.FrameResize(Sender: TObject);
var lParentForm: TCustomForm;
begin
  lParentForm := GetParentForm(self);
  if assigned(self.fParentFormOnResize) then self.fParentFormOnResize(lParentForm);
  self.SetBounds(0, 0, self.ClientWidth, self.ClientHeight);
  self.WebBrowser.SetBounds(0, 0, self.ClientWidth, self.ClientHeight);
  if self.Showing then
  begin
    lParentForm.FocusControl(nil);
    if assigned(self.WebBrowser.Document) then
    (self.WebBrowser.Application as IOleobject).DoVerb(OLEIVERB_UIACTIVATE, nil, self.WebBrowser, 0, Handle, self.GetClientRect);
  end;
end;

function TfrReport.GerarArquivoTemporario: string;
const
  lPrefixo = 'cnx';
var
  lPastaTemp : array[0..MAX_PATH] of Char;
  lNomeArq   : array[0..MAX_PATH] of Char;
begin
  if GetTempPath(MAX_PATH, @lPastaTemp) = 0 then
    raise Exception.Create ('GetTempPath error');
  if GetTempFileName(@lPastaTemp, lPrefixo, 0, @lNomeArq) = 0 then
    raise Exception.Create ('GetTempFileName error');
  Result := StrPas(lNomeArq);
  Result := StrUtils.ReplaceStr(Result, ExtractFileExt(Result), '.xml');
  fArquivosTemp.Add(Result);
end;

procedure TfrReport.LoadFile(const piFileName: string; const piExibirJanelaProgresso : Boolean = True);
begin
  WebBrowser.Navigate('file://'+piFileName);
  AguardarProcessamentoWebBrowser(piExibirJanelaProgresso);
end;

procedure TfrReport.LoadFromMessage(const piMessage: utField; const piExibirJanelaProgresso : Boolean = True);
var
  lStyleSheet : string;
begin
  if not piMessage.HasAttribute('StyleSheet') then raise Exception.Create('The StyleSheet attribute was not found.');
  lStyleSheet:=piMessage.AttributeByName('StyleSheet').AsString;
  //fXMLField := utField.Create;
  //fXMLField.Assign(piMessage);
  fXML := piMessage.GetXMLString([xoLegible], xeISO_8859_1, lStyleSheet);
  LoadXML(fXML, piExibirJanelaProgresso);
end;

procedure TfrReport.LoadHTML(const piHtml: string; const piExibirJanelaProgresso : Boolean = True);
var
  lStream : TStringStream;
begin
  WebBrowser.Navigate('about:blank');
  lStream:=TStringStream.Create(piHtml);
  try
    CarregarStream(lStream);
  finally
    lStream.Free;
  end;
  AguardarProcessamentoWebBrowser(piExibirJanelaProgresso);
end;

procedure TfrReport.LoadHTMLFile(const piHtmlFileName: string; const piExibirJanelaProgresso: Boolean);
var
  lStream : TFileStream;
begin
  WebBrowser.Navigate('about:blank');
  lStream:=TFileStream.Create(piHtmlFileName, fmOpenRead);
  try
    CarregarStream(lStream);
  finally
    lStream.Free;
  end;
  AguardarProcessamentoWebBrowser(piExibirJanelaProgresso);
end;

procedure TfrReport.LoadXML(const piXML: string; const piExibirJanelaProgresso : Boolean = True);
var
  lArq : TStringList;
  lNomeArq : string;
begin
  lNomeArq:=Self.GerarArquivoTemporario;
  lArq:=TStringList.Create;
  try
    lArq.Text:=piXML;
    lArq.SaveToFile(lNomeArq);
  finally
    lArq.Free;
  end;
  LoadFile(lNomeArq, piExibirJanelaProgresso);
end;

procedure TfrReport.PageSetup;
var
  vaIn, vaOut: OleVariant;
begin
  WebBrowser.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut);
end;

procedure TfrReport.PrintReport(const piOptions : TPrintOptions = []);
var
  vaIn, vaOut: OleVariant;
  lReg: TRegistry;
begin
  if (poShowConfig in piOptions) and (poShowPreview in piOptions) then
    raise Exception.Create('Using poShowConfig and poShowPreview at the same time is not allowed.');

  lReg := TRegistry.Create;
  try
    lReg.LazyWrite := False;
    lReg.RootKey := HKEY_CURRENT_USER;
    if lReg.OpenKey('\Software\Microsoft\Internet Explorer\PageSetup', False) then
    begin
      try
        if (poMinimalMargins in piOptions) then
        begin
          lReg.WriteString('margin_bottom', '0.20667');
          lReg.WriteString('margin_left', '0.25333');
          lReg.WriteString('margin_right', '0.24667');
          lReg.WriteString('margin_top', '0.25333');
        end;
        if (poMinimalMargins in piOptions) or (not (poWithHeader in piOptions)) then
        begin
          lReg.WriteString('header', '');
        end;
        if (poMinimalMargins in piOptions) or (not (poWithFooter in piOptions)) then
        begin
          lReg.WriteString('footer', '');
        end;
      finally
        lReg.CloseKey;
      end;
    end;
  finally
    lReg.free;
  end;

  if poShowConfig in piOptions then
    WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut)
  else if poShowPreview in piOptions then
    WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut)
  else
    WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

end.
