Sorry, I was unable to attach the file, so I will leave the unit in writing ...
This unit is where the export process is located, no installation or any other dependency is required ...
to call the export just declare the unit and call the procedure ...
XLSWriter.DataSetToXLS(DataSet,Arq_Name);
Sorry, but I'm using a translator ...
Report if it worked ...
Good code ...
Hugs
unit uNativeXLSExport;
// based on internet, generate basic BIFF5 XLS
// http://sc.openoffice.org/excelfileformat.pdf
// CodePage support (see WriteCodePage)
// and Unicode compatibility - Radek Cervinka, delphi.cz
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms,
Dialogs, db, dbctrls, comctrls;
const
{ BOF }
CBOF = $0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{ EOF }
BIFF_EOF = $000A;
{ Document types }
DOCTYPE_XLS = $0010;
{ Dimensions }
DIMENSIONS = $0000;
type
TAtributCell = (acHidden, acLocked, acShaded, acBottomBorder, acTopBorder,
acRightBorder, acLeftBorder, acLeft, acCenter, acRight, acFill);
TSetOfAtribut = set of TAtributCell;
TXLSWriter = class(Tobject)
procedure DataSetToXLS(ds: TDataSet; fname: String);
private
maxCols, maxRows: word;
fstream: TFileStream;
procedure WriteWord(w: word);
procedure CellWord(vCol, vRow: word; aValue: word;
vAtribut: TSetOfAtribut = []);
procedure CellDouble(vCol, vRow: word; aValue: double;
vAtribut: TSetOfAtribut = []);
procedure CellStr(vCol, vRow: word; aValue: String;
vAtribut: TSetOfAtribut = []);
procedure WriteField(vCol, vRow: word; Field: TField);
constructor create(vFileName: string);
destructor Destroy; override;
procedure SetCellAtribut(value: TSetOfAtribut; var FAtribut: array of byte);
procedure StringGridToXLS(grid: TStringGrid; fname: String);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
procedure WriteCodePage;
public
end;
implementation
procedure TXLSWriter.DataSetToXLS(ds: TDataSet; fname: String);
var
c, r: Integer;
xls: TXLSWriter;
begin
xls := TXLSWriter.create(fname);
if ds.FieldCount > xls.maxCols then
xls.maxCols := ds.FieldCount + 1;
try
xls.WriteBOF;
xls.WriteCodePage;
xls.WriteDimension;
for c := 0 to ds.FieldCount - 1 do
xls.CellStr(0, c, ds.Fields[c].FieldName);
r := 1;
ds.first;
while (not ds.eof) and (r <= xls.maxRows) do
begin
for c := 0 to ds.FieldCount - 1 do
xls.WriteField(r, c, ds.Fields[c]);
inc(r);
ds.next;
end;
xls.WriteEOF;
// <2002-11-17> dllee
// ?? Dimension ?? wirteEOF ??,???? if ??? Seek ?? position
// if r > xls.maxrows then begin
// xls.maxrows:=r+1;
// xls.fstream.Seek(10,soFromBeginning);
// xls.WriteDimension;
// end;
// ????? maxrows ?????,????????? 65535,??,?????
finally
xls.free;
end;
end;
procedure TXLSWriter.StringGridToXLS(grid: TStringGrid; fname: String);
var
c, r, rMax: Integer;
xls: TXLSWriter;
begin
xls := TXLSWriter.create(fname);
rMax := grid.RowCount;
if grid.ColCount > xls.maxCols then
xls.maxCols := grid.ColCount + 1;
if rMax > xls.maxRows then // ???????? 65535 Rows
rMax := xls.maxRows;
try
xls.WriteBOF;
xls.WriteDimension;
for c := 0 to grid.ColCount - 1 do
for r := 0 to rMax - 1 do
xls.CellStr(r, c, grid.Cells[c, r]);
xls.WriteEOF;
finally
xls.free;
end;
end;
{ TXLSWriter }
constructor TXLSWriter.create(vFileName: string);
begin
inherited create;
if FileExists(vFileName) then
begin
fstream := TFileStream.create(vFileName, fmOpenWrite);
fstream.Size := 0;
end
else
fstream := TFileStream.create(vFileName, fmCreate);
maxCols := 100; // <2002-11-17> dllee Column ???????? 65535, ??????
maxRows := 65535; // <2002-11-17> dllee ???????????,?????????????????
end;
destructor TXLSWriter.destroy;
begin
if fstream <> nil then
fstream.free;
inherited;
end;
procedure TXLSWriter.WriteBOF;
begin
WriteWord(BOF_BIFF5);
WriteWord(6); // count of bytes
WriteWord(0);
WriteWord(DOCTYPE_XLS);
WriteWord(0);
end;
procedure TXLSWriter.WriteDimension;
begin
WriteWord(DIMENSIONS); // dimension OP Code
WriteWord(8); // count of bytes
WriteWord(0); // min cols
WriteWord(maxRows); // max rows
WriteWord(0); // min rowss
WriteWord(maxCols); // max cols
end;
procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
vAtribut: TSetOfAtribut);
var
FAtribut: array [0 .. 2] of byte;
begin
WriteWord(3); // opcode for double
WriteWord(15); // count of byte
WriteWord(vCol);
WriteWord(vRow);
SetCellAtribut(vAtribut, FAtribut);
fstream.Write(FAtribut, 3);
fstream.Write(aValue, 8);
end;
procedure TXLSWriter.CellWord(vCol, vRow: word; aValue: word;
vAtribut: TSetOfAtribut = []);
var
FAtribut: array [0 .. 2] of byte;
begin
WriteWord(2); // opcode for word
WriteWord(9); // count of byte
WriteWord(vCol);
WriteWord(vRow);
SetCellAtribut(vAtribut, FAtribut);
fstream.Write(FAtribut, 3);
WriteWord(aValue);
end;
procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: String;
vAtribut: TSetOfAtribut);
var
FAtribut: array [0 .. 2] of byte;
slen: byte;
begin
WriteWord(4); // opcode for string
slen := length(aValue);
WriteWord(slen + 8); // count of byte
WriteWord(vCol);
WriteWord(vRow);
SetCellAtribut(vAtribut, FAtribut);
fstream.Write(FAtribut, 3);
fstream.Write(slen, 1);
{$IFDEF UNICODE}
fstream.Write(AnsiString(aValue)[1], slen);
{$ELSE}
fstream.Write(aValue[1], slen);
{$ENDIF}
end;
procedure TXLSWriter.SetCellAtribut(value: TSetOfAtribut; var FAtribut: array of byte);
var
i: Integer;
begin
// reset
for i := 0 to High(FAtribut) do
FAtribut := 0;
{ Byte Offset Bit Description Contents
0 7 Cell is not hidden 0b
Cell is hidden 1b
6 Cell is not locked 0b
Cell is locked 1b
5-0 Reserved, must be 0 000000b
1 7-6 Font number (4 possible)
5-0 Cell format code
2 7 Cell is not shaded 0b
Cell is shaded 1b
6 Cell has no bottom border 0b
Cell has a bottom border 1b
5 Cell has no top border 0b
Cell has a top border 1b
4 Cell has no right border 0b
Cell has a right border 1b
3 Cell has no left border 0b
Cell has a left border 1b
2-0 Cell alignment code
general 000b
left 001b
center 010b
right 011b
fill 100b
Multiplan default align. 111b
}
// bit sequence 76543210
if acHidden in value then // byte 0 bit 7:
FAtribut[0] := FAtribut[0] + 128;
if acLocked in value then // byte 0 bit 6:
FAtribut[0] := FAtribut[0] + 64;
if acShaded in value then // byte 2 bit 7:
FAtribut[2] := FAtribut[2] + 128;
if acBottomBorder in value then // byte 2 bit 6
FAtribut[2] := FAtribut[2] + 64;
if acTopBorder in value then // byte 2 bit 5
FAtribut[2] := FAtribut[2] + 32;
if acRightBorder in value then // byte 2 bit 4
FAtribut[2] := FAtribut[2] + 16;
if acLeftBorder in value then // byte 2 bit 3
FAtribut[2] := FAtribut[2] + 8;
// <2002-11-17> dllee ?? 3 bit ??? 1 ???
if acLeft in value then // byte 2 bit 1
FAtribut[2] := FAtribut[2] + 1
else if acCenter in value then // byte 2 bit 1
FAtribut[2] := FAtribut[2] + 2
else if acRight in value then // byte 2, bit 0 dan bit 1
FAtribut[2] := FAtribut[2] + 3
else if acFill in value then // byte 2, bit 0
FAtribut[2] := FAtribut[2] + 4;
end;
procedure TXLSWriter.WriteWord(w: word);
begin
fstream.Write(w, 2);
end;
procedure TXLSWriter.WriteEOF;
begin
WriteWord(BIFF_EOF);
WriteWord(0);
end;
procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
begin
case Field.DataType of
ftString, ftWideString, ftBoolean, ftDate, ftDateTime, ftTime, ftWideMemo:
CellStr(vCol, vRow, Field.asstring);
ftAutoInc, ftSmallint, ftInteger, ftWord:
CellWord(vCol, vRow, Field.AsInteger);
ftFloat, ftBCD:
CellDouble(vCol, vRow, Field.AsFloat);
else
CellStr(vCol, vRow, EmptyStr); // <2002-11-17> dllee ??????????
end;
end;
procedure TXLSWriter.WriteCodePage;
begin
WriteWord($0042); // OPCODE CODEPAGE
WriteWord($0002); // size
WriteWord($04E2); // CP1250
//- >http://sc.openoffice.org/excelfileformat.pdf , section 5.17
end;
end.
