I'm updating an old Delphi system that uses a class to create an Excel file without the need to use OLE objects or have Excel installed.
The Class works normally using the code that is just below.
Now there is a need to add information in the first row, however, by merging the total amount of columns in the report.
Follow the class
unit ExportToExcel;
interface
uses Windows, SysUtils, DB, Math;
// ============================================================
// TDataSet to Excel without OLE or Excel required
// Mike Heydon Dec 2002
// ============================================================
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;
FDataFile: file;
FFileName: string;
FDataSet: TDataSet;
public
constructor Create(ADataSet: TDataSet; const AFileName: string);
function WriteFile: 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(ADataSet: TDataSet;
const AFileName: string);
begin
FDataSet := ADataSet;
FFileName := ChangeFileExt(AFilename, '.xls');
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: 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
bRetvar := true;
FRow := 0;
FillChar(aAttributes, SizeOf(aAttributes), 0);
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
for i := 0 to FDataSet.FieldCount - 1 do
begin
wWidth := (FDataSet.Fields[i].DisplayWidth + 1) * 256;
if FDataSet.FieldDefs[i].DataType = ftDateTime then
inc(wWidth, 2000);
if FDataSet.FieldDefs[i].DataType = ftDate then
inc(wWidth, 1050);
if FDataSet.FieldDefs[i].DataType = ftTime then
inc(wWidth, 100);
WriteToken(XL_COLWIDTH, 4);
iColNum := i;
BlockWrite(FDataFile, iColNum, 1);
BlockWrite(FDataFile, iColNum, 1);
BlockWrite(FDataFile, wWidth, 2);
end;
// Column Formats
WriteFormat('General');
WriteFormat('0');
WriteFormat('###,###,##0.00');
WriteFormat('dd-mmm-yyyy hh:mm:ss');
WriteFormat('dd-mmm-yyyy');
WriteFormat('hh:mm:ss');
// Dimensions
WriteToken(XL_DIM, 8);
aDIMBuffer[0] := 0;
aDIMBuffer[1] := Min(FDataSet.RecordCount, $FFFF);
aDIMBuffer[2] := 0;
aDIMBuffer[3] := Min(FDataSet.FieldCount - 1, $FFFF);
Blockwrite(FDataFile, aDIMBuffer, SizeOf(aDIMBuffer));
// Column Headers
for i := 0 to FDataSet.FieldCount - 1 do
begin
// sStrData := FDataSet.Fields[i].DisplayName;
sStrBytes :=
TEncoding.ANSI.GetBytes(FDataSet.Fields[i].DisplayName);
iDataLen := length(sStrBytes);
WriteToken(XL_STRING, iDataLen + 8);
WriteToken(FRow, i);
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;
end;
// Data Rows
while not FDataSet.Eof do
begin
inc(FRow);
for i := 0 to FDataSet.FieldCount - 1 do
begin
case FDataSet.FieldDefs[i].DataType of
ftBoolean,
ftWideString,
ftFixedChar,
ftString:
begin
// sStrData := FDataSet.Fields[i].AsString;
sStrBytes:=TEncoding.ANSI.GetBytes(FDataSet.Fields[i].AsString);
iDataLen := length(sStrBytes);
WriteToken(XL_STRING, iDataLen + 8);
WriteToken(FRow, i);
aAttributes[1] := 0;
BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
if iDataLen > 0 then
BlockWrite(FDataFile, sStrBytes[0], iDataLen);
end;
ftAutoInc,
ftSmallInt,
ftInteger,
ftWord,
ftLargeInt:
begin
fDblData := FDataSet.Fields[i].AsFloat;
iDataLen := SizeOf(fDblData);
WriteToken(XL_DOUBLE, 15);
WriteToken(FRow, i);
aAttributes[1] := XL_INTFORMAT;
BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
BlockWrite(FDataFile, fDblData, iDatalen);
end;
ftFloat,
ftCurrency,
ftBcd:
begin
fDblData := FDataSet.Fields[i].AsFloat;
iDataLen := SizeOf(fDblData);
WriteToken(XL_DOUBLE, 15);
WriteToken(FRow, i);
aAttributes[1] := XL_DBLFORMAT;
BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
BlockWrite(FDataFile, fDblData, iDatalen);
end;
ftDateTime:
begin
fDblData := FDataSet.Fields[i].AsFloat;
iDataLen := SizeOf(fDblData);
WriteToken(XL_DOUBLE, 15);
WriteToken(FRow, i);
aAttributes[1] := XL_XDTFORMAT;
BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
BlockWrite(FDataFile, fDblData, iDatalen);
end;
ftDate:
begin
fDblData := FDataSet.Fields[i].AsFloat;
iDataLen := SizeOf(fDblData);
WriteToken(XL_DOUBLE, 15);
WriteToken(FRow, i);
aAttributes[1] := XL_DTEFORMAT;
BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
BlockWrite(FDataFile, fDblData, iDatalen);
end;
ftTime:
begin
fDblData := FDataSet.Fields[i].AsFloat;
iDataLen := SizeOf(fDblData);
WriteToken(XL_DOUBLE, 15);
WriteToken(FRow, i);
aAttributes[1] := XL_TMEFORMAT;
BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
BlockWrite(FDataFile, fDblData, iDatalen);
end;
end;
end;
FDataSet.Next;
end;
// End of File
WriteToken(XL_EOF, 0);
CloseFile(FDataFile);
except
bRetvar := false;
end;
Result := bRetvar;
end;
end.
Follow what I've tried without success
sStrData := 'A1:A10';
iDataLen := Length(sStrData);
WriteToken(XL_STRING, iDataLEn + 8); // Tentei tbm com XL_FORMAT
WriteToken(0, 1); // Escrevendo no binario do arquivo XLS para informar que a referencia é a Linha 0, Coluna 1;
I imagine that I need to write information in the XLS binary indicating the merge, but I still can not get it with this code.
I can not radically change how to generate this XLS. As the code suggests, I need to write an information in the first line and the file has 10 columns. The information needs to be in those 10 columns merged into 1.