Leaderboard

For people who is having problems with download the zip file. UExportExcel.pas //============================================================================= // 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, uniBasicGrid, uniDBGrid; 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: TUniDBGrid): 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: TUniDBGrid): 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('There is no Grid is vinculated.'); 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.