pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Release restriction on max 21 numberformats for writing biff2 files; extra formats not read correctly by Excel although I know from Office97 that there can be more than 21 formats in a biff2 file. Add some more unit tests for number format parser.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4166 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-05-30 22:09:53 +00:00
parent dc32996691
commit 61a55feef8
9 changed files with 221 additions and 166 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -90,6 +90,7 @@ type
procedure FixMonthMinuteToken(var ASection: TsNumFormatSection); procedure FixMonthMinuteToken(var ASection: TsNumFormatSection);
// Format string // Format string
function BuildFormatString: String; virtual; function BuildFormatString: String; virtual;
public public
constructor Create(AWorkbook: TsWorkbook; const AFormatString: String); constructor Create(AWorkbook: TsWorkbook; const AFormatString: String);
destructor Destroy; override; destructor Destroy; override;
@ -155,8 +156,13 @@ end;
{ TsNumFormatParser } { TsNumFormatParser }
{@@ Creates a number format parser for analyzing a formatstring that has been {@@ ----------------------------------------------------------------------------
read from a spreadsheet file. } Creates a number format parser for analyzing a formatstring that has been
read from a spreadsheet file.
If ALocalized is true then the formatstring contains localized decimal
separator etc.
-------------------------------------------------------------------------------}
constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook; constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook;
const AFormatString: String); const AFormatString: String);
begin begin
@ -1331,9 +1337,11 @@ var
n, m: Integer; n, m: Integer;
el: Integer; el: Integer;
savedCurrent: PChar; savedCurrent: PChar;
thSep: Char;
begin begin
hasDecSep := false; hasDecSep := false;
isFrac := false; isFrac := false;
thSep := ',';
while (FCurrent < FEnd) and (FStatus = psOK) do begin while (FCurrent < FEnd) and (FStatus = psOK) do begin
case FToken of case FToken of
',': AddElement(nftThSep, ','); ',': AddElement(nftThSep, ',');
@ -1344,7 +1352,7 @@ begin
'#': begin '#': begin
ScanAndCount('#', n); ScanAndCount('#', n);
savedCurrent := FCurrent; savedCurrent := FCurrent;
if not (hasDecSep or isFrac) and (n = 1) and (FToken = ',') then if not (hasDecSep or isFrac) and (n = 1) and (FToken = thSep) then
begin begin
m := 0; m := 0;
FToken := NextToken; FToken := NextToken;
@ -1352,34 +1360,34 @@ begin
case n of case n of
0: begin 0: begin
ScanAndCount('0', n); ScanAndCount('0', n);
ScanAndCount(',', m); ScanAndCount(thSep, m);
FToken := prevToken; FToken := prevToken;
if n = 3 then if n = 3 then
AddElement(nftIntTh, 3) AddElement(nftIntTh, 3, ',')
else else
FCurrent := savedCurrent; FCurrent := savedCurrent;
end; end;
1: begin 1: begin
ScanAndCount('0', n); ScanAndCount('0', n);
ScanAndCount(',', m); ScanAndCount(thSep, m);
FToken := prevToken; FToken := prevToken;
if n = 2 then if n = 2 then
AddElement(nftIntTh, 2) AddElement(nftIntTh, 2, ',')
else else
FCurrent := savedCurrent; FCurrent := savedCurrent;
end; end;
2: begin 2: begin
ScanAndCount('0', n); ScanAndCount('0', n);
ScanAndCount(',', m); ScanAndCount(thSep, m);
FToken := prevToken; FToken := prevToken;
if (n = 1) then if (n = 1) then
AddElement(nftIntTh, 1) AddElement(nftIntTh, 1, ',')
else else
FCurrent := savedCurrent; FCurrent := savedCurrent;
end; end;
end; end;
if m > 0 then if m > 0 then
AddElement(nftFactor, m); AddElement(nftFactor, m, thSep);
end else end else
begin begin
FToken := PrevToken; FToken := PrevToken;
@ -1394,7 +1402,7 @@ begin
end; end;
'0': begin '0': begin
ScanAndCount('0', n); ScanAndCount('0', n);
ScanAndCount(',', m); ScanAndCount(thSep, m);
FToken := PrevToken; FToken := PrevToken;
if hasDecSep then if hasDecSep then
AddElement(nftZeroDecs, n) AddElement(nftZeroDecs, n)
@ -1404,14 +1412,14 @@ begin
else else
AddElement(nftIntZeroDigit, n); AddElement(nftIntZeroDigit, n);
if m > 0 then if m > 0 then
AddElement(nftFactor, m); AddElement(nftFactor, m, thSep);
end; end;
'1'..'9': '1'..'9':
begin begin
if isFrac then if isFrac then
begin begin
n := 0; n := 0;
while (FToken in ['1'..'9','0']) do //and (FToken <= FEnd) do while (FToken in ['1'..'9','0']) do
begin begin
n := n*10 + StrToInt(FToken); n := n*10 + StrToInt(FToken);
FToken := nextToken; FToken := nextToken;

2
components/fpspreadsheet/fpspalette.pas
View File

@ -94,6 +94,8 @@ begin
SetLength(FColors, Length(FColors) + 1); SetLength(FColors, Length(FColors) + 1);
FColors[High(FColors)] := AColor; FColors[High(FColors)] := AColor;
Result := High(FColors);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------

1
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -894,7 +894,6 @@ var
numFmtParams: TsNumFormatParams; numFmtParams: TsNumFormatParams;
nfs: String; nfs: String;
font: TsFont; font: TsFont;
cb: TsCellBorder;
begin begin
Assert(AFromCell <> nil); Assert(AFromCell <> nil);
Assert(AToCell <> nil); Assert(AToCell <> nil);

8
components/fpspreadsheet/fpstypes.pas
View File

@ -991,10 +991,8 @@ begin
2: Result := Result + '#,#00'; 2: Result := Result + '#,#00';
3: Result := Result + '#,000'; 3: Result := Result + '#,000';
end; end;
nftDecSep: nftDecSep, nftThSep:
Result := Result + '.'; Result := Result + element.TextValue;
nftThSep:
Result := Result + ',';
nftFracSymbol: nftFracSymbol:
Result := Result + '/'; Result := Result + '/';
nftPercent: nftPercent:
@ -1005,7 +1003,7 @@ begin
n := element.IntValue; n := element.IntValue;
while (n > 0) do while (n > 0) do
begin begin
Result := Result + ','; Result := Result + element.TextValue;
dec(n); dec(n);
end; end;
end; end;

49
components/fpspreadsheet/tests/numformatparsertests.pas
View File

@ -7,8 +7,8 @@ interface
uses uses
// Not using Lazarus package as the user may be working with multiple versions // Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path // Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry, Classes, SysUtils, fpcunit, testregistry,
fpstypes, fpsallformats, fpspreadsheet, fpsnumformatparser, xlsbiff8 fpstypes, fpspreadsheet, fpsnumformatparser
{and a project requirement for lclbase for utf8 handling}, {and a project requirement for lclbase for utf8 handling},
testsutility; testsutility;
@ -23,10 +23,11 @@ type
SollNumeratorDigits: Integer; SollNumeratorDigits: Integer;
SollDenominatorDigits: Integer; SollDenominatorDigits: Integer;
SollCurrencySymbol: String; SollCurrencySymbol: String;
SollSection2Color: TsColor;
end; end;
var var
ParserTestData: Array[0..10] of TParserTestData; ParserTestData: Array[0..13] of TParserTestData;
procedure InitParserTestData; procedure InitParserTestData;
@ -151,8 +152,21 @@ begin
SollNumeratorDigits := 0; SollNumeratorDigits := 0;
SollDenominatorDigits := 0; SollDenominatorDigits := 0;
SollCurrencySymbol := '€'; SollCurrencySymbol := '€';
SollSection2Color := scBlack;
end; end;
with ParserTestData[9] do begin with ParserTestData[9] do begin
FormatString := '[$€] #,##0.00;[red]-[$€] #,##0.00;[$€] 0.00';
SollFormatString := '[$€] #,##0.00;[red]-[$€] #,##0.00;[$€] 0.00';
SollNumFormat := nfCurrencyRed;
SollSectionCount := 3;
SollDecimals := 2;
SollFactor := 0;
SollNumeratorDigits := 0;
SollDenominatorDigits := 0;
SollCurrencySymbol := '€';
SollSection2Color := scRed;
end;
with ParserTestData[10] do begin
FormatString := '0.00,,'; FormatString := '0.00,,';
SollFormatString := '0.00,,'; SollFormatString := '0.00,,';
SollNumFormat := nfCustom; SollNumFormat := nfCustom;
@ -163,7 +177,7 @@ begin
SollDenominatorDigits := 0; SollDenominatorDigits := 0;
SollCurrencySymbol := ''; SollCurrencySymbol := '';
end; end;
with ParserTestData[10] do begin with ParserTestData[11] do begin
FormatString := '# ??/??'; FormatString := '# ??/??';
SollFormatString := '# ??/??'; SollFormatString := '# ??/??';
SollNumFormat := nfFraction; SollNumFormat := nfFraction;
@ -174,6 +188,30 @@ begin
SollDenominatorDigits := 2; SollDenominatorDigits := 2;
SollCurrencySymbol := ''; SollCurrencySymbol := '';
end; end;
with ParserTestData[12] do begin
FormatString := 'General;[Red]-General';
SollFormatString := 'General;[red]-General';
SollNumFormat := nfCustom;
SollSectionCount := 2;
SollDecimals := 0;
SollFactor := 0;
SollNumeratorDigits := 0;
SollDenominatorDigits := 0;
SollCurrencySymbol := '';
SollSection2Color := scRed;
end;
with ParserTestData[13] do begin
FormatString := 'General';
SollFormatString := 'General';
SollNumFormat := nfGeneral;
SollSectionCount := 1;
SollDecimals := 0;
SollFactor := 0;
SollNumeratorDigits := 0;
SollDenominatorDigits := 0;
SollCurrencySymbol := '';
end;
{ {
with ParserTestData[5] do begin with ParserTestData[5] do begin
FormatString := '#,##0.00 "$";-#,##0.00 "$";-'; FormatString := '#,##0.00 "$";-#,##0.00 "$";-';
@ -241,6 +279,9 @@ begin
'Test format (' + ParserTestData[i].FormatString + ') numerator digits mismatch'); 'Test format (' + ParserTestData[i].FormatString + ') numerator digits mismatch');
CheckEquals(ParserTestData[i].SollDenominatorDigits, parser.ParsedSections[0].FracDenominator, CheckEquals(ParserTestData[i].SollDenominatorDigits, parser.ParsedSections[0].FracDenominator,
'Test format (' + ParserTestData[i].FormatString + ') denominator digits mismatch'); 'Test format (' + ParserTestData[i].FormatString + ') denominator digits mismatch');
if ParserTestData[i].SollSectionCount > 1 then
CheckEquals(ParserTestData[i].SollSection2Color, parser.ParsedSections[1].Color,
'Test format (' + ParserTestData[i].FormatString + ') section 2 color mismatch');
finally finally
parser.Free; parser.Free;
end; end;

155
components/fpspreadsheet/xlsbiff2.pas
View File

@ -84,6 +84,8 @@ type
FSheetIndex: Integer; // Index of worksheet to be written FSheetIndex: Integer; // Index of worksheet to be written
procedure GetCellAttributes(ACell: PCell; XFIndex: Word; procedure GetCellAttributes(ACell: PCell; XFIndex: Word;
out Attrib1, Attrib2, Attrib3: Byte); out Attrib1, Attrib2, Attrib3: Byte);
procedure GetFormatAndFontIndex(AFormatRecord: PsCellFormat;
out AFormatIndex, AFontIndex: Integer);
{ Record writing methods } { Record writing methods }
procedure WriteBOF(AStream: TStream); procedure WriteBOF(AStream: TStream);
procedure WriteCellFormatting(AStream: TStream; ACell: PCell; XFIndex: Word); procedure WriteCellFormatting(AStream: TStream; ACell: PCell; XFIndex: Word);
@ -93,11 +95,10 @@ type
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFontIndex: Integer); procedure WriteFont(AStream: TStream; AFontIndex: Integer);
procedure WriteFonts(AStream: TStream); procedure WriteFonts(AStream: TStream);
procedure WriteFormatCount(AStream: TStream);
procedure WriteIXFE(AStream: TStream; XFIndex: Word); procedure WriteIXFE(AStream: TStream; XFIndex: Word);
protected protected
procedure AddBuiltinNumFormats; override; procedure AddBuiltinNumFormats; override;
procedure ListAllNumFormats; override; // procedure ListAllNumFormats; override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
@ -105,12 +106,13 @@ type
procedure WriteCodePage(AStream: TStream; ACodePage: String); override; procedure WriteCodePage(AStream: TStream; ACodePage: String); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override; const AValue: TsErrorValue; ACell: PCell); override;
procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String;
AFormatIndex: Integer); override;
procedure WriteFORMATCOUNT(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override; const AValue: double; ACell: PCell); override;
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
AFormatIndex: Integer); override;
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet; procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override; ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
@ -159,7 +161,7 @@ var
implementation implementation
uses uses
Math, fpsStrings, fpsReaderWriter, fpsPalette; Math, fpsStrings, fpsReaderWriter, fpsPalette, fpsNumFormatParser;
const const
{ Excel record IDs } { Excel record IDs }
@ -442,14 +444,27 @@ var
len: byte; len: byte;
fmtString: AnsiString; fmtString: AnsiString;
nfs: String; nfs: String;
parser: TsNumFormatParser;
begin begin
// number format string // number format string
len := AStream.ReadByte; len := AStream.ReadByte;
SetLength(fmtString, len); SetLength(fmtString, len);
AStream.ReadBuffer(fmtString[1], len); AStream.ReadBuffer(fmtString[1], len);
// Add to the end of the list. // We need the format string as utf8 and non-localized
nfs := ConvertEncoding(fmtString, FCodePage, encodingUTF8); nfs := ConvertEncoding(fmtString, FCodePage, encodingUTF8);
{
if not SameText(nfs, 'General') then
begin
parser := TsNumFormatParser.Create(FWorkbook, nfs, true);
try
nfs := parser.FormatString;
finally
parser.Free;
end;
end;
}
// Add to the end of the list.
NumFormatList.Add(nfs); NumFormatList.Add(nfs);
end; end;
@ -1016,6 +1031,7 @@ procedure TsSpreadBIFF2Writer.GetCellAttributes(ACell: PCell; XFIndex: Word;
out Attrib1, Attrib2, Attrib3: Byte); out Attrib1, Attrib2, Attrib3: Byte);
var var
fmt: PsCellFormat; fmt: PsCellFormat;
fontIdx, formatIdx: Integer;
begin begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
@ -1035,7 +1051,9 @@ begin
// 2nd byte: // 2nd byte:
// Mask $3F: Index to FORMAT record ("FORMAT" = number format!) // Mask $3F: Index to FORMAT record ("FORMAT" = number format!)
// Mask $C0: Index to FONT record // Mask $C0: Index to FONT record
Attrib2 := fmt^.FontIndex shr 6; GetFormatAndFontIndex(fmt, formatIdx, fontIdx);
Attrib2 := formatIdx + fontIdx shr 6;
// Attrib2 := fmt^.FontIndex shr 6;
// 3rd byte // 3rd byte
// Mask $07: horizontal alignment // Mask $07: horizontal alignment
@ -1057,6 +1075,32 @@ begin
Attrib3 := Attrib3 or $80; Attrib3 := Attrib3 or $80;
end; end;
procedure TsSpreadBIFF2Writer.GetFormatAndFontIndex(AFormatRecord: PsCellFormat;
out AFormatIndex, AFontIndex: Integer);
var
nfparams: TsNumFormatParams;
nfs: String;
begin
{ Index to FORMAT record }
AFormatIndex := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then
begin
nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex);
nfs := nfParams.NumFormatStr;
AFormatIndex := NumFormatList.IndexOf(nfs);
if AFormatIndex = -1 then AFormatIndex := 0;
end;
{ Index to FONT record }
AFontIndex := 0;
if (AFormatRecord <> nil) and (uffFont in AFormatRecord^.UsedFormattingFields) then
begin
AFontIndex := AFormatRecord^.FontIndex;
if AFontIndex >= 4 then inc(AFontIndex); // Font #4 does not exist in BIFF
end;
end;
(*
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Builds up the list of number formats to be written to the biff2 file. Builds up the list of number formats to be written to the biff2 file.
Unlike biff5+ no formats are added here because biff2 supports only 21 Unlike biff5+ no formats are added here because biff2 supports only 21
@ -1067,7 +1111,7 @@ procedure TsSpreadBIFF2Writer.ListAllNumFormats;
begin begin
// Nothing to do here. // Nothing to do here.
end; end;
*)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Attaches cell formatting data for the given cell to the current record. Attaches cell formatting data for the given cell to the current record.
Is called from all writing methods of cell contents. Is called from all writing methods of cell contents.
@ -1374,23 +1418,18 @@ var
b: Byte; b: Byte;
j: Integer; j: Integer;
nfParams: TsNumFormatParams; nfParams: TsNumFormatParams;
nfs: String;
formatIdx, fontIdx: Integer;
begin begin
Unused(XFType_Prot); Unused(XFType_Prot);
GetFormatAndFontIndex(AFormatRecord, formatIdx, fontIdx);
{ BIFF Record header } { BIFF Record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_XF); rec.RecordID := WordToLE(INT_EXCEL_ID_XF);
rec.RecordSize := WordToLE(SizeOf(TBIFF2_XFRecord) - 2*SizeOf(word)); rec.RecordSize := WordToLE(SizeOf(TBIFF2_XFRecord) - 2*SizeOf(word));
{ Index to FONT record } { Index to FONT record }
rec.FontIndex := 0; rec.FontIndex := WordToLE(fontIdx);
if (AFormatRecord <> nil) then
begin
if (uffFont in AFormatRecord^.UsedFormattingFields) then
begin
rec.FontIndex := AFormatRecord^.FontIndex;
if rec.FontIndex >= 4 then inc(rec.FontIndex); // Font #4 does not exist in BIFF
end;
end;
{ Not used byte } { Not used byte }
rec.NotUsed := 0; rec.NotUsed := 0;
@ -1401,55 +1440,8 @@ begin
5-0 $3F Index to (number) FORMAT record 5-0 $3F Index to (number) FORMAT record
6 $40 1 = Cell is locked 6 $40 1 = Cell is locked
7 $80 1 = Formula is hidden } 7 $80 1 = Formula is hidden }
rec.NumFormatIndex_Flags := 0; rec.NumFormatIndex_Flags := WordToLE(formatIdx);
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then
begin
nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex);
if nfParams <> nil then
case nfParams.NumFormat of
nfGeneral:
j := 0;
nfFixed:
j := IfThen(nfParams.Sections[0].Decimals = 0, 1, 2);
nfFixedTh:
j := IfThen(nfParams.Sections[0].Decimals = 0, 3, 4);
nfCurrency:
j := IfThen(nfParams.Sections[0].Decimals = 0, 5, 7);
nfCurrencyRed:
j := IfThen(nfParams.Sections[0].Decimals = 0, 6, 8);
nfPercentage:
j := IfThen(nfParams.Sections[0].Decimals = 0, 9, 10);
nfExp:
j := 11;
nfShortDate:
j := 12;
nfLongDate:
j := 13;
nfDayMonth:
j := 14;
nfMonthYear:
j := 15;
nfShortTimeAM:
j := 16;
nfLongTimeAM:
j := 17;
nfShortTime:
j := 18;
nfLongTime:
j := 19;
nfShortDateTime:
j := 20;
// Not available in BIFF2
nfFraction:
j := 0;
nfTimeInterval:
j := 19;
nfCustom:
j := 0;
end;
rec.NumFormatIndex_Flags := j;
// Cell flags not used, so far... // Cell flags not used, so far...
end;
{Horizontal alignment, border style, and background {Horizontal alignment, border style, and background
Bit Mask Contents Bit Mask Contents
@ -1573,7 +1565,7 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes an Excel 2 FORMAT record which describes formatting of numerical data. Writes an Excel 2 FORMAT record which describes formatting of numerical data.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBiff2Writer.WriteNumFormat(AStream: TStream; procedure TsSpreadBiff2Writer.WriteFORMAT(AStream: TStream;
ANumFormatStr: String; AFormatIndex: Integer); ANumFormatStr: String; AFormatIndex: Integer);
type type
TNumFormatRecord = packed record TNumFormatRecord = packed record
@ -1586,13 +1578,25 @@ var
s: ansistring; s: ansistring;
rec: TNumFormatRecord; rec: TNumFormatRecord;
buf: array of byte; buf: array of byte;
parser: TsNumFormatParser;
begin begin
Unused(ANumFormatStr); //Unused(ANumFormatStr);
if (AFormatIndex = 0) then {if (AFormatIndex = 0) then
s := 'General' s := 'General'
else else begin
s := ConvertEncoding(NumFormatList[AFormatIndex], encodingUTF8, FCodePage); parser := TsNumFormatParser.Create(FWorkbook, NumFormatList[AFormatIndex]);
try
parser.Localize;
s := parser.FormatString;
s := ConvertEncoding(s, encodingUTF8, FCodePage);
finally
parser.Free;
end;
end;
}
// s := ConvertEncoding(NumFormatList[AFormatIndex], encodingUTF8, FCodePage);
s := ConvertEncoding(ANumFormatStr, encodingUTF8, FCodePage);
len := Length(s); len := Length(s);
{ BIFF record header } { BIFF record header }
@ -1608,7 +1612,7 @@ begin
Move(s[1], buf[SizeOf(rec)], len*SizeOf(ansiChar)); Move(s[1], buf[SizeOf(rec)], len*SizeOf(ansiChar));
{ Write out } { Write out }
AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*len); AStream.WriteBuffer(buf[0], SizeOf(rec) + SizeOf(ansiChar)*len);
{ Clean up } { Clean up }
SetLength(buf, 0); SetLength(buf, 0);
@ -1616,12 +1620,15 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes the number of FORMAT records contained in the file. Writes the number of FORMAT records contained in the file.
Excel 2 supports only 21 FORMAT records.
There are 21 built-in formats. The file may contain more, but Excel
expects a "21" here...
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteFormatCount(AStream: TStream); procedure TsSpreadBIFF2Writer.WriteFORMATCOUNT(AStream: TStream);
begin begin
WriteBiffHeader(AStream, INT_EXCEL_ID_FORMATCOUNT, 2); WriteBiffHeader(AStream, INT_EXCEL_ID_FORMATCOUNT, 2);
AStream.WriteWord(WordToLE(21)); // there are 21 built-in formats AStream.WriteWord(WordToLE(21));
// AStream.WriteWord(WordToLE(NumFormatList.Count));
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------

6
components/fpspreadsheet/xlsbiff5.pas
View File

@ -106,11 +106,11 @@ type
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont); procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream); procedure WriteFonts(AStream: TStream);
procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override;
procedure WriteIndex(AStream: TStream); procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteStyle(AStream: TStream); procedure WriteStyle(AStream: TStream);
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -1272,7 +1272,7 @@ end;
Writes an Excel 5 FORMAT record which is needed for formatting of numerical Writes an Excel 5 FORMAT record which is needed for formatting of numerical
data. data.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBiff5Writer.WriteNumFormat(AStream: TStream; procedure TsSpreadBiff5Writer.WriteFORMAT(AStream: TStream;
ANumFormatStr: String; ANumFormatIndex: Integer); ANumFormatStr: String; ANumFormatIndex: Integer);
type type
TNumFormatRecord = packed record TNumFormatRecord = packed record

90
components/fpspreadsheet/xlsbiff8.pas
View File

@ -132,6 +132,8 @@ type
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont); procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream); procedure WriteFonts(AStream: TStream);
procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override;
procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); override; procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); override;
procedure WriteHyperlink(AStream: TStream; AHyperlink: PsHyperlink; procedure WriteHyperlink(AStream: TStream; AHyperlink: PsHyperlink;
AWorksheet: TsWorksheet); AWorksheet: TsWorksheet);
@ -147,8 +149,6 @@ type
procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word); procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word);
procedure WriteMSODrawing3(AStream: TStream); procedure WriteMSODrawing3(AStream: TStream);
procedure WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word); procedure WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word);
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override;
procedure WriteOBJ(AStream: TStream; AObjID: Word); procedure WriteOBJ(AStream: TStream; AObjID: Word);
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal; function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): word; override; AFlags: TsRelFlags): word; override;
@ -2063,6 +2063,49 @@ begin
WriteFONT(AStream, Workbook.GetFont(i)); WriteFONT(AStream, Workbook.GetFont(i));
end; end;
procedure TsSpreadBiff8Writer.WriteFORMAT(AStream: TStream;
ANumFormatStr: String; ANumFormatIndex: Integer);
type
TNumFormatRecord = packed record
RecordID: Word;
RecordSize: Word;
FormatIndex: Word;
FormatStringLen: Word;
FormatStringFlags: Byte;
end;
var
len: Integer;
ws: widestring;
rec: TNumFormatRecord;
buf: array of byte;
begin
ws := UTF8Decode(ANumFormatStr);
len := Length(ws);
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_FORMAT);
rec.RecordSize := WordToLE(2 + 2 + 1 + len * SizeOf(WideChar));
{ Format index }
rec.FormatIndex := WordToLE(ANumFormatIndex);
{ Format string }
{ - length of string = 16 bits }
rec.FormatStringLen := WordToLE(len);
{ - Widestring flags, 1 = regular unicode LE string }
rec.FormatStringFlags := 1;
{ - Copy the text characters into a buffer immediately after rec }
SetLength(buf, SizeOf(rec) + SizeOf(WideChar)*len);
Move(rec, buf[0], SizeOf(rec));
Move(ws[1], buf[SizeOf(rec)], len*SizeOf(WideChar));
{ Write out }
AStream.WriteBuffer(buf[0], SizeOf(rec) + SizeOf(WideChar)*len);
{ Clean up }
SetLength(buf, 0);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes the first MSODRAWING record to file. It is needed for a comment Writes the first MSODRAWING record to file. It is needed for a comment
attached to a cell, but also for embedded shapes (currently not supported). attached to a cell, but also for embedded shapes (currently not supported).
@ -2241,49 +2284,6 @@ begin
AStream.WriteByte(0); // Unused AStream.WriteByte(0); // Unused
end; end;
procedure TsSpreadBiff8Writer.WriteNumFormat(AStream: TStream;
ANumFormatStr: String; ANumFormatIndex: Integer);
type
TNumFormatRecord = packed record
RecordID: Word;
RecordSize: Word;
FormatIndex: Word;
FormatStringLen: Word;
FormatStringFlags: Byte;
end;
var
len: Integer;
ws: widestring;
rec: TNumFormatRecord;
buf: array of byte;
begin
ws := UTF8Decode(ANumFormatStr);
len := Length(ws);
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_FORMAT);
rec.RecordSize := WordToLE(2 + 2 + 1 + len * SizeOf(WideChar));
{ Format index }
rec.FormatIndex := WordToLE(ANumFormatIndex);
{ Format string }
{ - length of string = 16 bits }
rec.FormatStringLen := WordToLE(len);
{ - Widestring flags, 1 = regular unicode LE string }
rec.FormatStringFlags := 1;
{ - Copy the text characters into a buffer immediately after rec }
SetLength(buf, SizeOf(rec) + SizeOf(WideChar)*len);
Move(rec, buf[0], SizeOf(rec));
Move(ws[1], buf[SizeOf(rec)], len*SizeOf(WideChar));
{ Write out }
AStream.WriteBuffer(buf[0], SizeOf(rec) + SizeOf(WideChar)*len);
{ Clean up }
SetLength(buf, 0);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes an OBJ record - belongs to the records required for cell comments Writes an OBJ record - belongs to the records required for cell comments
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}

34
components/fpspreadsheet/xlscommon.pas
View File

@ -481,6 +481,9 @@ type
// Writes out ERROR cell record // Writes out ERROR cell record
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override; const AValue: TsErrorValue; ACell: PCell); override;
// Writes out a FORMAT record
procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); virtual;
// Writes out a FORMULA record; formula is stored in cell already // Writes out a FORMULA record; formula is stored in cell already
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
@ -488,9 +491,6 @@ type
procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); virtual; procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); virtual;
// Writes out page margin for printing // Writes out page margin for printing
procedure WriteMARGIN(AStream: TStream; AMargin: Integer); procedure WriteMARGIN(AStream: TStream; AMargin: Integer);
// Writes out a FORMAT record
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); virtual;
// Writes out all FORMAT records // Writes out all FORMAT records
procedure WriteNumFormats(AStream: TStream); procedure WriteNumFormats(AStream: TStream);
// Writes out a floating point NUMBER record // Writes out a floating point NUMBER record
@ -2655,19 +2655,6 @@ begin
AStream.WriteBuffer(dbl, SizeOf(dbl)); AStream.WriteBuffer(dbl, SizeOf(dbl));
end; end;
{@@ ----------------------------------------------------------------------------
Writes a BIFF number format record defined in the specified format string
(in Excel dialect).
AFormatIndex is equal to the format index used in the Excel file.
Needs to be overridden by descendants.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteNumFormat(AStream: TStream;
ANumFormatStr: String; ANumFormatIndex: Integer);
begin
Unused(AStream, ANumFormatStr, ANumFormatIndex);
// needs to be overridden
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes all number formats to the stream. Saving starts at the item with the Writes all number formats to the stream. Saving starts at the item with the
FirstFormatIndexInFile. FirstFormatIndexInFile.
@ -2685,13 +2672,26 @@ begin
parser := TsNumFormatParser.Create(Workbook, fmtStr); parser := TsNumFormatParser.Create(Workbook, fmtStr);
try try
fmtStr := parser.FormatString; fmtStr := parser.FormatString;
WriteNumFormat(AStream, fmtStr, i); WriteFORMAT(AStream, fmtStr, i);
finally finally
parser.Free; parser.Free;
end; end;
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Writes a BIFF number format record defined in the specified format string
(in Excel dialect).
AFormatIndex is equal to the format index used in the Excel file.
Needs to be overridden by descendants.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteFORMAT(AStream: TStream;
ANumFormatStr: String; ANumFormatIndex: Integer);
begin
Unused(AStream, ANumFormatStr, ANumFormatIndex);
// needs to be overridden
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes an Excel FORMULA record. Writes an Excel FORMULA record.
Note: The formula is already stored in the cell. Note: The formula is already stored in the cell.