Estou atualizando um antigo sistema feito em Delphi que utiliza uma classe para criar um arquivo Excel sem a necessidade de utilizar objetos OLE ou ter o Excel instalado.
A Classe funciona normalmente utilizando o código que está logo mais abaixo.
Agora surgiu a necessidade de adicionar uma informação na primeira linha, porém, mesclando a quantidade de colunas total do relatório.
Segue a classe
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.
Segue o que já tentei sem sucesso
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;
Imagino que eu precise escrever informações no binário do XLS indicando o merge, porém ainda não consegui com esse código.
Não posso mudar radicalmente a forma de gerar esse XLS. Como o código sugere, preciso escrever uma informação na primeira linha e o arquivo possui 10 colunas. A informação precisa estar nessas l0 colunas mescladas em 1.