//=============================================================================
// 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.