program project1;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
uses
Classes, SysUtils;
const
BIFF_EOF = $000A;
XLS_SHEET = $0010;
//--
BOF_BIFF2 = $0009;
BIFF2_SHEETVIEWSETTINGS_WINDOW2 = $003E;
LABEL_BIFF2 = $0004;
DIMENSIONS_BIFF2 = $0000;
//--
BOF_BIFF5 = $0809;
LABEL_BIFF5 = $0204;
DIMENSIONS_BIFF5 = $0200;
type
TmyDynStringArray = array of string;
TmyDynStringStringArray = array of TmyDynStringArray;
type
TXLSWriter = class(Tobject)
private
procedure WriteBIFFRecordHeader(ARecordID: Word; ARecordSize: Word);
procedure WriteByte(B: byte);
procedure WriteWord(W: word);
protected
function ConvertToCodePage(AText: String): ansistring;
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
procedure WriteCodePage;
public
Version: Byte;
DataStream: TMemoryStream;
MaxCols: Word;
MaxRows: Word;
procedure CellStr(ARow, ACol: Word; const AValue: String);
constructor Create;
destructor Destroy; override;
end;
constructor TXLSWriter.Create;
begin
inherited Create;
DataStream := TMemoryStream.Create;
DataStream.Size := 0;
MaxCols := 256;
MaxRows := 65535;
end;
destructor TXLSWriter.Destroy;
begin
if DataStream <> nil then
DataStream.Free;
inherited;
end;
procedure TXLSWriter.WriteBIFFRecordHeader(ARecordID, ARecordSize: word);
begin
WriteWord(ARecordID);
WriteWord(ARecordSize);
end;
procedure TXLSWriter.WriteBOF;
begin
(*
https://www.openoffice.org/sc/excelfileformat.pdf#page=135&zoom=auto,104.9,771.1
- 5.8 BOF – Beginning of File
*)
WriteBIFFRecordHeader(BOF_BIFF2, 4);
WriteWord(BOF_BIFF2);
WriteWord(XLS_SHEET);
end;
procedure TXLSWriter.WriteDimension;
begin
(*
https://www.openoffice.org/sc/excelfileformat.pdf#page=160&zoom=auto,85.6,581.5
- 5.35 DIMENSIon
*)
WriteBIFFRecordHeader(DIMENSIONS_BIFF2, 8);
WriteWord(0); // min cols
WriteWord(MaxRows); // max rows
WriteWord(0); // min rowss
WriteWord(MaxCols); // max cols
end;
function TXLSWriter.ConvertString(AText: String): ansistring;
begin
{$IFDEF FPC}
Result := UTF8ToAnsi(AText);
{$ELSE}
Result := AnsiString(AText);
{$ENDIF}
end;
procedure TXLSWriter.CellStr(ARow, ACol: Word; const AValue: String);
var
TmpBytesLen: Cardinal;
TmpSizeOfFieldLen: Byte;
TmpStrExcel: AnsiString;
begin
(*
See:
- https://www.openoffice.org/sc/excelfileformat.pdf
"2.5.2 Byte Strings (BIFF2-BIFF5)" states all srings are byte strings
Strings to not have to include #0 terminator per protocol
*)
if AValue = '' then
exit;
TmpStrExcel := ConvertToCodePage(AValue); // To do for Delphi: Convert unicodestring to ansistring
TmpBytesLen := Length(TmpStrExcel);
//--
TmpSizeOfFieldLen := 1;
if (TmpBytesLen > 255) then
begin
TmpBytesLen := 255;
end
;
//--
WriteBIFFRecordHeader(LABEL_BIFF2, 2 + 2 + 3 + TmpSizeOfFieldLen + TmpBytesLen);
//--
WriteWord(ARow);
WriteWord(ACol);
//--
WriteByte(0);
WriteByte(0);
WriteByte(0);
//--
WriteByte(Byte(TmpBytesLen));
//--
DataStream.Write(TmpStrExcel[1], TmpBytesLen);
end;
procedure TXLSWriter.WriteByte(B: Byte);
begin
DataStream.Write(B, 1);
end;
procedure TXLSWriter.WriteWord(W: word);
begin
DataStream.Write(W, 2);
end;
procedure TXLSWriter.WriteEOF;
begin
(*
- https://www.openoffice.org/sc/excelfileformat.pdf#page=161&zoom=auto,113.9,540.2
5.37 - EOF - End of File
*)
WriteBIFFRecordHeader(BIFF_EOF, 0);
end;
procedure TXLSWriter.WriteCodePage;
var
W: Word;
begin
(*
https://www.openoffice.org/sc/excelfileformat.pdf#page=145&zoom=auto,113.9,771.1
- 5.17 CODEPAGE
*)
WriteBIFFRecordHeader($0042, 2); // $0042 = OPCODE CODEPAGE
W := 1252;
WriteWord(W);
end;
function BuildXLSFromStrArrs(const AStrArrs: TmyDynStringStringArray): TMemoryStream;
var
MR: Integer;
MC: Integer;
vxR: Integer;
vxC: Integer;
vxL: Word;
vxS: String;
vXLS: TXLSWriter;
begin
MR := Length(AStrArrs);
if MR > 0 then
MC := Length(AStrArrs[0])
else
MC := 0;
;
//--
//
//--
vXLS := TXLSWriter.Create;
vXLS.MaxRows := MR;
vXLS.MaxCols := MC;
//--
//
//--
vXLS.WriteBOF;
//vXLS.WriteCodePage; // Not absolutely necessary if you use strings of your code page
vXLS.WriteDimension;
//--
// TODO: Looking a specificaion, I may need to implement a row structure here
// --- wp: not absolutely necessary, only if you want to change row heights and add row formats
//--
for vxC := 0 to MC-1 do
begin
for vxR := 0 to MR-1 do
begin
vxS := AStrArrs[vxR,vxC];
vXLS.CellStr(vxR,vxC,vxS)
end;
end;
vXLS.WriteEOF;
vXLS.DataStream.Position := 0;
Result := TMemoryStream.Create;
Result.CopyFrom(vXLS.DataStream, vXLS.DataStream.Size);
Result.Position := 0;
vXLS.Free;
end;
var
memstream: TMemoryStream;
AStrArrs: TmyDynStringStringArray;
begin
SetLength(AStrArrs, 3);
SetLength(AStrArrs[0], 2);
SetLength(AStrArrs[1], 2);
SetLength(AStrArrs[2], 2);
AStrArrs[0, 0] := 'ÄÖÜ';
AStrArrs[1, 0] := 'B';
AStrArrs[2, 0] := 'C';
AStrArrs[0, 1] := 'D';
AStrArrs[1, 1] := 'E';
AStrArrs[2, 1] := 'F';
memstream := BuildXLSFromStrArrs(AStrArrs);
memstream.SaveToFile('d:\test.xls');
memstream.Free;
end.
Recent
