From 61a55feef82fff52052a7f0505e3cc967e8ac8bc Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 30 May 2015 22:09:53 +0000 Subject: [PATCH] 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. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4166 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../fpspreadsheet/fpsnumformatparser.pas | 34 ++-- components/fpspreadsheet/fpspalette.pas | 2 + components/fpspreadsheet/fpspreadsheet.pas | 1 - components/fpspreadsheet/fpstypes.pas | 8 +- .../tests/numformatparsertests.pas | 49 +++++- components/fpspreadsheet/xlsbiff2.pas | 163 +++++++++--------- components/fpspreadsheet/xlsbiff5.pas | 6 +- components/fpspreadsheet/xlsbiff8.pas | 90 +++++----- components/fpspreadsheet/xlscommon.pas | 34 ++-- 9 files changed, 221 insertions(+), 166 deletions(-) diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index 9709a1211..f869fe0b1 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -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; diff --git a/components/fpspreadsheet/fpspalette.pas b/components/fpspreadsheet/fpspalette.pas index 984b7e787..33d0a0686 100644 --- a/components/fpspreadsheet/fpspalette.pas +++ b/components/fpspreadsheet/fpspalette.pas @@ -94,6 +94,8 @@ begin SetLength(FColors, Length(FColors) + 1); FColors[High(FColors)] := AColor; + + Result := High(FColors); end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index bedc66915..f51567dd8 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -894,7 +894,6 @@ var numFmtParams: TsNumFormatParams; nfs: String; font: TsFont; - cb: TsCellBorder; begin Assert(AFromCell <> nil); Assert(AToCell <> nil); diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index c838b016f..5863c28bc 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -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; diff --git a/components/fpspreadsheet/tests/numformatparsertests.pas b/components/fpspreadsheet/tests/numformatparsertests.pas index cf0bf06e8..60acf1316 100644 --- a/components/fpspreadsheet/tests/numformatparsertests.pas +++ b/components/fpspreadsheet/tests/numformatparsertests.pas @@ -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; diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 41375fd80..ab4ea236f 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -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; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 0a7409963..61699fe17 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -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 diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index c91160227..9598dd528 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -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 -------------------------------------------------------------------------------} diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index aba75881c..473012b05 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -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.