leandropintor

Exportar Excel Sem Office

Nov 30th, 2020
1,173
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. //=============================================================================
  2. // TDataSet to Excel without OLE or Excel required
  3. // Mike Heydon Dec 2002
  4.  
  5. // Adapted to Unigui with TUniDBGrid
  6. // Mauricio Naozuka - 26/04/2018 - naozuka@gmail.com
  7. //=============================================================================
  8.  
  9. unit UExportExcel;
  10.  
  11. //  Example
  12. //
  13. //  Add uses UExportExcel
  14. //
  15. //procedure TMainForm.UniButton1Click(Sender: TObject);
  16. //var url, filename, reportname : String;
  17. //    exportExcel: TDataSetToExcel;
  18. //    i: integer;
  19. //begin
  20. //  reportname := 'ExcelReport';
  21. //  url := UniServerModule.LocalCacheURL+name+'.xls';
  22. //  filename := UniServerModule.NewCacheFileUrl(false, 'xls', reportname, '', url);
  23. //
  24. //  exportExcel := TDataSetToExcel.Create;
  25. //  exportExcel.WriteFile(filename, UniDBGrid1);
  26. //  FreeAndNil(exportExcel);
  27. //  UniSession.SendFile(filename, reportname+'.xls');
  28. //end;
  29.  
  30. interface
  31.  
  32. uses Windows, SysUtils, DB, Math, Vcl.DBGrids;
  33.  
  34. type
  35.   // TDataSetToExcel
  36.   TDataSetToExcel = class(TObject)
  37.   protected
  38.     procedure WriteToken(AToken: word; ALength: word);
  39.     procedure WriteFont(const AFontName: Ansistring; AFontHeight,
  40.       AAttribute: word);
  41.     procedure WriteFormat(const AFormatStr: Ansistring);
  42.   private
  43.     FRow: word;
  44.     FFieldCount: integer;
  45.     FDataFile: file;
  46.     FFileName: string;
  47.   public
  48.     constructor Create;
  49.     function WriteFile(const AFileName: string; const AGrid: TDBGrid): boolean;
  50.   end;
  51.  
  52. //-----------------------------------------------------------------------------
  53. implementation
  54.  
  55. const
  56.   // XL Tokens
  57.   XL_DIM = $00;
  58.   XL_BOF = $09;
  59.   XL_EOF = $0A;
  60.   XL_DOCUMENT = $10;
  61.   XL_FORMAT = $1E;
  62.   XL_COLWIDTH = $24;
  63.   XL_FONT = $31;
  64.  
  65.   // XL Cell Types
  66.   XL_INTEGER = $02;
  67.   XL_DOUBLE = $03;
  68.   XL_STRING = $04;
  69.  
  70.   // XL Cell Formats
  71.   XL_INTFORMAT = $81;
  72.   XL_DBLFORMAT = $82;
  73.   XL_XDTFORMAT = $83;
  74.   XL_DTEFORMAT = $84;
  75.   XL_TMEFORMAT = $85;
  76.   XL_HEADBOLD = $40;
  77.   XL_HEADSHADE = $F8;
  78.  
  79.   // ========================
  80.   // Create the class
  81.   // ========================
  82.  
  83. constructor TDataSetToExcel.Create;
  84. begin
  85.   FFieldCount := 0;
  86. end;
  87.  
  88. // ====================================
  89. // Write a Token Descripton Header
  90. // ====================================
  91.  
  92. procedure TDataSetToExcel.WriteToken(AToken: word; ALength: word);
  93. var
  94.   aTOKBuffer: array[0..1] of word;
  95. begin
  96.   aTOKBuffer[0] := AToken;
  97.   aTOKBuffer[1] := ALength;
  98.   Blockwrite(FDataFile, aTOKBuffer, SizeOf(aTOKBuffer));
  99. end;
  100.  
  101. // ====================================
  102. // Write the font information
  103. // ====================================
  104.  
  105. procedure TDataSetToExcel.WriteFont(const AFontName: ansistring;
  106.   AFontHeight, AAttribute: word);
  107. var
  108.   iLen: byte;
  109. begin
  110.   AFontHeight := AFontHeight * 20;
  111.   WriteToken(XL_FONT, 5 + length(AFontName));
  112.   BlockWrite(FDataFile, AFontHeight, 2);
  113.   BlockWrite(FDataFile, AAttribute, 2);
  114.   iLen := length(AFontName);
  115.   BlockWrite(FDataFile, iLen, 1);
  116.   BlockWrite(FDataFile, AFontName[1], iLen);
  117. end;
  118.  
  119. // ====================================
  120. // Write the format information
  121. // ====================================
  122.  
  123. procedure TDataSetToExcel.WriteFormat(const AFormatStr: ansistring);
  124. var
  125.   iLen: byte;
  126. begin
  127.   WriteToken(XL_FORMAT, 1 + length(AFormatStr));
  128.   iLen := length(AFormatStr);
  129.   BlockWrite(FDataFile, iLen, 1);
  130.   BlockWrite(FDataFile, AFormatStr[1], iLen);
  131. end;
  132.  
  133. // ====================================
  134. // Write the XL file from data set
  135. // ====================================
  136.  
  137. function TDataSetToExcel.WriteFile(const AFilename:String; const AGrid: TDbGrid): boolean;
  138. var
  139.   bRetvar: boolean;
  140.   aDOCBuffer: array[0..1] of word;
  141.   aDIMBuffer: array[0..3] of word;
  142.   aAttributes: array[0..2] of byte;
  143.   i: integer;
  144.   iColNum,
  145.   iDataLen: byte;
  146.   sStrData: string;
  147.   fDblData: double;
  148.   wWidth: word;
  149.   sStrBytes: TBytes;
  150. begin
  151.   if not Assigned(AGrid) then
  152.     raise Exception.Create('Sem grid vinculada.');
  153.  
  154.   if not Assigned(AGrid.DataSource) then
  155.     raise Exception.Create('There is no DataSource is vinculated to Grid ' + AGrid.Name);
  156.  
  157.   if not Assigned(AGrid.DataSource.DataSet) then
  158.     raise Exception.Create('There is no DataSet is vinculated to DataSource ' + AGrid.DataSource.Name);
  159.  
  160.   bRetvar := true;
  161.   FRow := 0;
  162.   FillChar(aAttributes, SizeOf(aAttributes), 0);
  163.   FFileName := ChangeFileExt(AFilename, '.xls');
  164.   AssignFile(FDataFile, FFileName);
  165.  
  166.   try
  167.     Rewrite(FDataFile, 1);
  168.     // Beginning of File
  169.     WriteToken(XL_BOF, 4);
  170.     aDOCBuffer[0] := 0;
  171.     aDOCBuffer[1] := XL_DOCUMENT;
  172.     Blockwrite(FDataFile, aDOCBuffer, SizeOf(aDOCBuffer));
  173.  
  174.     // Font Table
  175.     WriteFont('Arial', 10, 0);
  176.     WriteFont('Arial', 10, 1);
  177.     //WriteFont('Courier New', 11, 0);
  178.  
  179.     // Column widths
  180.     iColNum := 0;
  181.     for i := 0 to AGrid.Columns.Count-1 do
  182.     begin
  183.       if not AGrid.Columns[i].Visible then
  184.         continue;
  185.  
  186.       if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1 >
  187.          Length(AGrid.Columns[i].Title.Caption) then
  188.       begin
  189.         wWidth := (AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1) * 256;
  190.       end
  191.       else
  192.       begin
  193.         wWidth := (Length(AGrid.Columns[i].Title.Caption) + 1) * 256;
  194.       end;
  195.  
  196.       // Limitar o tamanho da coluna
  197.       if wWidth > 80*256 then
  198.         wWidth := 80*256;
  199.  
  200. //      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDateTime then
  201. //        inc(wWidth, 100);
  202. //      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDate then
  203. //        inc(wWidth, 1050);
  204. //      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftTime then
  205. //        inc(wWidth, 100);
  206.  
  207.       WriteToken(XL_COLWIDTH, 4);
  208.  
  209.       BlockWrite(FDataFile, iColNum, 1);
  210.       BlockWrite(FDataFile, iColNum, 1);
  211.       BlockWrite(FDataFile, wWidth, 2);
  212.       Inc(iColNum);
  213.     end;
  214.  
  215.     FFieldCount := iColNum;
  216.  
  217.     // Column Formats
  218.     WriteFormat('Geral');
  219.     WriteFormat('0');
  220.     WriteFormat('#.##0,0000');
  221.     WriteFormat('dd/mm/aaaa hh:mm:ss');
  222.     WriteFormat('dd/mm/aaaa');
  223.     WriteFormat('hh:mm:ss');
  224.  
  225.     // Dimensions
  226.     WriteToken(XL_DIM, 8);
  227.     aDIMBuffer[0] := 0;
  228.     aDIMBuffer[1] := Min(AGrid.DataSource.DataSet.RecordCount, $FFFF);
  229.     aDIMBuffer[2] := 0;
  230.     aDIMBuffer[3] := Min(FFieldCount - 1, $FFFF);
  231.     Blockwrite(FDataFile, aDIMBuffer, SizeOf(aDIMBuffer));
  232.  
  233.     // Column Headers
  234.     iColNum := 0;
  235.     for i := 0 to AGrid.Columns.Count-1 do
  236.     begin
  237.       if not AGrid.Columns[i].Visible then
  238.         continue;
  239.  
  240.       //      sStrData := FDataSet.Fields[i].DisplayName;
  241.       sStrBytes := TEncoding.ANSI.GetBytes(AGrid.Columns[i].Title.Caption);
  242.       iDataLen := length(sStrBytes);
  243.       WriteToken(XL_STRING, iDataLen + 8);
  244.       WriteToken(FRow, iColNum);
  245.       aAttributes[1] := XL_HEADBOLD;
  246.       //aAttributes[2] := XL_HEADSHADE;
  247.       BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
  248.       BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
  249.       if iDataLen > 0 then
  250.         BlockWrite(FDataFile, sStrBytes[0], iDataLen);
  251.       aAttributes[2] := 0;
  252.       Inc(iColNum);
  253.     end;
  254.  
  255.     try
  256.       AGrid.DataSource.DataSet.DisableControls;
  257.       AGrid.DataSource.DataSet.First;
  258.  
  259.       // Data Rows
  260.       while not AGrid.DataSource.DataSet.Eof do
  261.       begin
  262.         inc(FRow);
  263.         iColNum := 0;
  264.  
  265.         for i := 0 to AGrid.Columns.Count-1 do
  266.         begin
  267.           if not AGrid.Columns[i].Visible then
  268.             continue;
  269.  
  270.           case AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType of
  271.               ftBoolean,
  272.               ftWideString,
  273.               ftFixedChar,
  274.               ftString:
  275.               begin
  276.                 try
  277.                   //              sStrData := FDataSet.Fields[i].AsString;
  278.  
  279.                   sStrBytes:=TEncoding.ANSI.GetBytes(AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsString);
  280.                   iDataLen := length(sStrBytes);
  281.                   WriteToken(XL_STRING, iDataLen + 8);
  282.                   WriteToken(FRow, iColNum);
  283.                   aAttributes[1] := 0;
  284.                   BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
  285.                   BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
  286.                   if iDataLen > 0 then
  287.                     BlockWrite(FDataFile, sStrBytes[0], iDataLen);
  288.                 except on E: Exception do
  289.                   //ShowMessage(E.Message);
  290.                   raise Exception.Create('Erro Converter: ' + E.Message);
  291.                 end;
  292.               end;
  293.  
  294.               ftAutoInc,
  295.               ftSmallInt,
  296.               ftInteger,
  297.               ftWord,
  298.               ftLargeInt:
  299.               begin
  300.                 try
  301.                 fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
  302.                 iDataLen := SizeOf(fDblData);
  303.                 WriteToken(XL_DOUBLE, 15);
  304.                 WriteToken(FRow, iColNum);
  305.                 aAttributes[1] := XL_INTFORMAT;
  306.                 BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
  307.                 BlockWrite(FDataFile, fDblData, iDatalen);
  308.                 except on E: Exception do
  309.                   //ShowMessage(E.Message);
  310.                   raise Exception.Create('Erro Converter Inteiro: ' + E.Message);
  311.                 end;
  312.               end;
  313.  
  314.               ftFloat,
  315.               ftCurrency,
  316.               ftBcd,
  317.               ftFMTBcd:
  318.               begin
  319.                 try
  320.                 fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
  321.                 iDataLen := SizeOf(fDblData);
  322.                 WriteToken(XL_DOUBLE, 15);
  323.                 WriteToken(FRow, iColNum);
  324.                 aAttributes[1] := XL_DBLFORMAT;
  325.                 BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
  326.                 BlockWrite(FDataFile, fDblData, iDatalen);
  327.                 except on E: Exception do
  328.                   //ShowMessage(E.Message);
  329.                   raise Exception.Create('Erro Converter Float: ' + E.Message);
  330.                 end;
  331.               end;
  332.  
  333.             ftDateTime:
  334.               begin
  335.                 try
  336.                   if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
  337.                   begin
  338.                     fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
  339.                     iDataLen := SizeOf(fDblData);
  340.                     WriteToken(XL_DOUBLE, 15);
  341.                     WriteToken(FRow, iColNum);
  342.                     aAttributes[1] := XL_XDTFORMAT;
  343.                     BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
  344.                     BlockWrite(FDataFile, fDblData, iDatalen);
  345.                   end;
  346.                 except on E: Exception do
  347.                   //ShowMessage(E.Message);
  348.                   raise Exception.Create('Erro Converter DateTime: ' + E.Message);
  349.                 end;
  350.               end;
  351.  
  352.             ftDate:
  353.               begin
  354.                 try
  355.                   if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
  356.                   begin
  357.                     fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
  358.                     iDataLen := SizeOf(fDblData);
  359.                     WriteToken(XL_DOUBLE, 15);
  360.                     WriteToken(FRow, iColNum);
  361.                     aAttributes[1] := XL_DTEFORMAT;
  362.                     BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
  363.                     BlockWrite(FDataFile, fDblData, iDatalen);
  364.                   end;
  365.                 except on E: Exception do
  366.                   //ShowMessage(E.Message);
  367.                   raise Exception.Create('Erro Converter Date: ' + E.Message);
  368.                 end;
  369.               end;
  370.  
  371.             ftTime:
  372.               begin
  373.                 try
  374.                   if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
  375.                   begin
  376.                     fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
  377.                     iDataLen := SizeOf(fDblData);
  378.                     WriteToken(XL_DOUBLE, 15);
  379.                     WriteToken(FRow, iColNum);
  380.                     aAttributes[1] := XL_TMEFORMAT;
  381.                     BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
  382.                     BlockWrite(FDataFile, fDblData, iDatalen);
  383.                   end;
  384.                 except on E: Exception do
  385.                   //ShowMessage(E.Message);
  386.                   raise Exception.Create('Erro Converter Time: ' + E.Message);
  387.                 end;
  388.               end;
  389.  
  390.             ftMemo:
  391.               begin
  392.                 // Does not print memo
  393.               end;
  394.  
  395.           else raise Exception.Create('Tipo [' + AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).ClassName + '] do campo [' +
  396.                                       AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).FieldName + '] não foi tratado.');
  397.  
  398.           end;
  399.  
  400.           Inc(iColNum);
  401.         end; // end of for
  402.  
  403.         AGrid.DataSource.DataSet.Next;
  404.       end; // end of while
  405.  
  406.     finally
  407.       AGrid.DataSource.DataSet.EnableControls;
  408.       AGrid.DataSource.DataSet.First;
  409.     end;
  410.  
  411.     // End of File
  412.     WriteToken(XL_EOF, 0);
  413.     CloseFile(FDataFile);
  414.   except
  415.     bRetvar := false;
  416.   end;
  417.  
  418.   Result := bRetvar;
  419. end;
  420.  
  421. end.
RAW Paste Data