From 1e5fa19f944166d7d9a153d3a52db60c495fd564 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 17 Jun 2014 09:06:34 +0000 Subject: [PATCH] fpspreadsheet: add support for writing currency formats to ods files. Fix "red" option for negative numbers. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3186 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/excel8demo/excel8write.lpr | 9 +- .../examples/opendocdemo/opendocwrite.lpr | 22 ++- .../fpspreadsheet/fpsnumformatparser.pas | 136 ++++++++++++++++-- components/fpspreadsheet/fpsopendocument.pas | 90 ++++++++++-- components/fpspreadsheet/fpspreadsheet.pas | 19 ++- components/fpspreadsheet/xlscommon.pas | 2 +- 6 files changed, 248 insertions(+), 30 deletions(-) diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr index 1ae1eea57..4752ff44b 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr @@ -44,6 +44,9 @@ begin MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1); MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines]; + + number := 10000; + (* { MyWorksheet.Options := MyWorksheet.Options + [soHasFrozenPanes]; myWorksheet.LeftPaneWidth := 1; @@ -307,12 +310,12 @@ begin MyWorksheet.WriteCurrency(r, 1, number, nfCurrency, 0, 'USD'); MyWorksheet.WriteCurrency(r, 2, -number, nfCurrency, 0, 'USD'); MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrency, 0, 'USD'); - inc(r); + inc(r); *) MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrencyRed, 0 decs'); MyWorksheet.WriteCurrency(r, 1, number, nfCurrencyRed, 0, 'USD'); MyWorksheet.WriteCurrency(r, 2, -number, nfCurrencyRed, 0, 'USD'); MyWorksheet.WriteCurrency(r, 3, 0.0, nfCurrencyRed, 0, 'USD'); - inc(r); + inc(r); (* MyWorksheet.WriteUTF8Text(r, 0, 'nfAccounting, 0 decs'); MyWorksheet.WriteCurrency(r, 1, number, nfAccounting, 0, 'USD'); MyWorksheet.WriteCurrency(r, 2, -number, nfAccounting, 0, 'USD'); @@ -413,7 +416,7 @@ begin MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth); MyWorksheet.WriteTextRotation(0, 0, rt90DegreeClockwiseRotation); MyWorksheet.WriteUsedFormatting(0, 1, [uffBold]); - + *) // Save the spreadsheet to a file MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel8, true); MyWorkbook.Free; diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr index 456151c2d..5c1843a2a 100644 --- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr +++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr @@ -36,7 +36,7 @@ begin MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet'); // Write some cells - MyWorksheet.WriteNumber(0, 0, 1.0);// A1 + //MyWorksheet.WriteNumber(0, 0, 1.0);// A1 MyWorksheet.WriteNumber(0, 1, 2.0);// B1 MyWorksheet.WriteNumber(0, 2, 3.0);// C1 MyWorksheet.WriteNumber(0, 3, 4.0);// D1 @@ -191,6 +191,26 @@ begin MyWorksheet.WriteNumber(row, 6, number6, nfSci, 2); MyWorksheet.WriteNumber(row, 7, number7, nfSci, 2); MyWorksheet.WriteNumber(row, 8, number8, nfSci, 2); + inc(row); + MyWorksheet.WriteUTF8Text(row, 0, 'nfCurrency, 2 decimals'); + MyWorksheet.WriteCurrency(row, 1, number1, nfCurrency, 2, '$'); + MyWorksheet.WriteCurrency(row, 2, number2, nfCurrency, 2, '$'); + MyWorksheet.WriteCurrency(row, 3, number3, nfCurrency, 2, '$'); + MyWorksheet.WriteCurrency(row, 4, number4, nfCurrency, 2, '$'); + MyWorksheet.WriteCurrency(row, 5, number5, nfCurrency, 2, '$'); + MyWorksheet.WriteCurrency(row, 6, number6, nfCurrency, 2, '$'); + MyWorksheet.WriteCurrency(row, 7, number7, nfCurrency, 2, '$'); + MyWorksheet.WriteCurrency(row, 8, number8, nfCurrency, 2, '$'); + inc(row); + MyWorksheet.WriteUTF8Text(row, 0, 'nfCurrencyRed, 2 decimals, +:$ 1000, -:($ 1000)'); + MyWorksheet.WriteCurrency(row, 1, number1, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + MyWorksheet.WriteCurrency(row, 2, number2, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + MyWorksheet.WriteCurrency(row, 3, number3, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + MyWorksheet.WriteCurrency(row, 4, number4, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + MyWorksheet.WriteCurrency(row, 5, number5, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + MyWorksheet.WriteCurrency(row, 6, number6, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + MyWorksheet.WriteCurrency(row, 7, number7, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); + MyWorksheet.WriteCurrency(row, 8, number8, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); // Creates a new worksheet MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2'); diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index 9775756e2..3e41667a7 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/components/fpspreadsheet/fpsnumformatparser.pas @@ -73,6 +73,7 @@ type FStart: PChar; FEnd: PChar; FCurrSection: Integer; + FHasRedSection: Boolean; FStatus: Integer; function GetCurrencySymbol: String; function GetDecimals: byte; @@ -126,13 +127,13 @@ type // NumberFormat procedure EvalNumFormatOfSection(ASection: Integer; out ANumFormat: TsNumberFormat; out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor); - function IsCurrencyAt(ASection, AIndex: Integer; out ANumFormat: TsNumberFormat; + function IsCurrencyAt(ASection: Integer; out ANumFormat: TsNumberFormat; out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor): Boolean; function IsDateAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; var ANextIndex: Integer): Boolean; function IsNumberAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; var ADecimals: Byte; var ANextIndex: Integer): Boolean; - function IsSciAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; + function IsSciAt(ASection, AIndex: Integer; var ANumberFormat: TsNumberFormat; var ADecimals: Byte; var ANextIndex: Integer): Boolean; function IsTextAt(AText: string; ASection, AIndex: Integer): Boolean; function IsTimeAt(ASection,AIndex: Integer; var ANumberFormat: TsNumberFormat; @@ -140,8 +141,10 @@ type function IsTokenAt(AToken: TsNumFormatToken; ASection,AIndex: Integer): Boolean; public - constructor Create(AWorkbook: TsWorkbook; const AFormatString: String); + constructor Create(AWorkbook: TsWorkbook; const AFormatString: String; + const ANumFormat: TsNumberFormat = nfGeneral); destructor Destroy; override; + procedure ClearAll; function GetDateTimeCode(ASection: Integer): String; function IsDateTimeFormat: Boolean; procedure LimitDecimals; @@ -170,19 +173,24 @@ const { TsNumFormatParser } { Creates a number format parser for analyzing a formatstring that has been read - from a spreadsheet file. } + from a spreadsheet file. + In case of "red" number formats we also have to specify the number format + because the format string might not contain the color information, and we + extract it from the NumFormat in this case. } constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook; - const AFormatString: String); + const AFormatString: String; const ANumFormat: TsNumberFormat = nfGeneral); begin inherited Create; FCreateMethod := 0; FWorkbook := AWorkbook; + FHasRedSection := (ANumFormat in [nfCurrencyRed, nfAccountingRed]); Parse(AFormatString); end; destructor TsNumFormatParser.Destroy; begin FSections := nil; +// ClearAll; inherited Destroy; end; @@ -295,8 +303,10 @@ function TsNumFormatParser.BuildFormatStringFromSection(ASection: Integer; var element: TsNumFormatElement; i: Integer; + colorAdded: Boolean; begin Result := ''; + colorAdded := false; if (ASection < 0) and (ASection >= GetParsedSectionCount) then exit; @@ -354,7 +364,7 @@ begin nftRepeat: if element.TextValue <> '' then Result := Result + '*' + element.TextValue; nftColor: - if ADialect = nfdExcel then + if ADialect = nfdExcel then begin case element.IntValue of scBlack : Result := '[black]'; scWhite : Result := '[white]'; @@ -366,8 +376,17 @@ begin scCyan : Result := '[cyan]'; else Result := Format('[Color%d]', [element.IntValue]); end; + colorAdded := true; + end; end; end; + { + if (ADialect = nfdExcel) + and (not colorAdded) and + (FSections[ASection].NumFormat in [nfCurrencyRed, nfAccountingRed]) + then + Result := '[red]'+Result; + } end; procedure TsNumFormatParser.CheckSections; @@ -459,6 +478,20 @@ begin ); end; +procedure TsNumFormatParser.ClearAll; +var + i, j: Integer; +begin + for i:=0 to Length(FSections)-1 do begin + for j:=0 to Length(FSections[i].Elements) do + if FSections[i].Elements <> nil then + FSections[i].Elements[j].TextValue := ''; + FSections[i].Elements := nil; + FSections[i].CurrencySymbol := ''; + end; + FSections := nil; +end; + procedure TsNumFormatParser.DeleteElement(ASection, AIndex: Integer); var i, n: Integer; @@ -562,15 +595,16 @@ begin exit; end; end; - // nfCurrency - if IsCurrencyAt(ASection, 0, ANumFormat, ADecimals, ACurrencySymbol, AColor) - then exit; end; // Look for scientific format if IsSciAt(ASection, 0, ANumFormat, ADecimals, next) then exit; + // Currency? + if IsCurrencyAt(ASection, ANumFormat, ADecimals, ACurrencySymbol, AColor) + then exit; + // Look for date formats if IsDateAt(ASection, 0, ANumFormat, next) then begin if (next = Length(Elements)) then @@ -658,11 +692,14 @@ begin Result := FSections[0].NumFormat; if (Result in [nfCurrency, nfAccounting]) then begin if Length(FSections) = 2 then begin + Result := FSections[1].NumFormat; if FSections[1].CurrencySymbol <> FSections[0].CurrencySymbol then begin Result := nfCustom; exit; end; - if (FSections[0].NumFormat = nfCurrency) and (FSections[1].NumFormat = nfCurrency) then + if (FSections[0].NumFormat in [nfCurrency, nfCurrencyRed]) and + (FSections[1].NumFormat in [nfCurrency, nfCurrencyRed]) + then exit; if FSections[1].NumFormat = nfAccounting then begin Result := nfAccounting; @@ -670,14 +707,16 @@ begin end; end else if Length(FSections) = 3 then begin + Result := FSections[1].NumFormat; if (FSections[0].CurrencySymbol <> FSections[1].CurrencySymbol) or (FSections[1].CurrencySymbol <> FSections[2].CurrencySymbol) then begin Result := nfCustom; exit; end; - if (FSections[0].NumFormat = nfCurrency) and (FSections[1].NumFormat = nfCurrency) and - (FSections[2].NumFormat = nfCurrency) + if (FSections[0].NumFormat in [nfCurrency, nfCurrencyRed]) and + (FSections[1].NumFormat in [nfCurrency, nfCurrencyRed]) and + (FSections[2].NumFormat in [nfCurrency, nfCurrencyRed]) then exit; if (FSections[1].NumFormat = nfAccounting) and @@ -709,13 +748,15 @@ end; the numberformat code, the count of decimals, the currency sambol, and the color. Note that the check is not very exact, but should cover most cases. } -function TsNumFormatParser.IsCurrencyAt(ASection, AIndex: Integer; +function TsNumFormatParser.IsCurrencyAt(ASection: Integer; out ANumFormat: TsNumberFormat; out ADecimals: byte; out ACurrencySymbol: String; out AColor: TsColor): Boolean; var isAccounting : Boolean; hasCurrSymbol: Boolean; + hasColor: Boolean; next: Integer; + el: Integer; begin Result := false; @@ -723,7 +764,75 @@ begin ACurrencySymbol := ''; ADecimals := 0; AColor := scNotDefined; + isAccounting := false; + hasColor := false; + // Looking for the currency symbol: it is the unique identifier of the + // currency format. + for el := 0 to High(FSections[ASection].Elements) do + if FSections[ASection].Elements[el].Token = nftCurrSymbol then begin + Result := true; + break; + end; + + if not Result then + exit; + + { When the format string comes from fpc it does not contain a color token. + Color would be lost when saving. Therefore, we take the color from the + knowledge of the NumFormat passed on creation: nfCurrencyRed has color red + in the second section! } + if (ASection = 1) and FHasRedSection then + AColor := scRed; + + // Now that we know that it is a currency format analyze the elements again + // and determine color, decimals and currency symbol. + el := 0; + while (el < Length(FSections[ASection].Elements)) do begin + case FSections[ASection].Elements[el].Token of + nftColor: + begin + AColor := FSections[ASection].Elements[el].IntValue; + hasColor := true; + end; + nftRepeat: + isAccounting := true; + nftCurrSymbol: + ACurrencySymbol := FSections[ASection].Elements[el].TextValue; + nftOptDigit: + if IsNumberAt(ASection, el, ANumFormat, ADecimals, el) then + dec(el) + else begin + Result := false; + exit; + end; + nftDigit: + if IsNumberAt(ASection, el, ANumFormat, ADecimals, el) then + dec(el) + else begin + Result := false; + exit; + end; + end; + inc(el); + end; + + if (ASection = 1) and FHasRedSection and not hasColor then + InsertElement(ASection, 0, nftColor, scRed); + + Result := hasCurrSymbol and ((ANumFormat = nfFixedTh) or (ASection = 2)); + if Result then begin + if isAccounting then begin + if AColor = scNotDefined then ANumFormat := nfAccounting else + if AColor = scRed then ANumFormat := nfAccountingRed; + end else begin + if AColor = scNotDefined then ANumFormat := nfCurrency else + if AColor = scRed then ANumFormat := nfCurrencyRed; + end; + end else + ANumFormat := nfCustom; + + (* if IsTokenAt(nftColor, ASection, AIndex) then begin AIndex := AIndex + 1; AColor := FSections[ASection].Elements[AIndex].IntValue; @@ -760,6 +869,7 @@ begin end; end else ANumFormat := nfCustom; + *) end; function TsNumFormatParser.IsDateAt(ASection,AIndex: Integer; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index c476e95c5..abadd4413 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -299,12 +299,14 @@ type procedure TsSpreadOpenDocNumFormatList.AddBuiltinFormats; begin AddFormat('N0', '', nfGeneral); + { AddFormat('N1', '0', nfFixed); AddFormat('N2', '0.00', nfFixed); AddFormat('N3', '#,##0', nfFixedTh); - AddFormat('N4', '#,##0.00', nfFixed); + AddFormat('N4', '#,##0.00', nfFixedTh); AddFormat('N10', '0%', nfPercentage); AddFormat('N11', '0.00%', nfPercentage); +} end; @@ -313,10 +315,14 @@ end; function TsSpreadOpenDocNumFormatParser.BuildXMLAsString(AIndent, AFormatName: String): String; var - i, ns: Integer; + i: Integer; begin Result := ''; - for i := Length(FSections)-1 downto 0 do + { When there is only one section the next statement is the only one executed. + When there are several sections the file contains at first the + positive section (index 0), then the negative section (index 1), and + finally the zero section (index 2) which contains the style-map. } + for i:=0 to Length(FSections)-1 do Result := Result + BuildXMLAsStringFromSection(i, AIndent, AFormatName); end; @@ -333,6 +339,8 @@ var ns: Integer; clr: TsColorvalue; el: Integer; + s: String; + begin Result := ''; sGrouping := ''; @@ -340,20 +348,23 @@ begin sStyleMap := ''; ns := Length(FSections); + if (ns = 0) then + exit; + if (ns > 1) then begin if (ASection = ns - 1) then case ns of 2: sStyleMap := AIndent + ' ' + LineEnding; // >= 0 + 'style:condition="value()>=0" />' + LineEnding; // >= 0 3: sStyleMap := AIndent + ' 0 - 'style:condition="value()>0" />' + LineEnding + AIndent + + 'style:condition="value()>0" />' + LineEnding + AIndent + ' ' + LineEnding; + 'style:condition="value()<0" />' + LineEnding; else raise Exception.Create('At most 3 format sections allowed.'); end @@ -427,14 +438,17 @@ begin end; end; - // nfSci: not supported by ods, use nfExp instead. + // If the program gets here the format can only be nfSci, nfCurrency/Accounting, + // or date/time. el := 0; decs := 0; while el < Length(Elements) do begin case Elements[el].Token of nftDecs: decs := Elements[el].IntValue; + nftExpChar: + // nfSci: not supported by ods, use nfExp instead. begin while el < Length(Elements) do begin if Elements[el].Token = nftExpDigits then begin @@ -453,6 +467,57 @@ begin end; exit; end; + + nftCurrSymbol: + begin + Result := AIndent + + '' + LineEnding; + el := 0; + while el < Length(Elements) do begin + case Elements[el].Token of + nftColor: + begin + clr := FWorkbook.GetPaletteColor(Elements[el].IntValue); + Result := Result + AIndent + + ' ' + LineEnding; + inc(el); + end; + nftSign, nftSignBracket: + begin + Result := Result + AIndent + + ' ' + Elements[el].TextValue + '' + LineEnding; + inc(el); + end; + nftSpace: + begin + Result := Result + AIndent + + ' ' + LineEnding; + inc(el); + end; + nftCurrSymbol: + begin + Result := Result + AIndent + + ' ' + Elements[el].TextValue + + '' + LineEnding; + inc(el); + end; + nftOptDigit: + if IsNumberAt(ASection, el, nf, decs, el) then + Result := Result + AIndent + + ' ' + + LineEnding; + nftDigit: + if IsNumberAt(ASection, el, nf, decs, el) then + Result := Result + AIndent + + ' ' + LineEnding; + else + inc(el); + end; // case + end; // while + Result := Result + sStyleMap + AIndent + '' + LineEnding; + end; end; inc(el); end; @@ -2096,9 +2161,10 @@ var lRowStylesCode: String; lNumFmtCode: String; begin + ListAllNumFormats; + ListAllFormattingStyles; ListAllColumnStyles; ListAllRowStyles; - ListAllFormattingStyles; lNumFmtCode := WriteNumFormatsXMLAsString; @@ -2347,10 +2413,10 @@ var parser: TsSpreadOpenDocNumFormatParser; begin Result := ''; - ListAllNumFormats; for i:=0 to FNumFormatList.Count-1 do begin fmtItem := FNumFormatList.Items[i]; - parser := TsSpreadOpenDocNumFormatParser.Create(Workbook, fmtItem.FormatString); + parser := TsSpreadOpenDocNumFormatParser.Create(Workbook, fmtItem.FormatString, + fmtItem.NumFormat); try numFmtXML := parser.BuildXMLAsString(' ', fmtItem.Name); if numFmtXML <> '' then @@ -2888,7 +2954,9 @@ begin lIndex := FindFormattingInList(ACell); lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" '; if pos('%', ACell^.NumberFormatStr) <> 0 then - valType := 'percentage'; + valType := 'percentage' + else if IsCurrencyFormat(ACell^.NumberFormat) then + valType := 'currency'; end else lStyle := ''; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index a8571f34b..91d4c6e6a 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -545,6 +545,7 @@ type function GetLastRowNumber: Cardinal; deprecated 'Use GetLastRowIndex'; { Data manipulation methods - For Rows and Cols } + function CalcAutoRowHeight(ARow: Cardinal): Single; function FindRow(ARow: Cardinal): PRow; function FindCol(ACol: Cardinal): PCol; function GetCellCountInRow(ARow: Cardinal): Cardinal; @@ -2505,6 +2506,22 @@ begin Result := FWorkbook.FormatSettings; end; +function TsWorksheet.CalcAutoRowHeight(ARow: Cardinal): Single; +var + cell: PCell; + fnt: TsFont; + col: Integer; + h0: Single; +begin + Result := 0; + h0 := Workbook.GetDefaultFontSize; + for col := 0 to GetLastColIndex do begin + cell := FindCell(ARow, col); + if cell <> nil then + Result := Max(Result, Workbook.GetFont(cell^.FontIndex).Size / h0); + end; +end; + function TsWorksheet.FindRow(ARow: Cardinal): PRow; var LElement: TRow; @@ -2614,7 +2631,7 @@ begin if row <> nil then Result := row^.Height else - Result := FWorkbook.DefaultRowHeight; + Result := CalcAutoRowHeight(ARow); //FWorkbook.DefaultRowHeight; end; procedure TsWorksheet.RemoveAllRows; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index a06bd19f8..bfcd614fe 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -764,7 +764,7 @@ var parser: TsNumFormatParser; fmt: String; begin - parser := TsNumFormatParser.Create(Workbook, AFormatString); + parser := TsNumFormatParser.Create(Workbook, AFormatString, ANumFormat); try if parser.Status = psOK then begin // For writing, we have to convert the fpc format string to Excel dialect