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);
// Format string
function BuildFormatString: String; virtual;
public
constructor Create(AWorkbook: TsWorkbook; const AFormatString: String);
destructor Destroy; override;
@ -155,8 +156,13 @@ end;
{ 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;
const AFormatString: String);
begin
@ -1331,9 +1337,11 @@ var
n, m: Integer;
el: Integer;
savedCurrent: PChar;
thSep: Char;
begin
hasDecSep := false;
isFrac := false;
thSep := ',';
while (FCurrent < FEnd) and (FStatus = psOK) do begin
case FToken of
',': AddElement(nftThSep, ',');
@ -1344,7 +1352,7 @@ begin
'#': begin
ScanAndCount('#', n);
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
m := 0;
FToken := NextToken;
@ -1352,34 +1360,34 @@ begin
case n of
0: begin
ScanAndCount('0', n);
ScanAndCount(',', m);
ScanAndCount(thSep, m);
FToken := prevToken;
if n = 3 then
AddElement(nftIntTh, 3)
AddElement(nftIntTh, 3, ',')
else
FCurrent := savedCurrent;
end;
1: begin
ScanAndCount('0', n);
ScanAndCount(',', m);
ScanAndCount(thSep, m);
FToken := prevToken;
if n = 2 then
AddElement(nftIntTh, 2)
AddElement(nftIntTh, 2, ',')
else
FCurrent := savedCurrent;
end;
2: begin
ScanAndCount('0', n);
ScanAndCount(',', m);
ScanAndCount(thSep, m);
FToken := prevToken;
if (n = 1) then
AddElement(nftIntTh, 1)
AddElement(nftIntTh, 1, ',')
else
FCurrent := savedCurrent;
end;
end;
if m > 0 then
AddElement(nftFactor, m);
AddElement(nftFactor, m, thSep);
end else
begin
FToken := PrevToken;
@ -1394,7 +1402,7 @@ begin
end;
'0': begin
ScanAndCount('0', n);
ScanAndCount(',', m);
ScanAndCount(thSep, m);
FToken := PrevToken;
if hasDecSep then
AddElement(nftZeroDecs, n)
@ -1404,14 +1412,14 @@ begin
else
AddElement(nftIntZeroDigit, n);
if m > 0 then
AddElement(nftFactor, m);
AddElement(nftFactor, m, thSep);
end;
'1'..'9':
begin
if isFrac then
begin
n := 0;
while (FToken in ['1'..'9','0']) do //and (FToken <= FEnd) do
while (FToken in ['1'..'9','0']) do
begin
n := n*10 + StrToInt(FToken);
FToken := nextToken;

2
components/fpspreadsheet/fpspalette.pas
View File

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

1
components/fpspreadsheet/fpspreadsheet.pas
View File

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

8
components/fpspreadsheet/fpstypes.pas
View File

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

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

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

163
components/fpspreadsheet/xlsbiff2.pas
View File

@ -84,6 +84,8 @@ type
FSheetIndex: Integer; // Index of worksheet to be written
procedure GetCellAttributes(ACell: PCell; XFIndex: Word;
out Attrib1, Attrib2, Attrib3: Byte);
procedure GetFormatAndFontIndex(AFormatRecord: PsCellFormat;
out AFormatIndex, AFontIndex: Integer);
{ Record writing methods }
procedure WriteBOF(AStream: TStream);
procedure WriteCellFormatting(AStream: TStream; ACell: PCell; XFIndex: Word);
@ -93,11 +95,10 @@ type
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFontIndex: Integer);
procedure WriteFonts(AStream: TStream);
procedure WriteFormatCount(AStream: TStream);
procedure WriteIXFE(AStream: TStream; XFIndex: Word);
protected
procedure AddBuiltinNumFormats; override;
procedure ListAllNumFormats; override;
// procedure ListAllNumFormats; override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
@ -105,12 +106,13 @@ type
procedure WriteCodePage(AStream: TStream; ACodePage: String); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
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;
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override;
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
AFormatIndex: Integer); override;
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
@ -159,7 +161,7 @@ var
implementation
uses
Math, fpsStrings, fpsReaderWriter, fpsPalette;
Math, fpsStrings, fpsReaderWriter, fpsPalette, fpsNumFormatParser;
const
{ Excel record IDs }
@ -269,9 +271,9 @@ begin
Add(BuildCurrencyFormatString(nfCurrencyRed, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 6
Add(BuildCurrencyFormatString(nfCurrency, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 7
Add(BuildCurrencyFormatString(nfCurrencyRed, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 8
Add('0%'); // 9
Add('0.00%'); // 10
Add('0.00E+00'); // 11
Add('0%'); // 9
Add('0.00%'); // 10
Add('0.00E+00'); // 11
Add(BuildDateTimeFormatString(nfShortDate, fs)); // 12
Add(BuildDateTimeFormatString(nfLongDate, fs)); // 13
Add(BuildDateTimeFormatString(nfDayMonth, fs)); // 14: 'd/mmm'
@ -442,14 +444,27 @@ var
len: byte;
fmtString: AnsiString;
nfs: String;
parser: TsNumFormatParser;
begin
// number format string
len := AStream.ReadByte;
SetLength(fmtString, 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);
{
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);
end;
@ -1016,6 +1031,7 @@ procedure TsSpreadBIFF2Writer.GetCellAttributes(ACell: PCell; XFIndex: Word;
out Attrib1, Attrib2, Attrib3: Byte);
var
fmt: PsCellFormat;
fontIdx, formatIdx: Integer;
begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
@ -1035,7 +1051,9 @@ begin
// 2nd byte:
// Mask $3F: Index to FORMAT record ("FORMAT" = number format!)
// 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
// Mask $07: horizontal alignment
@ -1057,6 +1075,32 @@ begin
Attrib3 := Attrib3 or $80;
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.
Unlike biff5+ no formats are added here because biff2 supports only 21
@ -1067,7 +1111,7 @@ procedure TsSpreadBIFF2Writer.ListAllNumFormats;
begin
// Nothing to do here.
end;
*)
{@@ ----------------------------------------------------------------------------
Attaches cell formatting data for the given cell to the current record.
Is called from all writing methods of cell contents.
@ -1374,23 +1418,18 @@ var
b: Byte;
j: Integer;
nfParams: TsNumFormatParams;
nfs: String;
formatIdx, fontIdx: Integer;
begin
Unused(XFType_Prot);
GetFormatAndFontIndex(AFormatRecord, formatIdx, fontIdx);
{ BIFF Record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_XF);
rec.RecordSize := WordToLE(SizeOf(TBIFF2_XFRecord) - 2*SizeOf(word));
{ Index to FONT record }
rec.FontIndex := 0;
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;
rec.FontIndex := WordToLE(fontIdx);
{ Not used byte }
rec.NotUsed := 0;
@ -1401,55 +1440,8 @@ begin
5-0 $3F Index to (number) FORMAT record
6 $40 1 = Cell is locked
7 $80 1 = Formula is hidden }
rec.NumFormatIndex_Flags := 0;
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...
end;
rec.NumFormatIndex_Flags := WordToLE(formatIdx);
// Cell flags not used, so far...
{Horizontal alignment, border style, and background
Bit Mask Contents
@ -1573,7 +1565,7 @@ end;
{@@ ----------------------------------------------------------------------------
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);
type
TNumFormatRecord = packed record
@ -1586,13 +1578,25 @@ var
s: ansistring;
rec: TNumFormatRecord;
buf: array of byte;
parser: TsNumFormatParser;
begin
Unused(ANumFormatStr);
//Unused(ANumFormatStr);
if (AFormatIndex = 0) then
{if (AFormatIndex = 0) then
s := 'General'
else
s := ConvertEncoding(NumFormatList[AFormatIndex], encodingUTF8, FCodePage);
else begin
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);
{ BIFF record header }
@ -1608,7 +1612,7 @@ begin
Move(s[1], buf[SizeOf(rec)], len*SizeOf(ansiChar));
{ Write out }
AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*len);
AStream.WriteBuffer(buf[0], SizeOf(rec) + SizeOf(ansiChar)*len);
{ Clean up }
SetLength(buf, 0);
@ -1616,12 +1620,15 @@ end;
{@@ ----------------------------------------------------------------------------
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
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;
{@@ ----------------------------------------------------------------------------

6
components/fpspreadsheet/xlsbiff5.pas
View File

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

90
components/fpspreadsheet/xlsbiff8.pas
View File

@ -132,6 +132,8 @@ type
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream);
procedure WriteFORMAT(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override;
procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); override;
procedure WriteHyperlink(AStream: TStream; AHyperlink: PsHyperlink;
AWorksheet: TsWorksheet);
@ -147,8 +149,6 @@ type
procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word);
procedure WriteMSODrawing3(AStream: TStream);
procedure WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word);
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
ANumFormatIndex: Integer); override;
procedure WriteOBJ(AStream: TStream; AObjID: Word);
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): word; override;
@ -2063,6 +2063,49 @@ begin
WriteFONT(AStream, Workbook.GetFont(i));
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
attached to a cell, but also for embedded shapes (currently not supported).
@ -2241,49 +2284,6 @@ begin
AStream.WriteByte(0); // Unused
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
-------------------------------------------------------------------------------}

34
components/fpspreadsheet/xlscommon.pas
View File

@ -481,6 +481,9 @@ type
// Writes out ERROR cell record
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
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
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
@ -488,9 +491,6 @@ type
procedure WriteHeaderFooter(AStream: TStream; AIsHeader: Boolean); virtual;
// Writes out page margin for printing
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
procedure WriteNumFormats(AStream: TStream);
// Writes out a floating point NUMBER record
@ -2655,19 +2655,6 @@ begin
AStream.WriteBuffer(dbl, SizeOf(dbl));
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
FirstFormatIndexInFile.
@ -2685,13 +2672,26 @@ begin
parser := TsNumFormatParser.Create(Workbook, fmtStr);
try
fmtStr := parser.FormatString;
WriteNumFormat(AStream, fmtStr, i);
WriteFORMAT(AStream, fmtStr, i);
finally
parser.Free;
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.
Note: The formula is already stored in the cell.