Exportar Excel Sem Office

//=============================================================================
// TDataSet to Excel without OLE or Excel required
// Mike Heydon Dec 2002

// Adapted to Unigui with TUniDBGrid
// Mauricio Naozuka - 26/04/2018 - naozuka@gmail.com
//=============================================================================

unit UExportExcel;

//  Example
//
//  Add uses UExportExcel
//
//procedure TMainForm.UniButton1Click(Sender: TObject);
//var url, filename, reportname : String;
//    exportExcel: TDataSetToExcel;
//    i: integer;
//begin
//  reportname := 'ExcelReport';
//  url := UniServerModule.LocalCacheURL+name+'.xls';
//  filename := UniServerModule.NewCacheFileUrl(false, 'xls', reportname, '', url);
//
//  exportExcel := TDataSetToExcel.Create;
//  exportExcel.WriteFile(filename, UniDBGrid1);
//  FreeAndNil(exportExcel);
//  UniSession.SendFile(filename, reportname+'.xls');
//end;

interface

uses Windows, SysUtils, DB, Math, Vcl.DBGrids;

type
  // TDataSetToExcel
  TDataSetToExcel = class(TObject)
  protected
    procedure WriteToken(AToken: word; ALength: word);
    procedure WriteFont(const AFontName: Ansistring; AFontHeight,
      AAttribute: word);
    procedure WriteFormat(const AFormatStr: Ansistring);
  private
    FRow: word;
    FFieldCount: integer;
    FDataFile: file;
    FFileName: string;
  public
    constructor Create;
    function WriteFile(const AFileName: string; const AGrid: TDBGrid): boolean;
  end;

//-----------------------------------------------------------------------------
implementation

const
  // XL Tokens
  XL_DIM = $00;
  XL_BOF = $09;
  XL_EOF = $0A;
  XL_DOCUMENT = $10;
  XL_FORMAT = $1E;
  XL_COLWIDTH = $24;
  XL_FONT = $31;

  // XL Cell Types
  XL_INTEGER = $02;
  XL_DOUBLE = $03;
  XL_STRING = $04;

  // XL Cell Formats
  XL_INTFORMAT = $81;
  XL_DBLFORMAT = $82;
  XL_XDTFORMAT = $83;
  XL_DTEFORMAT = $84;
  XL_TMEFORMAT = $85;
  XL_HEADBOLD = $40;
  XL_HEADSHADE = $F8;

  // ========================
  // Create the class
  // ========================

constructor TDataSetToExcel.Create;
begin
  FFieldCount := 0;
end;

// ====================================
// Write a Token Descripton Header
// ====================================

procedure TDataSetToExcel.WriteToken(AToken: word; ALength: word);
var
  aTOKBuffer: array[0..1] of word;
begin
  aTOKBuffer[0] := AToken;
  aTOKBuffer[1] := ALength;
  Blockwrite(FDataFile, aTOKBuffer, SizeOf(aTOKBuffer));
end;

// ====================================
// Write the font information
// ====================================

procedure TDataSetToExcel.WriteFont(const AFontName: ansistring;
  AFontHeight, AAttribute: word);
var
  iLen: byte;
begin
  AFontHeight := AFontHeight * 20;
  WriteToken(XL_FONT, 5 + length(AFontName));
  BlockWrite(FDataFile, AFontHeight, 2);
  BlockWrite(FDataFile, AAttribute, 2);
  iLen := length(AFontName);
  BlockWrite(FDataFile, iLen, 1);
  BlockWrite(FDataFile, AFontName[1], iLen);
end;

// ====================================
// Write the format information
// ====================================

procedure TDataSetToExcel.WriteFormat(const AFormatStr: ansistring);
var
  iLen: byte;
begin
  WriteToken(XL_FORMAT, 1 + length(AFormatStr));
  iLen := length(AFormatStr);
  BlockWrite(FDataFile, iLen, 1);
  BlockWrite(FDataFile, AFormatStr[1], iLen);
end;

// ====================================
// Write the XL file from data set
// ====================================

function TDataSetToExcel.WriteFile(const AFilename:String; const AGrid: TDbGrid): boolean;
var
  bRetvar: boolean;
  aDOCBuffer: array[0..1] of word;
  aDIMBuffer: array[0..3] of word;
  aAttributes: array[0..2] of byte;
  i: integer;
  iColNum,
  iDataLen: byte;
  sStrData: string;
  fDblData: double;
  wWidth: word;
  sStrBytes: TBytes;
begin
  if not Assigned(AGrid) then
    raise Exception.Create('Sem grid vinculada.');

  if not Assigned(AGrid.DataSource) then
    raise Exception.Create('There is no DataSource is vinculated to Grid ' + AGrid.Name);

  if not Assigned(AGrid.DataSource.DataSet) then
    raise Exception.Create('There is no DataSet is vinculated to DataSource ' + AGrid.DataSource.Name);

  bRetvar := true;
  FRow := 0;
  FillChar(aAttributes, SizeOf(aAttributes), 0);
  FFileName := ChangeFileExt(AFilename, '.xls');
  AssignFile(FDataFile, FFileName);

  try
    Rewrite(FDataFile, 1);
    // Beginning of File
    WriteToken(XL_BOF, 4);
    aDOCBuffer[0] := 0;
    aDOCBuffer[1] := XL_DOCUMENT;
    Blockwrite(FDataFile, aDOCBuffer, SizeOf(aDOCBuffer));

    // Font Table
    WriteFont('Arial', 10, 0);
    WriteFont('Arial', 10, 1);
    //WriteFont('Courier New', 11, 0);

    // Column widths
    iColNum := 0;
    for i := 0 to AGrid.Columns.Count-1 do
    begin
      if not AGrid.Columns[i].Visible then
        continue;

      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1 >
         Length(AGrid.Columns[i].Title.Caption) then
      begin
        wWidth := (AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1) * 256;
      end
      else
      begin
        wWidth := (Length(AGrid.Columns[i].Title.Caption) + 1) * 256;
      end;

      // Limitar o tamanho da coluna
      if wWidth > 80*256 then
        wWidth := 80*256;

//      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDateTime then
//        inc(wWidth, 100);
//      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDate then
//        inc(wWidth, 1050);
//      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftTime then
//        inc(wWidth, 100);

      WriteToken(XL_COLWIDTH, 4);

      BlockWrite(FDataFile, iColNum, 1);
      BlockWrite(FDataFile, iColNum, 1);
      BlockWrite(FDataFile, wWidth, 2);
      Inc(iColNum);
    end;

    FFieldCount := iColNum;

    // Column Formats
    WriteFormat('Geral');
    WriteFormat('0');
    WriteFormat('#.##0,0000');
    WriteFormat('dd/mm/aaaa hh:mm:ss');
    WriteFormat('dd/mm/aaaa');
    WriteFormat('hh:mm:ss');

    // Dimensions
    WriteToken(XL_DIM, 8);
    aDIMBuffer[0] := 0;
    aDIMBuffer[1] := Min(AGrid.DataSource.DataSet.RecordCount, $FFFF);
    aDIMBuffer[2] := 0;
    aDIMBuffer[3] := Min(FFieldCount - 1, $FFFF);
    Blockwrite(FDataFile, aDIMBuffer, SizeOf(aDIMBuffer));

    // Column Headers
    iColNum := 0;
    for i := 0 to AGrid.Columns.Count-1 do
    begin
      if not AGrid.Columns[i].Visible then
        continue;

      //      sStrData := FDataSet.Fields[i].DisplayName;
      sStrBytes := TEncoding.ANSI.GetBytes(AGrid.Columns[i].Title.Caption);
      iDataLen := length(sStrBytes);
      WriteToken(XL_STRING, iDataLen + 8);
      WriteToken(FRow, iColNum);
      aAttributes[1] := XL_HEADBOLD;
      //aAttributes[2] := XL_HEADSHADE;
      BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
      BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
      if iDataLen > 0 then
        BlockWrite(FDataFile, sStrBytes[0], iDataLen);
      aAttributes[2] := 0;
      Inc(iColNum);
    end;

    try
      AGrid.DataSource.DataSet.DisableControls;
      AGrid.DataSource.DataSet.First;

      // Data Rows
      while not AGrid.DataSource.DataSet.Eof do
      begin
        inc(FRow);
        iColNum := 0;

        for i := 0 to AGrid.Columns.Count-1 do
        begin
          if not AGrid.Columns[i].Visible then
            continue;

          case AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType of
              ftBoolean,
              ftWideString,
              ftFixedChar,
              ftString:
              begin
                try
                  //              sStrData := FDataSet.Fields[i].AsString;

                  sStrBytes:=TEncoding.ANSI.GetBytes(AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsString);
                  iDataLen := length(sStrBytes);
                  WriteToken(XL_STRING, iDataLen + 8);
                  WriteToken(FRow, iColNum);
                  aAttributes[1] := 0;
                  BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                  BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
                  if iDataLen > 0 then
                    BlockWrite(FDataFile, sStrBytes[0], iDataLen);
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter: ' + E.Message);
                end;
              end;

              ftAutoInc,
              ftSmallInt,
              ftInteger,
              ftWord,
              ftLargeInt:
              begin
                try
                fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                iDataLen := SizeOf(fDblData);
                WriteToken(XL_DOUBLE, 15);
                WriteToken(FRow, iColNum);
                aAttributes[1] := XL_INTFORMAT;
                BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                BlockWrite(FDataFile, fDblData, iDatalen);
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Inteiro: ' + E.Message);
                end;
              end;

              ftFloat,
              ftCurrency,
              ftBcd,
              ftFMTBcd:
              begin
                try
                fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                iDataLen := SizeOf(fDblData);
                WriteToken(XL_DOUBLE, 15);
                WriteToken(FRow, iColNum);
                aAttributes[1] := XL_DBLFORMAT;
                BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                BlockWrite(FDataFile, fDblData, iDatalen);
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Float: ' + E.Message);
                end;
              end;

            ftDateTime:
              begin
                try
                  if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                  begin
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_XDTFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                  end;
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter DateTime: ' + E.Message);
                end;
              end;

            ftDate:
              begin
                try
                  if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                  begin
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_DTEFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                  end;
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Date: ' + E.Message);
                end;
              end;

            ftTime:
              begin
                try
                  if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                  begin
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_TMEFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                  end;
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Time: ' + E.Message);
                end;
              end;

            ftMemo:
              begin
                // Does not print memo
              end;

          else raise Exception.Create('Tipo [' + AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).ClassName + '] do campo [' +
                                      AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).FieldName + '] não foi tratado.');

          end;

          Inc(iColNum);
        end; // end of for

        AGrid.DataSource.DataSet.Next;
      end; // end of while

    finally
      AGrid.DataSource.DataSet.EnableControls;
      AGrid.DataSource.DataSet.First;
    end;

    // End of File
    WriteToken(XL_EOF, 0);
    CloseFile(FDataFile);
  except
    bRetvar := false;
  end;

  Result := bRetvar;
end;

end.