unit ituReport;

interface

uses
  ituVCLUIController, ituUIController, utuMessage,
  //Units do Delphi
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, JvMemoryDataset, StdCtrls, Buttons, ExtCtrls, AppEvnts, fruReport;

type
  TEventoCarga = procedure (const piDado : string; const piExibirJanelaProgresso : Boolean = True) of object;
  TEventoCargaMensagem = procedure (const piMessage : utField; const piExibirJanelaProgresso : Boolean = True) of object;
  TEventoImpressao = procedure (const piOptions : TPrintOptions = []) of object;

  TitReport = class(itInterfaceForm)
    pnBotoes: TPanel;
    btImprimir: TBitBtn;
    btConfigurarImprimir: TBitBtn;
    frReport1: TfrReport;
    btVisualizarImpressao: TBitBtn;
    SaveDialog1: TSaveDialog;
    btExportarXLS: TButton;
    itSelecionarArquivoExportacao: TSaveDialog;
    btExportarPDF: TButton;
    procedure btImprimirClick(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure btExportarXLSClick(Sender: TObject);
    procedure btExportarPDFClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    fPrintOptions: TPrintOptions;
    function LerLoadHTML : TEventoCarga;
    function LerLoadXML : TEventoCarga;
    function LerLoadFile : TEventoCarga;
    function LerLoadFromMessage : TEventoCargaMensagem;
    function LerPrintReport : TEventoImpressao;
    function RemoveXMLStyleSheetHeaderLine(piXMLStringIn: string): string;
    procedure TabularXML(piFieldIn: utField; piJoinField: utField; poFieldOut:utField);
    procedure PreencheDataSet(piMemoryDataSet: TJvMemoryData; piCollectionField: utField);
  public
    XSLFileName: string;
    mdExcel: TJvMemoryData;
    constructor Create(piApplication: TApplication; piPDFExportable: Boolean = False; piXLSExportable: Boolean = False); reintroduce;
    property LoadHTML : TEventoCarga read LerLoadHTML;
    property LoadXML : TEventoCarga read LerLoadXML;
    property LoadFile : TEventoCarga read LerLoadFile;
    property LoadFromMessage : TEventoCargaMensagem read LerLoadFromMessage;
    property PrintReport : TEventoImpressao read LerPrintReport;
    property PrintOptions: TPrintOptions read fPrintOptions write fPrintOptions;
  end;

var
  itReport: TitReport;

implementation

uses
  Activex, acuObject, acExcelExport, StrUtils, Printers, DB;

{$R *.dfm}

var MouseHook: Cardinal;

function MouseProc(nCode: Integer; wParam, lParam: Longint): LongInt; stdcall;
var
 classbuf: array[0..255] of Char;
const
 ie = 'Internet Explorer_Server';
begin
 Result := 0;
 case nCode < 0 of
   True:
     Result := CallNextHookEx(MouseHook, nCode, wParam, lParam) ;
   False:
     case wParam of
     WM_RBUTTONDOWN, WM_RBUTTONUP:
     begin
       GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, classbuf, SizeOf(classbuf)) ;
       if lstrcmp(@classbuf[0], @ie[1]) = 0 then
         Result := HC_SKIP
       else
         Result := CallNextHookEx(MouseHook, nCode, wParam, lParam) ;
     end
     else
     begin
       Result := CallNextHookEx(MouseHook, nCode, wParam, lParam) ;
     end;
   end; //case wParam
 end; //case nCode
end; (*MouseProc*)

{ TitRelatorio }

procedure TitReport.btExportarPDFClick(Sender: TObject);
begin

  //TODO

{  with TGDIPages.Create(self) do
  try
    // the title of the report
    Caption := self.Caption;

    //set orientation (portrait or landscape)
    Orientation := poLandscape;

    BeginDoc;
    // now we add some content to the report

    // header and footer
    AddTextToHeader(paramstr(0));
    SaveLayout;
    Font.Style := [fsItalic];
    TextAlign := taRight;
    //AddTextToFooterAt('http://synopse.info',RightMarginPos);
    RestoreSavedLayout;
    //AddTextToFooter(DateTimeToStr(Now));
    // main content (automaticaly split on next pages)
    //NewHalfLine;
    DrawTitle('Teste de Relatório',true);
    AddColumns([25,25,50]); //percentual width array
    AddColumnHeaders(['Coluna 1','Coluna 2','Coluna 3'],true,true); //headers array
    for i := 1 to 100 do
      DrawTextAcrossCols([IntToStr(i),'Column '+IntToStr(i),'Some text here']);
    NewLine;
    EndDoc;
    // this method will show a preview form, and allow basic actions
    // by using the right click menu
    ExportPDF('<FILENAME>', false, false);
  finally
    Free;
  end;}
  
end;

procedure TitReport.btExportarXLSClick(Sender: TObject);
var
  lReportField: utField;
  lXLSExportField,
  lXLSOutField: utField;
  lXLSTag: string;
  lExcelExport: TDataSetToExcel;
  lXmlString: string;
begin

  lXLSOutField := nil;

  lReportField := utField.Create;
  try
    if Assigned(frReport1.XMLField) then
    begin
      lReportField := frReport1.XMLField;
    end
    else
    begin
      lXmlString := RemoveXMLStyleSheetHeaderLine(frReport1.XML);
      lReportField.LoadFieldFromXMLString(lXmlString);
    end;

    if lReportField.HasAttribute('XLSExportTag') then
    begin
      if itSelecionarArquivoExportacao.Execute then
      begin
        if itSelecionarArquivoExportacao.FileName <> '' then
        begin
          XSLFileName := itSelecionarArquivoExportacao.FileName;
        end;
        lXlSTag := lReportField.AttributeByName('XLSExportTag').AsString;
        lXLSExportField := lReportField.FieldByName(lXLSTag);
        try
          lXLSOutField := utField.Create();
          lXLSOutField.Name := 'ROOT';
          TabularXML(lXLSExportField, nil, lXLSOutField);
          PreencheDataSet(mdExcel, lXLSOutField);
        finally
          lXLSOutField.Free;
        end;
        mdExcel.First;
        lExcelExport := TDataSetToExcel.Create(mdExcel, XSLFileName);
        if lExcelExport.WriteFile
          then Application.MessageBox(PChar('Arquivo ' + XSLFileName + ' gerado com sucesso.'), 'Sucesso')
          else raise Exception.Create('Erro na exportação do XLS.');
      end
      else ModalResult := mrCancel;
    end
    else raise Exception.Create('Relatório não possui campos candidatos para exportação.');
  finally
    lReportField.Free;
  end;
end;

procedure TitReport.btImprimirClick(Sender: TObject);
begin
  if Sender = btImprimir then
    frReport1.PrintReport(fPrintOptions)
  else if Sender = btConfigurarImprimir then
    frReport1.PrintReport(fPrintOptions + [poShowConfig])
  else
    frReport1.PrintReport(fPrintOptions + [poShowPreview]);
end;

constructor TitReport.Create(piApplication: TApplication; piPDFExportable: Boolean = False; piXLSExportable: Boolean = False);
begin
  inherited Create(piApplication);
  Self.btExportarPDF.Visible := piPDFExportable;
  Self.btExportarXLS.Visible := piXLSExportable;
end;

procedure TitReport.FormCreate(Sender: TObject);
begin
  MouseHook := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
end;

procedure TitReport.FormDestroy(Sender: TObject);
begin
  if MouseHook <> 0 then UnHookWindowsHookEx(MouseHook);
end;

procedure TitReport.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  lFileStream: TFileStream;
begin
  if Key = VK_F12 then
  begin
    SaveDialog1.Execute;
    if SaveDialog1.FileName <> '' then
    begin
      lFileStream := TFileStream.Create(SaveDialog1.FileName,fmCreate);
      try
        lFileStream.Write(Pointer(frReport1.XML)^,Length(frReport1.XML));
      except
        lFileStream.Free;
        raise;
      end;
      lFileStream.Free;
    end;
  end;
end;

procedure TitReport.FormShow(Sender: TObject);
begin
  self.frReport1.WebBrowser.Width := self.ClientWidth;
  self.frReport1.WebBrowser.Height := self.ClientHeight - pnBotoes.Height;
end;

function TitReport.LerLoadFile: TEventoCarga;
begin
  Result:=frReport1.LoadFile;
end;

function TitReport.LerLoadFromMessage: TEventoCargaMensagem;
begin
  Result:=frReport1.LoadFromMessage;
end;

function TitReport.LerLoadHTML: TEventoCarga;
begin
  Result:=frReport1.LoadHTML;
end;

function TitReport.LerLoadXML: TEventoCarga;
begin
  Result := frReport1.LoadXML;
  if frReport1.XMLField.HasAttribute('XLSExportTag') then btExportarXLS.Visible := True;
end;

function TitReport.LerPrintReport: TEventoImpressao;
begin
  Result:=frReport1.PrintReport;
end;

procedure TitReport.PreencheDataSet(piMemoryDataSet: TJvMemoryData; piCollectionField: utField);
var
  lmarc: acEnumerator;
  lFieldIndicador: utField;
  I: integer;
  lNomeAtributo: string;
  lTipoAtributo: TFieldType;

begin
  lmarc := piCollectionField.GetFieldsEnumerator;
  piMemoryDataSet.EmptyTable;
  piMemoryDataSet.Edit;
  try
    while not lmarc.EOL do
    begin
      lFieldIndicador := utField(lmarc.Current);
      piMemoryDataSet.Append;
      for I := 0 to piMemoryDataSet.FieldDefs.Count-1 do
      begin
        lNomeAtributo := piMemoryDataSet.FieldDefs[I].Name;
        lTipoAtributo := piMemoryDataSet.FieldDefs[I].DataType;
        if lFieldIndicador.HasAttribute(lNomeAtributo) then
        begin
          case lTipoAtributo of
            ftString: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsString;
            ftInteger: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsInteger;
            ftBoolean: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsBoolean;
            ftFloat: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsFloat;
            ftCurrency: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsCurrency;
            ftDate: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsDate;
            ftTime: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsTime;
            ftDateTime: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).AsDateTime;
            ftVariant: piMemoryDataSet.FieldByName(lNomeAtributo).Value := lFieldIndicador.AttributeByName(lNomeAtributo).ASVariant;
          end;
        end;
      end;
      lmarc.MoveNext;
    end;
  finally
    lmarc.Free;
  end;
end;

function TitReport.RemoveXMLStyleSheetHeaderLine(piXMLStringIn: string): string;
var
  lXMLStream: TStringStream;
  lXMLStringList: TStringList;
  lStringEnum: TStringsEnumerator;
  lXMLString: string;
  lCount: integer;
begin
  Result := '';
  lXMLStream := TStringStream.Create(piXMLStringIn);
  try
    lXMLStringList := TStringList.Create;
    try
      lXMLStringList.LoadFromStream(lXMLStream);
      lStringEnum := lXMLStringList.GetEnumerator;
      try
        lCount := 0;
        lStringEnum.MoveNext;
        lXMLString := lStringEnum.GetCurrent;
        while (AnsiContainsStr(lXMLString, '<?')) do
        begin
          lXMLString := lStringEnum.GetCurrent;
          lStringEnum.MoveNext;
          if AnsiContainsStr(lXMLString, 'xml-stylesheet') then
          begin
            lXMLStringList.Delete(lCount);
          end;
          Inc(lCount);
        end;
        Result := lXMLStringList.Text;
      finally
        lStringEnum.Free;
      end;
    finally
      lXMLStringList.Free;
    end;
  finally
    lXMLStream.Free;
  end;
end;

procedure TitReport.TabularXML(piFieldIn, piJoinField, poFieldOut: utField);
var
  lField: utField;
  lAttributesEnum,
  lFieldsEnum: acEnumerator;
  lCurrAttribute: utAttribute;
begin

  lField := utField.Create;
  lField.Name := 'ROW';

  if Assigned(piJoinField) then lField.Assign(piJoinField);

  lAttributesEnum := piFieldIn.GetAttibutesEnumerator;
  try
    while not lAttributesEnum.EOL do
    begin
      lCurrAttribute := lAttributesEnum.Current as utAttribute;
      lField.AddAttribute(lCurrAttribute.Name).Value := lCurrAttribute.Value;
      lAttributesEnum.MoveNext;
    end;
  finally
    lAttributesEnum.Free;
  end;
  if piFieldIn.HasFields then
  begin
    lFieldsEnum := piFieldIn.GetFieldsEnumerator;
    try
      while not lFieldsEnum.EOL do
      begin
        TabularXML(utField(lFieldsEnum.Current), lField, poFieldOut);
        lFieldsEnum.MoveNext;
      end;
    finally
      lFieldsEnum.Free;
    end;
  end
  else poFieldOut.AddField(lField.Name).Assign(lField);

  lField.Free;
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

end.
