From 7f7d07f151b87c7d2f95392b9b156add60ea0bec Mon Sep 17 00:00:00 2001 From: bigchimp Date: Sun, 22 Dec 2013 14:02:04 +0000 Subject: [PATCH] + Add support for text/number/date formats in BIFF8/xls. + Add support for writing out date/time to non-BIFF8 xls (though as text only for now) Slightly modified patch by wp, thanks a lot. See http://forum.lazarus.freepascal.org/index.php/topic,22940.msg136761.html#msg136761 Still to do: add test cases for invalid format strings git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2863 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/excel2demo/excel2write.lpr | 5 +- .../examples/excel5demo/excel5write.lpr | 12 +- .../examples/excel8demo/excel8write.lpr | 64 +++- .../examples/ooxmldemo/ooxmlwrite.lpr | 5 +- .../examples/opendocdemo/opendocwrite.lpr | 1 + components/fpspreadsheet/fpsopendocument.pas | 11 + components/fpspreadsheet/fpspreadsheet.pas | 201 ++++++++-- components/fpspreadsheet/tests/datetests.pas | 344 +++++++++++++++++- .../fpspreadsheet/tests/formattests.pas | 225 ++++++++++++ .../fpspreadsheet/tests/manualtests.pas | 2 +- .../fpspreadsheet/tests/numberstests.pas | 58 ++- .../fpspreadsheet/tests/spreadtestcli.lpr | 2 +- .../fpspreadsheet/tests/spreadtestgui.lpi | 18 +- .../fpspreadsheet/tests/spreadtestgui.lpr | 2 +- .../fpspreadsheet/tests/stringtests.pas | 45 ++- components/fpspreadsheet/tests/testbiff8.xls | Bin 16896 -> 39936 bytes .../fpspreadsheet/tests/testbiff8_1899.xls | Bin 9728 -> 31232 bytes components/fpspreadsheet/xlsbiff2.pas | 16 + components/fpspreadsheet/xlsbiff5.pas | 15 + components/fpspreadsheet/xlsbiff8.pas | 231 +++++++++--- components/fpspreadsheet/xlscommon.pas | 233 +++++++++++- components/fpspreadsheet/xlsxooxml.pas | 11 + 22 files changed, 1402 insertions(+), 99 deletions(-) create mode 100644 components/fpspreadsheet/tests/formattests.pas diff --git a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr index 7f5c692f0..09c279c48 100644 --- a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr +++ b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr @@ -55,8 +55,11 @@ begin MyWorksheet.WriteUTF8Text(1, 2, 'Third'); MyWorksheet.WriteUTF8Text(1, 3, 'Fourth'); + // Write current date/time + MyWorksheet.WriteDateTime(2, 0, now); + // Save the spreadsheet to a file - MyWorkbook.WriteToFile(MyDir + 'test' + STR_EXCEL_EXTENSION, sfExcel2); + MyWorkbook.WriteToFile(MyDir + 'test' + STR_EXCEL_EXTENSION, sfExcel2, true); MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr index f8e55b209..e259271d0 100644 --- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr +++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr @@ -10,8 +10,7 @@ program excel5write; {$mode delphi}{$H+} uses - Classes, SysUtils, fpspreadsheet, xlsbiff5, - laz_fpspreadsheet, fpsconvencoding; + Classes, SysUtils, fpspreadsheet, xlsbiff5; const Str_First = 'First'; @@ -40,9 +39,12 @@ begin MyWorksheet.WriteNumber(0, 2, 3.0);// C1 MyWorksheet.WriteNumber(0, 3, 4.0);// D1 MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5 - MyWorksheet.WriteNumber(4, 3, 10); // D5 + MyWorksheet.WriteNumber(4, 3, 10); // D5 -{ Uncommend this to test large XLS files + // Write current date/time + MyWorksheet.WriteDateTime(5, 0, now); + +{ Uncomment this to test large XLS files for i := 2 to 20 do begin MyWorksheet.WriteAnsiText(i, 0, ParamStr(0)); @@ -83,7 +85,7 @@ begin MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth); // Save the spreadsheet to a file - MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel5, False); + MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel5, true); MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr index 247ddf4f9..4eb10de41 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr @@ -28,6 +28,7 @@ var MyDir: string; i: Integer; lCell: PCell; + number: Double; begin MyDir := ExtractFilePath(ParamStr(0)); @@ -41,7 +42,7 @@ begin MyWorksheet.WriteNumber(0, 2, 3.0);// C1 MyWorksheet.WriteNumber(0, 3, 4.0);// D1 MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5 - MyWorksheet.WriteNumber(4, 3, 10); // D5 + MyWorksheet.WriteNumber(4, 3, 10); // D5 // D6 number with background color MyWorksheet.WriteNumber(5, 3, 10); @@ -49,7 +50,7 @@ begin lCell^.BackgroundColor := scPURPLE; lCell^.UsedFormattingFields := [uffBackgroundColor]; -{ Uncommend this to test large XLS files +{ Uncomment this to test large XLS files for i := 2 to 20 do begin MyWorksheet.WriteAnsiText(i, 0, ParamStr(0)); @@ -80,6 +81,63 @@ begin //MyFormula.FormulaStr := ''; + // Write current date/time to cells B11:B16 + MyWorksheet.WriteUTF8Text(10, 0, 'nfShortDate'); + MyWorksheet.WriteDateTime(10, 1, now, nfShortDate); + MyWorksheet.WriteUTF8Text(11, 0, 'nfShortTime'); + MyWorksheet.WriteDateTime(11, 1, now, nfShortTime); + MyWorksheet.WriteUTF8Text(12, 0, 'nfLongTime'); + MyWorksheet.WriteDateTime(12, 1, now, nfLongTime); + MyWorksheet.WriteUTF8Text(13, 0, 'nfShortDateTime'); + MyWorksheet.WriteDateTime(13, 1, now, nfShortDateTime); + MyWorksheet.WriteUTF8Text(14, 0, 'nfFmtDateTime, DM'); + MyWorksheet.WriteDateTime(14, 1, now, nfFmtDateTime, 'DM'); + MyWorksheet.WriteUTF8Text(15, 0, 'nfFmtDateTime, MY'); + MyWorksheet.WriteDateTime(15, 1, now, nfFmtDateTime, 'MY'); + MyWorksheet.WriteUTF8Text(16, 0, 'nfShortTimeAM'); + MyWorksheet.WriteDateTime(16, 1, now, nfShortTimeAM); + MyWorksheet.WriteUTF8Text(17, 0, 'nfLongTimeAM'); + MyWorksheet.WriteDateTime(17, 1, now, nfLongTimeAM); + MyWorksheet.WriteUTF8Text(18, 0, 'nfFmtDateTime, MS'); + MyWorksheet.WriteDateTime(18, 1, now, nfFmtDateTime, 'MS'); + MyWorksheet.WriteUTF8Text(19, 0, 'nfFmtDateTime, MSZ'); + MyWorksheet.WriteDateTime(19, 1, now, nfFmtDateTime, 'MSZ'); + + // Write formatted numbers + number := 12345.67890123456789; + MyWorksheet.WriteUTF8Text(24, 1, '12345.67890123456789'); + MyWorksheet.WriteUTF8Text(24, 2, '-12345.67890123456789'); + MyWorksheet.WriteUTF8Text(25, 0, 'nfFixed, 0 decs'); + MyWorksheet.WriteNumber(25, 1, number, nfFixed, 0); + MyWorksheet.WriteNumber(25, 2, -number, nfFixed, 0); + MyWorksheet.WriteUTF8Text(26, 0, 'nfFixed, 2 decs'); + MyWorksheet.WriteNumber(26, 1, number, nfFixed, 2); + MyWorksheet.WriteNumber(26, 2, -number, nfFixed, 2); + MyWorksheet.WriteUTF8Text(27, 0, 'nfFixedTh, 0 decs'); + MyWorksheet.WriteNumber(27, 1, number, nfFixedTh, 0); + MyWorksheet.WriteNumber(27, 2, -number, nfFixedTh, 0); + MyWorksheet.WriteUTF8Text(28, 0, 'nfFixedTh, 2 decs'); + MyWorksheet.WriteNumber(28, 1, number, nfFixedTh, 2); + MyWorksheet.WriteNumber(28, 2, -number, nfFixedTh, 2); + MyWorksheet.WriteUTF8Text(29, 0, 'nfSci, 1 dec'); + MyWorksheet.WriteNumber(29, 1, number, nfSci); + MyWorksheet.WriteNumber(29, 2, -number, nfSci); + MyWorksheet.WriteNumber(29, 3, 1.0/number, nfSci); + MyWorksheet.WriteNumber(29, 4, -1.0/number, nfSci); + MyWorksheet.WriteUTF8Text(30, 0, 'nfExp, 2 decs'); + MyWorksheet.WriteNumber(30, 1, number, nfExp, 2); + MyWorksheet.WriteNumber(30, 2, -number, nfExp, 2); + MyWorksheet.WriteNumber(30, 3, 1.0/number, nfExp, 2); + MyWorksheet.WriteNumber(30, 4, -1.0/number, nfExp, 2); + + number := 1.333333333; + MyWorksheet.WriteUTF8Text(35, 0, 'nfPercent, 0 decs'); + MyWorksheet.WriteNumber(35, 1, number, nfPercent, 0); + MyWorksheet.WriteUTF8Text(36, 0, 'nfPercent, 2 decs'); + MyWorksheet.WriteNumber(36, 1, number, nfPercent, 2); + MyWorksheet.WriteUTF8Text(37, 0, 'nfTimeInterval'); + MyWorksheet.WriteDateTime(37, 1, number, nfTimeInterval); + // Creates a new worksheet MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2); @@ -92,7 +150,7 @@ begin MyWorksheet.WriteUsedFormatting(0, 1, [uffBold]); // Save the spreadsheet to a file - MyWorkbook.WriteToFile(MyDir + 'test2.xls', sfExcel8, False); + MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel8, true); MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr index 35c000716..9f455347a 100644 --- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr +++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr @@ -33,7 +33,7 @@ begin MyWorksheet.WriteNumber(0, 2, 3.0); MyWorksheet.WriteNumber(0, 3, 4.0); -// Uncommend this to test large XLS files +// Uncomment this to test large XLS files for i := 2 to 2{20} do begin MyWorksheet.WriteUTF8Text(i, 0, ParamStr(0)); @@ -61,6 +61,9 @@ begin MyWorksheet.WriteUTF8Text(0, 2, 'Third'); MyWorksheet.WriteUTF8Text(0, 3, 'Fourth'); + // Write current date/time + MyWorksheet.WriteDateTime(0, 5, now); + // Save the spreadsheet to a file MyWorkbook.WriteToFile(MyDir + 'test.xlsx', sfOOXML); MyWorkbook.Free; diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr index 19752efe6..23885550b 100644 --- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr +++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr @@ -31,6 +31,7 @@ begin MyWorksheet.WriteNumber(0, 3, 4.0);// D1 MyWorksheet.WriteUTF8Text(4, 2, 'Total:');// C5 MyWorksheet.WriteNumber(4, 3, 10); // D5 + MyWorksheet.WriteDateTime(5, 0, now); // Add some formatting MyWorksheet.WriteUsedFormatting(0, 0, [uffBold]); diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index d8b27f5ee..bb6d56446 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -89,6 +89,7 @@ type procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); override; 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 WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; end; implementation @@ -709,6 +710,16 @@ begin ' ' + LineEnding; end; +{ + Writes the date/time as a text to the sheet. + Currently, no formatting code is written. +} +procedure TsSpreadOpenDocWriter.WriteDateTime(AStream: TStream; + const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); +begin + WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell); +end; + { Registers this reader / writer on fpSpreadsheet } diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 8ad39045b..962f83321 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -102,7 +102,9 @@ type enough to be able to read/write date values. } - TsNumberFormat = (nfGeneral, nfShortDate, nfShortDateTime); + TsNumberFormat = (nfGeneral, nfFixed, nfFixedTh, nfExp, nfSci, nfPercentage, + nfShortDateTime, nfFmtDateTime, nfShortDate, nfShortTime, nfLongTime, + nfShortTimeAM, nfLongTimeAM, nfTimeInterval); {@@ Text rotation formatting. The text is rotated relative to the standard orientation, which is from left to right horizontal: ---> @@ -187,6 +189,8 @@ type Border: TsCellBorders; BackgroundColor: TsColor; NumberFormat: TsNumberFormat; + NumberFormatStr: String; + NumberDecimals: Word; RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR end; @@ -242,8 +246,10 @@ type function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; procedure RemoveAllCells; procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); - procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double); - procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime); + procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double; + AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2); + procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; + AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula); procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat); procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula); @@ -378,10 +384,14 @@ procedure RegisterSpreadFormat( AWriterClass: TsSpreadWriterClass; AFormat: TsSpreadsheetFormat); +function SciFloat(AValue: Double; ADecimals: Word): String; +function TimeIntervalToString(AValue: TDateTime): String; + + implementation uses - Math; + Math, StrUtils; var { Translatable strings } @@ -405,6 +415,51 @@ begin GsSpreadFormats[len].Format := AFormat; end; +{@@ + Formats the number AValue in "scientific" format with the given number of + decimals. "Scientific" is the same as "exponential", but with exponents rounded + to multiples of 3. +} +function SciFloat(AValue: Double; ADecimals: Word): String; +var + m: Double; + ex: Integer; +begin + if AValue = 0 then + Result := '0.0' + else begin + ex := floor(log10(abs(AValue))); // exponent + // round exponent to multiples of 3 + ex := (ex div 3) * 3; + if ex < 0 then dec(ex, 3); + m := AValue * Power(10, -ex); // mantisse + Result := Format('%.*fE%d', [ADecimals, m, ex]); + end; +end; + +{@@ + Formats the number AValue as a time string with hours, minutes and seconds. + Unlike TimeToStr there can be more than 24 hours. +} +function TimeIntervalToString(AValue: TDateTime): String; +var + hrs: Integer; + diff: Double; + h,m,s,z: Word; + ts: String; +begin + ts := DefaultFormatSettings.TimeSeparator; + DecodeTime(frac(abs(AValue)), h, m, s, z); + hrs := h + trunc(abs(AValue))*24; + if z > 499 then inc(s); + if hrs > 0 then + Result := Format('%d%s%.2d%s%.2d', [hrs, ts, m, ts, s]) + else + Result := Format('%d%s%.2d', [m, ts, s]); + if AValue < 0.0 then Result := '-' + Result; +end; + + { TsWorksheet } {@@ @@ -673,12 +728,42 @@ end; @return The text representation of the cell } function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring; + + function FloatToStrNoNaN(const Value: Double; + ANumberFormat: TsNumberFormat; ANumberFormatStr: ansistring): ansistring; + begin + if IsNan(Value) then + Result := '' + else + if ANumberFormat = nfSci then + Result := SciFloat(Value, 1) + else + if (ANumberFormat = nfGeneral) or (ANumberFormatStr = '') then + Result := FloatToStr(Value) + else + if (ANumberFormat = nfPercentage) then + Result := FormatFloat(ANumberFormatStr, Value*100) + '%' + else + Result := FormatFloat(ANumberFormatStr, Value); + end; + + function DateTimeToStrNoNaN(const Value: Double; + ANumberFormat: TsNumberFormat; ANumberFormatStr: String): ansistring; + begin + Result := ''; + if not IsNaN(Value) then begin + if ANumberFormat = nfTimeInterval then + Result := TimeIntervalToString(Value) + else + if ANumberFormatStr = '' then + Result := FormatDateTime('c', Value) + else + Result := FormatDateTime(ANumberFormatStr, Value); + end; + end; + var ACell: PCell; - function FloatToStrNoNaN(const Value: Double): ansistring; - begin - if IsNan(Value) then Result:='' else Result:=FloatToStr(Value); - end; begin ACell := FindCell(ARow, ACol); @@ -690,17 +775,9 @@ begin case ACell^.ContentType of //cctFormula - cctNumber: Result := FloatToStrNoNaN(ACell^.NumberValue); + cctNumber: Result := FloatToStrNoNaN(ACell^.NumberValue, ACell^.NumberFormat, ACell^.NumberFormatStr); cctUTF8String: Result := ACell^.UTF8StringValue; - cctDateTime: - begin - Result := SysUtils.DateToStr(ACell^.DateTimeValue); - // User can have specified custom date/time format or one of the other built - // in formats that include time. We can't parse all of them so just return - // time as well unless absolutely sure we only want a date - if ACell^.NumberFormat<>nfShortDate then - Result := Result+' ' + SysUtils.TimeToStr(ACell^.DateTimeValue); - end; + cctDateTime: Result := DateTimeToStrNoNaN(ACell^.DateTimeValue, ACell^.NumberFormat, ACell^.NumberFormatStr); else Result := ''; end; @@ -839,35 +916,63 @@ end; @param ARow The row of the cell @param ACol The column of the cell @param ANumber The number to be written + @param AFormat The format identifier, e.g. nfFixed (optional) + @param ADecimals The number of decimals used for formatting (optional) } -procedure TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double); +procedure TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double; + AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2); var ACell: PCell; + decs: String; begin ACell := GetCell(ARow, ACol); ACell^.ContentType := cctNumber; ACell^.NumberValue := ANumber; + ACell^.NumberDecimals := ADecimals; + if AFormat <> nfGeneral then begin + Include(ACell^.UsedFormattingFields, uffNumberFormat); + ACell^.NumberFormat := AFormat; + decs := DupeString('0', ADecimals); + if ADecimals > 0 then decs := '.' + decs; + case AFormat of + nfFixed: + ACell^.NumberFormatStr := '0' + decs; + nfFixedTh: + ACell^.NumberFormatStr := '#,##0' + decs; + nfExp: + ACell^.NumberFormatStr := '0' + decs + 'E+00'; + nfSci: + ACell^.NumberFormatStr := ''; + nfPercentage: + ACell^.NumberFormatStr := '0' + decs; + end; + end; end; {@@ Writes a date/time value to a determined cell - @param ARow The row of the cell - @param ACol The column of the cell - @param AValue The date/time/datetime to be written + @param ARow The row of the cell + @param ACol The column of the cell + @param AValue The date/time/datetime to be written + @param AFormat The format specifier, e.g. nfShortDate (optional) + @param AFormatStr Format string, used only for nfFmtDateTime. + Must follow the rules for "FormatDateTime", or use + "dm" as abbreviation for "d/mmm", "my" for "mmm/yy", + "ms" for "nn:ss", "msz" for "nn:ss.z" (optional) Note: at least Excel xls does not recognize a separate datetime cell type: a datetime is stored as a (floating point) Number, and the cell is formatted as a date (either built-in or a custom format). - This procedure automatically sets the cell format to short date/time. You may - change this format to another date/time format, but changing it to another - format (e.g. General) will likely lead to the cell being written out as a - plain number. + + Note: custom formats are currently not supported by the writer. } -procedure TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime); +procedure TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; + AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); var ACell: PCell; + fmt: String; begin ACell := GetCell(ARow, ACol); @@ -876,11 +981,32 @@ begin // Date/time is actually a number field in Excel. // To make sure it gets saved correctly, set a date format (instead of General). // The user can choose another date format if he wants to - if not(uffNumberFormat in ACell^.UsedFormattingFields) or - ((uffNumberFormat in ACell^.UsedFormattingFields) and (ACell^.NumberFormat = nfGeneral)) then - begin - Include(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormat := nfShortDateTime; + Include(ACell^.UsedFormattingFields, uffNumberFormat); + ACell^.NumberFormat := AFormat; + case AFormat of + nfShortDateTime: + ACell^.NumberFormatStr := FormatSettings.ShortDateFormat + ' ' + FormatSettings.ShortTimeFormat; + nfShortDate: + ACell^.NumberFormatStr := FormatSettings.ShortDateFormat; + nfShortTime: + ACell^.NumberFormatStr := 't'; + nfLongTime: + ACell^.NumberFormatStr := 'tt'; + nfShortTimeAM: + ACell^.NumberFormatStr := 't am/pm'; + nfLongTimeAM: + ACell^.NumberFormatStr := 'tt am/pm'; + nfFmtDateTime: + begin + fmt := lowercase(AFormatStr); + if fmt = 'dm' then ACell^.NumberFormatStr := 'd/mmm' + else if fmt = 'my' then ACell^.NumberFormatSTr := 'mmm/yy' + else if fmt = 'ms' then ACell^.NumberFormatStr := 'nn:ss' + else if fmt = 'msz' then ACell^.NumberFormatStr := 'nn:ss.z' + else ACell^.NumberFormatStr := AFormatStr; + end; + nfTimeInterval: + ACell^.NumberFormatStr := ''; end; end; @@ -1503,8 +1629,16 @@ begin if uffBackgroundColor in AFormat^.UsedFormattingFields then if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue; - if uffNumberFormat in AFormat^.UsedFormattingFields then + if uffNumberFormat in AFormat^.UsedFormattingFields then begin if (FFormattingStyles[i].NumberFormat <> AFormat^.NumberFormat) then Continue; + case AFormat^.NumberFormat of + nfFixed, nfFixedTh, nfPercentage, nfExp: + if (FFormattingStyles[i].NumberDecimals <> AFormat^.NumberDecimals) then Continue; + nfShortDate, nfShortDateTime, nfShortTime, nfLongTime, nfShortTimeAM, + nfLongTimeAM, nfFmtDateTime, nfTimeInterval: + if (FFormattingstyles[i].NumberFormatStr <> AFormat^.NumberFormatStr) then Continue; + end; + end; // If we arrived here it means that the styles match Exit(i); @@ -1735,6 +1869,7 @@ begin // Silently dump the formula; child classes should implement their own support end; + finalization SetLength(GsSpreadFormats, 0); diff --git a/components/fpspreadsheet/tests/datetests.pas b/components/fpspreadsheet/tests/datetests.pas index b565b702a..186e21c84 100644 --- a/components/fpspreadsheet/tests/datetests.pas +++ b/components/fpspreadsheet/tests/datetests.pas @@ -22,7 +22,7 @@ uses var // Norm to test against - list of dates/times that should occur in spreadsheet - SollDates: array[0..11] of TDateTime; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;) + SollDates: array[0..37] of TDateTime; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;) // Initializes Soll*/normative variables. // Useful in test setup procedures to make sure the norm is correct. procedure InitSollDates; @@ -53,6 +53,32 @@ type procedure TestReadDate9; procedure TestReadDate10; procedure TestReadDate11; + procedure TestReadDate12; + procedure TestReadDate13; + procedure TestReadDate14; + procedure TestReadDate15; + procedure TestReadDate16; + procedure TestReadDate17; + procedure TestReadDate18; + procedure TestReadDate19; + procedure TestReadDate20; + procedure TestReadDate21; + procedure TestReadDate22; + procedure TestReadDate23; + procedure TestReadDate24; + procedure TestReadDate25; + procedure TestReadDate26; + procedure TestReadDate27; + procedure TestReadDate28; + procedure TestReadDate29; + procedure TestReadDate30; + procedure TestReadDate31; + procedure TestReadDate32; + procedure TestReadDate33; + procedure TestReadDate34; + procedure TestReadDate35; + procedure TestReadDate36; + procedure TestReadDate37; procedure TestReadDate1899_0; //same as above except with the 1899/1900 date system set procedure TestReadDate1899_1; procedure TestReadDate1899_2; @@ -65,6 +91,32 @@ type procedure TestReadDate1899_9; procedure TestReadDate1899_10; procedure TestReadDate1899_11; + procedure TestReadDate1899_12; + procedure TestReadDate1899_13; + procedure TestReadDate1899_14; + procedure TestReadDate1899_15; + procedure TestReadDate1899_16; + procedure TestReadDate1899_17; + procedure TestReadDate1899_18; + procedure TestReadDate1899_19; + procedure TestReadDate1899_20; + procedure TestReadDate1899_21; + procedure TestReadDate1899_22; + procedure TestReadDate1899_23; + procedure TestReadDate1899_24; + procedure TestReadDate1899_25; + procedure TestReadDate1899_26; + procedure TestReadDate1899_27; + procedure TestReadDate1899_28; + procedure TestReadDate1899_29; + procedure TestReadDate1899_30; + procedure TestReadDate1899_31; + procedure TestReadDate1899_32; + procedure TestReadDate1899_33; + procedure TestReadDate1899_34; + procedure TestReadDate1899_35; + procedure TestReadDate1899_36; + procedure TestReadDate1899_37; end; { TSpreadWriteReadDateTests } @@ -109,6 +161,36 @@ begin SollDates[9]:=EncodeTime(18,0,0,0); SollDates[10]:=EncodeTime(23,59,0,0); SollDates[11]:=EncodeTime(23,59,59,0); + + SollDates[12]:=SollDates[1]; // #1 formatted as nfShortDateTime + SollDates[13]:=SollDates[1]; // #1 formatted as nfShortTime + SollDates[14]:=SollDates[1]; // #1 formatted as nfLongTime + SollDates[15]:=SollDates[1]; // #1 formatted as nfShortTimeAM + SollDates[16]:=SollDates[1]; // #1 formatted as nfLongTimeAM + SollDates[17]:=SollDates[1]; // #1 formatted as nfFmtDateTime dm + SollDates[18]:=SollDates[1]; // #1 formatted as nfFmtDateTime my + SollDates[19]:=SollDates[1]; // #1 formatted as nfFmtDateTime ms + + SollDates[20]:=SollDates[5]; // #5 formatted as nfShortDateTime + SollDates[21]:=SollDates[5]; // #5 formatted as nfShortTime + SollDates[22]:=SollDates[5]; // #5 formatted as nfLongTime + SollDates[23]:=SollDates[5]; // #5 formatted as nfShortTimeAM + SollDates[24]:=SollDates[5]; // #5 formatted as nfLongTimeAM + SollDates[25]:=SollDates[5]; // #5 formatted as nfFmtDateTime dm + SollDates[26]:=SollDates[5]; // #5 formatted as nfFmtDateTime my + SollDates[27]:=SollDates[5]; // #5 formatted as nfFmtDateTime ms + + SollDates[28]:=SollDates[11]; // #11 formatted as nfShortDateTime + SollDates[29]:=SollDates[11]; // #11 formatted as nfShortTime + SollDates[30]:=SollDates[11]; // #11 formatted as nfLongTime + SollDates[31]:=SollDates[11]; // #11 formatted as nfShortTimeAM + SollDates[32]:=SollDates[11]; // #11 formatted as nfLongTimeAM + SollDates[33]:=SollDates[11]; // #11 formatted as nfFmtDateTime dm + SollDates[34]:=SollDates[11]; // #11 formatted as nfFmtDateTime my + SollDates[35]:=SollDates[11]; // #11 formatted as nfFmtDateTime ms + + SollDates[36]:=EncodeTime(3,45,12,0); // formatted as nfTimeDuration + SollDates[37]:=EncodeTime(3,45,12,0) + 1 // formatted as nfTimeDuration end; { TSpreadWriteReadDateTests } @@ -270,6 +352,136 @@ begin TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,11); end; +procedure TSpreadReadDateTests.TestReadDate12; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,12); +end; + +procedure TSpreadReadDateTests.TestReadDate13; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,13); +end; + +procedure TSpreadReadDateTests.TestReadDate14; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,14); +end; + +procedure TSpreadReadDateTests.TestReadDate15; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,15); +end; + +procedure TSpreadReadDateTests.TestReadDate16; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,16); +end; + +procedure TSpreadReadDateTests.TestReadDate17; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,17); +end; + +procedure TSpreadReadDateTests.TestReadDate18; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,18); +end; + +procedure TSpreadReadDateTests.TestReadDate19; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,19); +end; + +procedure TSpreadReadDateTests.TestReadDate20; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,20); +end; + +procedure TSpreadReadDateTests.TestReadDate21; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,21); +end; + +procedure TSpreadReadDateTests.TestReadDate22; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,22); +end; + +procedure TSpreadReadDateTests.TestReadDate23; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,23); +end; + +procedure TSpreadReadDateTests.TestReadDate24; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,24); +end; + +procedure TSpreadReadDateTests.TestReadDate25; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,25); +end; + +procedure TSpreadReadDateTests.TestReadDate26; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,26); +end; + +procedure TSpreadReadDateTests.TestReadDate27; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,27); +end; + +procedure TSpreadReadDateTests.TestReadDate28; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,28); +end; + +procedure TSpreadReadDateTests.TestReadDate29; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,29); +end; + +procedure TSpreadReadDateTests.TestReadDate30; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,30); +end; + +procedure TSpreadReadDateTests.TestReadDate31; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,31); +end; + +procedure TSpreadReadDateTests.TestReadDate32; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,32); +end; + +procedure TSpreadReadDateTests.TestReadDate33; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,33); +end; + +procedure TSpreadReadDateTests.TestReadDate34; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,34); +end; + +procedure TSpreadReadDateTests.TestReadDate35; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,35); +end; + +procedure TSpreadReadDateTests.TestReadDate36; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,36); +end; + +procedure TSpreadReadDateTests.TestReadDate37; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,37); +end; + procedure TSpreadReadDateTests.TestReadDate1899_0; begin TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,0); @@ -330,6 +542,136 @@ begin TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,11); end; +procedure TSpreadReadDateTests.TestReadDate1899_12; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,12); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_13; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,13); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_14; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,14); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_15; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,15); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_16; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,16); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_17; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,17); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_18; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,18); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_19; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,19); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_20; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,20); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_21; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,21); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_22; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,22); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_23; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,23); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_24; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,24); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_25; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,25); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_26; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,26); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_27; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,27); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_28; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,28); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_29; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,29); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_30; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,30); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_31; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,31); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_32; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,32); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_33; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,33); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_34; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,34); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_35; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,35); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_36; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,36); +end; + +procedure TSpreadReadDateTests.TestReadDate1899_37; +begin + TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,37); +end; + initialization // Register so these tests are included in a full run diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas new file mode 100644 index 000000000..084804c8b --- /dev/null +++ b/components/fpspreadsheet/tests/formattests.pas @@ -0,0 +1,225 @@ +unit formattests; + +{$mode objfpc}{$H+} + +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, + fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling}, + testsutility; + +var + // Norm to test against - list of strings that should occur in spreadsheet + SollNumberStrings: array[0..6, 0..8] of string; + SollNumbers: array[0..6] of Double; + SollNumberFormats: array[0..8] of TsNumberFormat; + SollNumberDecimals: array[0..8] of word; + + SollDateTimeStrings: array[0..4, 0..9] of string; + SollDateTimes: array[0..4] of TDateTime; + SollDateTimeFormats: array[0..9] of TsNumberFormat; + SollDateTimeFormatStrings: array[0..9] of String; + + procedure InitSollFmtData; + +type + { TSpreadWriteReadFormatTests } + //Write to xls/xml file and read back + TSpreadWriteReadFormatTests = class(TTestCase) + private + protected + // Set up expected values: + procedure SetUp; override; + procedure TearDown; override; + published + // Writes out numbers & reads back. + // If previous read tests are ok, this effectively tests writing. + procedure TestWriteReadNumberFormats; + // Repeat with date/times + procedure TestWriteReadDateTimeFormats; + end; + +implementation + +const + FmtNumbersSheet = 'Numbers'; + FmtDateTimesSheet = 'Date/Times'; + +// Initialize array with variables that represent the values +// we expect to be in the test spreadsheet files. +// +// When adding tests, add values to this array +// and increase array size in variable declaration +procedure InitSollFmtData; +var + i: Integer; +begin + // Set up norm - MUST match spreadsheet cells exactly + + // Numbers + SollNumbers[0] := 0.0; + SollNumbers[1] := 1.0; + SollNumbers[2] := -1.0; + SollNumbers[3] := 1.2345E6; + SollNumbers[4] := -1.23456E6; + SollNumbers[5] := 1.23456E-6; + SollNumbers[6] := -1.23456E-6; + + SollNumberFormats[0] := nfGeneral; SollNumberDecimals[0] := 0; + SollNumberFormats[1] := nfFixed; SollNumberDecimals[1] := 0; + SollNumberFormats[2] := nfFixed; SollNumberDecimals[2] := 2; + SollNumberFormats[3] := nfFixedTh; SollNumberDecimals[3] := 0; + SollNumberFormats[4] := nfFixedTh; SollNumberDecimals[4] := 2; + SollNumberFormats[5] := nfExp; SollNumberDecimals[5] := 2; + SollNumberFormats[6] := nfSci; SollNumberDecimals[6] := 1; + SollNumberFormats[7] := nfPercentage; SollNumberDecimals[7] := 0; + SollNumberFormats[8] := nfPercentage; SollNumberDecimals[8] := 2; + + for i:=Low(SollNumbers) to High(SollNumbers) do begin + SollNumberStrings[i, 0] := FloatToStr(SollNumbers[i]); + SollNumberStrings[i, 1] := FormatFloat('0', SollNumbers[i]); + SollNumberStrings[i, 2] := FormatFloat('0.00', SollNumbers[i]); + SollNumberStrings[i, 3] := FormatFloat('#,##0', SollNumbers[i]); + SollNumberStrings[i, 4] := FormatFloat('#,##0.00', SollNumbers[i]); + SollNumberStrings[i, 5] := FormatFloat('0.00E+00', SollNumbers[i]); + SollNumberStrings[i, 6] := SciFloat(SollNumbers[i], 1); + SollNumberStrings[i, 7] := FormatFloat('0', SollNumbers[i]*100) + '%'; + SollNumberStrings[i, 8] := FormatFloat('0.00', SollNumbers[i]*100) + '%'; + end; + + // Date/time values + SollDateTimes[0] := EncodeDate(2012, 1, 12) + EncodeTime(13, 14, 15, 567); + SolLDateTimes[1] := EncodeDate(2012, 2, 29) + EncodeTime(0, 0, 0, 1); + SollDateTimes[2] := EncodeDate(2040, 12, 31) + EncodeTime(12, 0, 0, 0); + SollDateTimes[3] := 1 + EncodeTime(3,45, 0, 0); + SollDateTimes[4] := EncodeTime(12, 0, 0, 0); + + SollDateTimeFormats[0] := nfShortDateTime; SollDateTimeFormatStrings[0] := ''; + SollDateTimeFormats[1] := nfShortDate; SollDateTimeFormatStrings[1] := ''; + SollDateTimeFormats[2] := nfShortTime; SollDateTimeFormatStrings[2] := ''; + SollDateTimeFormats[3] := nfLongTime; SollDateTimeFormatStrings[3] := ''; + SollDateTimeFormats[4] := nfShortTimeAM; SollDateTimeFormatStrings[4] := ''; + SollDateTimeFormats[5] := nfLongTimeAM; SollDateTimeFormatStrings[5] := ''; + SollDateTimeFormats[6] := nfFmtDateTime; SollDateTimeFormatStrings[6] := 'dm'; + SolLDateTimeFormats[7] := nfFmtDateTime; SollDateTimeFormatStrings[7] := 'my'; + SollDateTimeFormats[8] := nfFmtDateTime; SollDateTimeFormatStrings[8] := 'ms'; + SollDateTimeFormats[9] := nfTimeInterval; SollDateTimeFormatStrings[9] := ''; + + for i:=Low(SollDateTimes) to High(SollDateTimes) do begin + SollDateTimeStrings[i, 0] := DateToStr(SollDateTimes[i]) + ' ' + FormatDateTime('t', SollDateTimes[i]); + SollDateTimeStrings[i, 1] := DateToStr(SollDateTimes[i]); + SollDateTimeStrings[i, 2] := FormatDateTime('t', SollDateTimes[i]); + SolLDateTimeStrings[i, 3] := FormatDateTime('tt', SollDateTimes[i]); + SollDateTimeStrings[i, 4] := FormatDateTime('t am/pm', SollDateTimes[i]); + SollDateTimeStrings[i, 5] := FormatDateTime('tt am/pm', SollDateTimes[i]); + SollDateTimeStrings[i, 6] := FormatDateTime('dd/mmm', SollDateTimes[i]); + SollDateTimeStrings[i, 7] := FormatDateTime('mmm/yy', SollDateTimes[i]); + SollDateTimeStrings[i, 8] := FormatDateTime('nn:ss', SollDateTimes[i]); + SollDateTimeStrings[i, 9] := TimeIntervalToString(SollDateTimes[i]); + end; +end; + +{ TSpreadWriteReadFormatTests } + +procedure TSpreadWriteReadFormatTests.SetUp; +begin + inherited SetUp; + InitSollFmtData; //just for security: make sure the variables are reset to default +end; + +procedure TSpreadWriteReadFormatTests.TearDown; +begin + inherited TearDown; +end; + +procedure TSpreadWriteReadFormatTests.TestWriteReadNumberFormats; +var + MyWorksheet: TsWorksheet; + MyWorkbook: TsWorkbook; + ActualString: String; + Row, Col: Integer; + TempFile: string; //write xls/xml to this file and read back from it +begin + TempFile:=GetTempFileName; + {// Not needed: use workbook.writetofile with overwrite=true + if fileexists(TempFile) then + DeleteFile(TempFile); + } + // Write out all test values + MyWorkbook := TsWorkbook.Create; + MyWorkSheet:= MyWorkBook.AddWorksheet(FmtNumbersSheet); + for Row := Low(SollNumbers) to High(SollNumbers) do + for Col := ord(Low(SollNumberFormats)) to ord(High(SollNumberFormats)) do begin + MyWorksheet.WriteNumber(Row, Col, SollNumbers[Row], SollNumberFormats[Col], SollNumberDecimals[Col]); + ActualString := MyWorksheet.ReadAsUTF8Text(Row, Col); + CheckEquals(SollNumberStrings[Row, Col], ActualString, 'Test unsaved string mismatch cell ' + CellNotation(MyWorksheet,Row,Col)); + end; + MyWorkBook.WriteToFile(TempFile,sfExcel8,true); + MyWorkbook.Free; + + // Open the spreadsheet, as biff8 + MyWorkbook := TsWorkbook.Create; + MyWorkbook.ReadFromFile(TempFile, sfExcel8); + MyWorksheet:=GetWorksheetByName(MyWorkBook, FmtNumbersSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + for Row := Low(SollNumbers) to High(SollNumbers) do + for Col := Low(SollNumberFormats) to High(SollNumberFormats) do begin + ActualString := MyWorkSheet.ReadAsUTF8Text(Row,Col); + CheckEquals(SollNumberStrings[Row,Col],ActualString,'Test saved string mismatch cell '+CellNotation(MyWorkSheet,Row,Col)); + end; + + // Finalization + MyWorkbook.Free; + + DeleteFile(TempFile); +end; + +procedure TSpreadWriteReadFormatTests.TestWriteReadDateTimeFormats; +var + MyWorksheet: TsWorksheet; + MyWorkbook: TsWorkbook; + ActualString: String; + Row,Col: Integer; + TempFile: string; //write xls/xml to this file and read back from it +begin + TempFile:=GetTempFileName; + // Write out all test values + MyWorkbook := TsWorkbook.Create; + MyWorksheet := MyWorkbook.AddWorksheet(FmtDateTimesSheet); + for Row := Low(SollDateTimes) to High(SollDateTimes) do + for Col := Low(SollDateTimeFormats) to High(SollDateTimeFormats) do begin + MyWorksheet.WriteDateTime(Row, Col, SollDateTimes[Row], SollDateTimeFormats[Col], SollDateTimeFormatStrings[Col]); + ActualString := MyWorksheet.ReadAsUTF8Text(Row, Col); + CheckEquals(SollDateTimeStrings[Row, Col], ActualString, 'Test unsaved string mismatch cell ' + CellNotation(MyWorksheet,Row,Col)); + end; + MyWorkBook.WriteToFile(TempFile,sfExcel8,true); + MyWorkbook.Free; + + // Open the spreadsheet, as biff8 + MyWorkbook := TsWorkbook.Create; + MyWorkbook.ReadFromFile(TempFile, sfExcel8); + MyWorksheet := GetWorksheetByName(MyWorkbook, FmtDateTimesSheet); + if MyWorksheet = nil then + fail('Error in test code. Failed to get named worksheet'); + for Row := Low(SollDateTimes) to High(SollDateTimes) do + for Col := Low(SollDateTimeFormats) to High(SollDateTimeFormats) do begin + ActualString := myWorksheet.ReadAsUTF8Text(Row,Col); + CheckEquals(SollDateTimeStrings[Row, Col], ActualString, 'Test saved string mismatch cell '+CellNotation(MyWorksheet,Row,Col)); + end; + + // Finalization + MyWorkbook.Free; + + DeleteFile(TempFile); +end; + +initialization + RegisterTest(TSpreadWriteReadFormatTests); + InitSollFmtData; + +end. + diff --git a/components/fpspreadsheet/tests/manualtests.pas b/components/fpspreadsheet/tests/manualtests.pas index b614213c3..0e5a47724 100644 --- a/components/fpspreadsheet/tests/manualtests.pas +++ b/components/fpspreadsheet/tests/manualtests.pas @@ -26,7 +26,7 @@ uses var // Norm to test against - list of dates/times that should occur in spreadsheet - SollColors: array[0..22] of tsColor; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;) + SollColors: array[0..22] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;) SollColorNames: array[0..22] of string; //matching names for SollColors // Initializes Soll*/normative variables. // Useful in test setup procedures to make sure the norm is correct. diff --git a/components/fpspreadsheet/tests/numberstests.pas b/components/fpspreadsheet/tests/numberstests.pas index a500c869b..00bac7627 100644 --- a/components/fpspreadsheet/tests/numberstests.pas +++ b/components/fpspreadsheet/tests/numberstests.pas @@ -22,7 +22,7 @@ uses var // Norm to test against - list of numbers/times that should occur in spreadsheet - SollNumbers: array[0..12] of double; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;) + SollNumbers: array[0..20] of double; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;) // Initializes Soll*/normative variables. // Useful in test setup procedures to make sure the norm is correct. procedure InitSollNumbers; @@ -53,6 +53,14 @@ type procedure TestReadNumber9; procedure TestReadNumber10; procedure TestReadNumber11; + procedure TestReadNumber12; + procedure TestReadNumber13; + procedure TestReadNumber14; + procedure TestReadNumber15; + procedure TestReadNumber16; + procedure TestReadNumber17; + procedure TestReadNumber18; + procedure TestReadNumber19; end; { TSpreadWriteReadNumberTests } @@ -98,6 +106,14 @@ begin SollNumbers[10]:=3.14159265358979; //some parts of pi SollNumbers[11]:=59000000; //59 million SollNumbers[12]:=59000000.1; //same + a tenth + SollNumbers[13]:=0.3536; // 0.3536 formatted as percentage, no decimals + SollNumbers[14]:=0.3536; // 0.3536 formatted as percentage, 2 decimals + SollNumbers[15]:=59000000.1234; // 59 million + 0.1234 formatted with thousand separator, no decimals + SollNumbers[16]:=59000000.1234; // 59 million + 0.1234 formatted with thousand separator, 2 decimals + SollNumbers[17]:=-59000000.1234; // minus 59 million + 0.1234, formatted as "scientific" with 1 decimal + SollNumbers[18]:=-59000000.1234; // minus 59 million + 0.1234, formatted as "exp" with 2 decimals + SollNumbers[19]:=59000000.1234; // 59 million + 0.1234 formatted as currrency (EUROs), 2 decimals + SollNumbers[20]:=59000000.1234; // 59 million + 0.1234 formatted as currrency (Dollars), 2 decimals end; { TSpreadWriteReadNumberTests } @@ -252,6 +268,46 @@ begin TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,11); end; +procedure TSpreadReadNumberTests.TestReadNumber12; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,12); +end; + +procedure TSpreadReadNumberTests.TestReadNumber13; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,13); +end; + +procedure TSpreadReadNumberTests.TestReadNumber14; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,14); +end; + +procedure TSpreadReadNumberTests.TestReadNumber15; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,15); +end; + +procedure TSpreadReadNumberTests.TestReadNumber16; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,16); +end; + +procedure TSpreadReadNumberTests.TestReadNumber17; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,17); +end; + +procedure TSpreadReadNumberTests.TestReadNumber18; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,16); +end; + +procedure TSpreadReadNumberTests.TestReadNumber19; +begin + TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,17); +end; + initialization // Register so these tests are included in a full run diff --git a/components/fpspreadsheet/tests/spreadtestcli.lpr b/components/fpspreadsheet/tests/spreadtestcli.lpr index 2c5561030..6ba2e93f8 100644 --- a/components/fpspreadsheet/tests/spreadtestcli.lpr +++ b/components/fpspreadsheet/tests/spreadtestcli.lpr @@ -10,7 +10,7 @@ uses testregistry, testdbwriter {used to get results into db}, datetests, manualtests, numberstests, stringtests, internaltests, - testsutility, testutils {the actual tests}; + testsutility, testutils, formattests {the actual tests}; const ShortOpts = 'ac:dhlpr:x'; diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index faead4edf..775053d77 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -1,4 +1,4 @@ - + @@ -21,9 +21,13 @@ + + + + @@ -75,7 +79,7 @@ - + @@ -111,6 +115,11 @@ + + + + + @@ -140,7 +149,7 @@ - + @@ -150,6 +159,9 @@ + + + diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr index 0c5ab37c3..acf3b5dba 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpr +++ b/components/fpspreadsheet/tests/spreadtestgui.lpr @@ -5,7 +5,7 @@ program spreadtestgui; uses Interfaces, Forms, GuiTestRunner, datetests, stringtests, - numberstests, manualtests, testsutility, internaltests; + numberstests, manualtests, testsutility, internaltests, formattests; begin Application.Initialize; diff --git a/components/fpspreadsheet/tests/stringtests.pas b/components/fpspreadsheet/tests/stringtests.pas index 1fe7def2b..e3148ac64 100644 --- a/components/fpspreadsheet/tests/stringtests.pas +++ b/components/fpspreadsheet/tests/stringtests.pas @@ -22,7 +22,7 @@ uses var // Norm to test against - list of strings that should occur in spreadsheet - SollStrings: array[0..6] of string; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;) + SollStrings: array[0..12] of string; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;) // Initializes Soll*/normative variables. // Useful in test setup procedures to make sure the norm is correct. procedure InitSollStrings; @@ -48,6 +48,12 @@ type procedure TestReadString4; procedure TestReadString5; procedure TestReadString6; + procedure TestReadString7; + procedure TestReadString8; + procedure TestReadString9; + procedure TestReadString10; + procedure TestReadString11; + procedure TestReadString12; end; { TSpreadWriteReadStringTests } @@ -84,6 +90,12 @@ begin SollStrings[4]:='café au lait'; //accent aigue on the e SollStrings[5]:='водка'; //cyrillic SollStrings[6]:='wódka'; //Polish o accent aigue + SollStrings[7]:='35%'; // 0.3536 formatted as percentage, no decimals + SollStrings[8]:=FormatFloat('0.00', 35.36)+'%'; // 0.3536 formatted as percentage, 2 decimals + SollStrings[9]:=FormatFloat('#,##0', 59000000.1234); // 59 million + 0.1234 formatted with thousand separator, no decimals + SollStrings[10]:=FormatFloat('#,##0.00', 59000000.1234); // 59 million + 0.1234 formatted with thousand separator, 2 decimals + SollStrings[11]:=SciFloat(-59000000.1234, 1); // minus 59 million + 0.1234, formatted as "scientific" with 1 decimal + SollStrings[12]:=FormatFloat('0.00E+00', -59000000.1234); // minus 59 million + 0.1234, formatted as "exp" with 2 decimals end; { TSpreadWriteReadStringTests } @@ -318,6 +330,37 @@ begin TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,6); end; +procedure TSpreadReadStringTests.TestReadString7; +begin + TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,7); +end; + +procedure TSpreadReadStringTests.TestReadString8; +begin + TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,8); +end; + +procedure TSpreadReadStringTests.TestReadString9; +begin + TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,9); +end; + +procedure TSpreadReadStringTests.TestReadString10; +begin + TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,10); +end; + +procedure TSpreadReadStringTests.TestReadString11; +begin + TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,11); +end; + +procedure TSpreadReadStringTests.TestReadString12; +begin + TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,12); +end; + + initialization // Register so these tests are included in a full run RegisterTest(TSpreadReadStringTests); diff --git a/components/fpspreadsheet/tests/testbiff8.xls b/components/fpspreadsheet/tests/testbiff8.xls index 3c0cb9b76ca800c37df7af4201915b8334364728..5093f294b127017cdd24bc7695d018bc6e6d49c9 100644 GIT binary patch literal 39936 zcmeHQ3v?XSdH!d$l2(>%S$;p|vHZ3rp_jprU`c*}34Y-Rk06e{mR8or(n{G~0itmc zZF5dfARMq0NPs4ggq9>EJVQcD85cXnU+$GX$^Ju>e{;@LJynVij3Nrgjh;PVdqe5xQm zli{g-ycC}yDsBIdEKn6eK~|K@Pgg!y`HC1)5fb^4gyiAy)7Xpr7@&{rClOH7i|Cs9ctw8}hZ3M48w zx)C2o+~98+OKt<)PchpCx$EU#L>1F+V*TsoRbWIUm%}Ye_qZHZ`JfG$qH2N^hIC3! z(?S@AbQDeTtb}ETVqp>FTUzU}X+k|BMOj{jDQ8cBAyQW~1vRaiP}2_-#h^`fZgtt_ zTWr8EWSu83LsqG<=G9AMffR$Nd%2PePnhCW)G;rM8-tp5OqiER6QnRugZ%18eRz$O z%XBdsVPV^8O zfqPrg4p}4TITUSfap|g0Ep2k&8 zz1~@9N99Y>?ninMjkp+PEG{&>c-6f!-g8rxA0NJOnL`t7R#QtV!Bbx5@sf+3J7UD;`8o;;xV@ zQ9X-Y(Ss}M!@J~Rxr7b->ZMDYI$G9WWA#LA(I&c`oVce+by0}uaYvwsLX)Sg>!4X5 zULud62bQY|cfmD%*m@d!%)XxH9&-p=k2!{|K3px2(o-4OFf_EWt3Etm9+O$>s*5^W zTCSmZLn_r{cJDlI&(8YrTzMShum)YPVy!4%yFk8ZTaLpxi0r9w){o7 zQ?h9hJXeK-KD=N%t%3Y)-a+y75Aeu6^;y?X^ymfC8<ATu$9XnB##Wu)gO3DS{>lD+T~EHD>?633 zp!%gS5~xkVIMjC7V6{4 zmq>L%c_r-sNEy=S<@e#@>GSgSXuc2GLQD_u+JOt18ON@r2p;niWbSE_WF zG@tA7J8*hhkCD6>9EKvRXUhnsnTJwR|*|!;B=u^ z%a%e7Cb`*j@YY~bn>`0(jV#NZgR4fC=gz@WBP(*}3V)?KA59&J9*&&|)nXcq(PVQh z8S5QLj3$oolGRMIEuPRxCZn@P``DH|5<8rTr%r@sqSc_s-{juxQ zCqiLq8n4Qn2t_bAFB7?VRLRa8k3bfdmhm!mY#pz_u?91FuN8B{IfEIPgOjVE9 zd8MlS)_bL@{5E){9aLuHcvz|af$>TlXUc`l|K+jd(ZrdN{&dXzP;77z#+(iZ5JTz} z(PYADmYHzckX|J+&p_jmE$HADNz{1Sh{)51$o@|laz-YV_aaRb!d8(zgRy8TW{x7H2V!Qo**iQq zI+QT`hm&S6)J;Jgh5HpB95fHd%w#OuXC59i`$tkE{G1wy#nMn~>#&&^PMbr+eewP= z6W8{|24l#vg4k%rErg+1DrJt2C@ScePC|DD^15caP%#4mg6i;K45bf)>$SBEG z>KO31j3r^;cyGBFZQ)Jfj_`(XOBl8Mx?lDkjpDjJ!-MhEfH`bB0g&e#V##6Dn4x%L zG-a+`kNg2;IDv+$MU2OsMW3XGqA0`uWVDxdW3IHRT2U3!#pF=WE%PEH%H=t z%;EEbDB{V+ScCD$oe!CO{Zghs7mPpEUD}DiCT-Zyai}TIA@?4JCbD4hG72ZBq~|nlc+wy>VnE-XHI6&?>gt+FW=JD6#8D ztjpW%%To(Pa=8apqJQ7Oa5Bvnx*xR=lR;1Pj^V@+#$X!fiBT6a3NtppsP3JZ=6ND* z#O|HA=irIEXeg^nquDn!L4u*wL`AHn@pJnT5cPR&Si=a|_8wBQp^6nciP6 z55F+B=2)a#j=AJ$WElJ=W9|cB%(g^u!$;j&nu7iug9#&I{a_ROmQy|m9j5>woUi+X z&}#|+!UyL5Aat1mfM6&u0)oCO2ng-yuL+&80GiO}_XlB#P6%>pNAc1@tqKBCymU|% zgMbt-9XfsivQxZt=p_aKDPB5gK|w%@mkxSV2MA6IwVk&1;-#}N7)bHbL1!35lj5a= z`vpNjikFTV45WDJEDi=zymT6ZfN0;_zX2`@22#9qmIebUUOLNyffO&D<-tITm(Ge{ zAnww+-81g21W2VCcj#7hc6Mg+#vMky_10S%yL2is7TJkSJVoJO#38dEhE_Rb`cY38 zoW|U>fK}VEh*zmqkmrXn>c$&y%y^Ze%&Qb-UZp6rbb^&udMvdXQAT!zh8LOb zW%4sXZz`98&dzHKXCQOxGkI41-DTi_Cj-q;DxA$g-V}qy%DIQLn`E)tGTW-hB26CP z^KextTZfndR~^cqr?lV#J#?@h;U=>C0#0@q@trrG&zdK{JX(<=S03<49OdDiU9}-L zM|e-nhcNT=dmMz-6E8XHiiA{7NKOc6KbX1 zBC;~n%6yBhb!R{-vfSC}AuX2quCkco&M&9)kwTXf%ap-cPDVcK1uB_6DfM1}8#cMx zfzH8V_1b=25Rgo#RqcF0)&~K}4)H$u-vAK*{D<=MzcI^7rs+hE zM|L9EXJ}{P`pjhbMlHB+XyRUxDcy2ZZoqn^gru=vi?zvs&r}(X_5brv-prKqGkX~1 zb{YMbe87exfV#OV!17rCTR(g?2;lM}fNZ*!h83~?e|z(XK>$}50qn>DR>t~&a{Awc z05%r^)D2u^IRYF0;+H`H+lm0Pv0GWLiuJ$yvsZ!uE&^ajfKooS!pLzg1Ty9>ozP4LGAb!Kg8A=ZjHDd&+5eYg6sEhyF_fP< zE~|D|fu}^az(8W>S;Tc#F$pgEEQGD+3tBM-h(rs=%3#O9jqdb1LXF zTLpb)tDw)0N49%ZsLD)NDx^S771Bx_Q?|<(-ol`2T&bPFEQ7OrHJ^aXH7?_sKvXk8}uSp^_3cEg6&W~M6GqpwsXevvwHpYZYX13rc5qI@$mvZ(_rnS(`H{x&(6BI!+mim zf_JWplr`Nsj5x<}pWHPMH5Q;uc0o_lCatp0k<<6G$?t)eXOZ{0K|+&|XqOBFB92N! zug-3G^y=((Mvp94$@Q6C$@Q6C$@N)&#Vm)id!XiUcB;&59gl2r>toDES?^QLU=Uf; z&B19?x^>xX!S}PWwcGS4zRGSm6M$$x=;@*$@c zfz*SL52T*?gaGNOe`V8)KypaZEytDdxJf^5$cz%j-sf}pu?l-V`zdO!hR5c z91hB|jWFB)+MPZkqC&$GK*DzRt+mN|I zu>xz%oM*R2u9RCHKJ9G)t;64bwf+aV*yEs)*fknvh} zjrwiIsjjyft3xvwt+tuipWcF778eWd%kka68tnV9XoR2ZuotW?iO88Rz4^VJhxc?I zRPxnIzDDi;L`lYx#@?3UAtZ`HZbHn{VRDh>PgUwaQ~RB=7s_ozai(Cc1gf)bFV1sJ z*^MIZhuwN%T@$1Kl~|_Jj&KD=<&~;eCzpXmdap{ls`l=2+(M|5yQ(`Peb72&3}ESt zAp;B8{8r1~w*err|v^G_YLoOXeIlu}jF5xJ|n9xoK|kDoV|-5zFCn6C@uZA9Qh54|Zo z>}*@u^3t(nfszGE7N7-mpCcGi`dobtpEcT>{>}uRu@_?RQzobF3++UuW61*NYykt~ zSgs-&crMWZrdqIRfmNt8 zeUd8)D>55rsM&^Y`F5N>vPTHAajtbA*0xunpP|(;3v^s|x>KK=?lj~8Vj^-3^IUHC z)^Vnbv>_}`#m1Q`-F&>Vfi>Xzvt<~gR>`PkIcB$Nvt;D*$~Y_X$~Z6f%E;xFagODc zah-@)#>(TBv1j$l=m~gbT$kXL(I#FQR=nrQXe)0zzSHHE(Sjk5t+@2iE1On8Hobt1 zzJ&AIKgP0tZYab5_{E#=Dv!s&8L!o6Vcgl~#*{2MXnFe9lZ<2E(5+-;D0`M*t<<;g znVXq%P{oH-JmrjMY1Yc+9hJME9ov7BXe>+Sx%njHS&FqX?eib)uC5yR7V&wjs8-b{ zre=vUwbqNRq887@wO%aQTpaK10tqtWvV?18!!0d8zIANvCgMg^yjmiNc$RjpR5U*M z@xLE_qm%J`)2UXqCtgqc)Jk2`*8TszxT=fs%y})oI6`x?7QlMb>!vV{Z!y*KO=`u> z+E6RcojN7U8*b@le2t1%>-m7qnsJewjs5zy=zT9K?#YPXg4a3p^{ge^T=9G>YzyA* z(DBUk#j^CtGgt%Opv;%UPVy5gs) z_(hN#p$b(?E>)jc5uWxMeu4UIs!!bK{wB#Lyc6<-a)`Qs zU~dbdLmA2G`tgM(kfQ9g%-zz0=#x z@cD0crDW+&?DNy^FYXgLd3nj_w@ex6VEeg-PwJA-?_-#fxMYEn1^!?xz&R7QlFzU0 zP};wj7AX1rL9P9V>hm9(>h}4y?^W{oQE#mK89{u0`df5xYVl;%>uocRvt-;cvEp*x zHsd%#Y*D_eJ|haz^cnqfrr??OyXmF!O#9sQOZ6GAqpm#D9yrTVpD~UeD9^O_O@C6K zF^=9NJ!ER{_G0OQ=e$_v!0pA-1J8M}^uXO-toFcdFP8aod$HOBx4l^A&F#f%FWmNG znOnCPtG#gBi)H?IDle9~r5D>E&%k_h40^7sVFMoN&*uIt&lTxKy3}6pl;=u=uwW~B zi_G{x;JNZ%h2B=;@a@C6OP3V+dHTKdUYDaLzwrxhKkZ!M_`DLIzqjHT{@>_a<@j8B z!d-g8ZP(h;v1Eag1>Ua~;7o;E$=lU-DDB@%3zWRwpw@mrdAppR^9gsO(P&gZaR~pX zJME+Q3HQmGE~E^pC*HhDs&nU*cg@t^FrSE*;qQ?3M4adFw+yLvd&``I^GR>%3HiBr z%Un%B-?Y#Za<7b@saM8_h+Y|=a(iWblIfLkO@mj))tz1$pDBA~^u4??J|FhV_)OR< z<5#wLW%P=@GJ3*Z8NFYxj2^F3WS`fc8FZY%1f*mKxdn zZUa^il#ewJoQep|s;I6Ka>cwzt}-#Nmyd&A6J&i|6A^w!in-YeTItp_jo>z`&c6xxo0dccAL^h8i=*Rw>cRaRN=m{s0n>r!o(rO8(y zsNV|~C`brOFFIlqGz%OMwwMZiU!IN;XeHl5aqH}-aAb>hnz)ai_+6O^%a z%4@N$ZO%fS?BbZLI2tSt-ZI>s<=`?Xa;&V;)eoEjIk-S7myaomW3k0S#64LKP9`YX zZ*hP#AP4bt9JPvLiN(QNyO(7-rdk~176&*3a!hq`OjR69Ee;OLd$SyTHHP_k(Bc4R zK#n>WN1ftWW^r(s$I2XxA*_e|F)woblf?nffE?3Y9McrX3X6l&hW%L%{!|z_!jpBG zgEJt-EQa?>~Ya7vS?nnXh0i` zW|4~qzk7kQVY_)5bNQcRupA8CET6?2x!bXf{3^K=5B?4yT#C=1R5t*56Hxyh!Aqa{ ze{=&);5pqG%9s_ej8^o@sEb#|2IrNrb$Dg0%1#-pwF%i}F4LKo>894|)&o-pGo9%& zovBP`_XW(}UKh<`i)Nig1KMCTi(NE}6^-2&&|>>sGz}KbA&UmI!Dt#>G!2Tz?h9B5 z`&~4c52~K+&n+6zp0y^7m7(0=mfuL1xM-Fr8oMu`@easC%Rf8w6X9pn^6I6EhBsi? zq?fAHt8m7Wqzw+pOV2#^`P;|eQmL1z)T^!3%d)BIoiZy2P^+iOts%izIoLI|8B3tm zqGmPu??NhjQ;&v8LLYmXqEnBCtGTFIiY{tK^hArAA3uadYV%vvY{&oJk7seWpaSm? zdp84u(;xfXTff;oF!d|9M`X>4$6jfHYyhDgf$==2E5`c|bSbtYa2k*4mRfCo2uC8n zhHjaiBhy+xA}d|^EO#CG)eAp+-r(o)_D@fVWS%$5C@*a#3zRHSvOviKB@2`+P_jVD z0woKSEKssQ$pR${lq~Q&wLmfdKlJ_QzJE{i{HZ7Ig#X|8o3GK|e+GemJpF(A`}!_E ze-Tvhy=DCNG?7CHeC#rSz=sJV2)r+FJp%6&+>2n}7oflY(mXz()SKV29>7dXZtI8r z)SVdhi+<{p`YAuDK{{gdegmvZRub%C5g+nC*eQmCa=8FLIrRlrVkLNO4u56>P z&t;-q#z}vl%OJT%kv>1~3vlTj*Tr$s8dsEYxfj=B(KqKRCKF*XLIc7Q1TF#LnhP!o z;gXG&2wd>NMICDp8WEZhni0-JXhCR2XhUd6=s;MDa6ZBX2wa!29$^E*S-cSS0UR$x z*o4rD(1p;Auo;2zTXEcma1p}A2-^`ZLHHm7le*bMH_zgs}{RHLTNH{hgY~@&LH;ixorw;m8 R1J6yLb^nX}Zy~Y8|34|$AqoHh delta 2000 zcmb7FT})g>6#i!RpWS7bh20C;bzz|mKe~E%0R@^`Q0i7dOIv;ovIKx;)xBQ{Ys zu_Wk2V>>Y+s4-0nYGSOoiJBObKGYYh(HgaB(g$N=8l#5B_#l{aJu~-$R8pgJcjlZs z_nhyXZ|2Nw_9LD>$zIl3>FHF|9tW_v=R6Yz%ja2$0RNV8@gx5^H|eb7wj!JpZ+JB} zFFy1pN*7Q7l(!5VE#GF1-6Ip_ar*(hi5f6b?Td@B@7`Rq|0EL^3v{t1R4hIZ>7uo8 zqF-=3f?1m(WkJ@dWGL%U5?Lr&n6)celyw>Xj8ksY2%t5O6u9u{@h2Z28b3A-KMcQ| za-eHyazagv1;ui4!u1%hp!rxXQPRVw43xu-cU^#wCNH^xY6i4>fVWA0O0t4NJmC&g zmvCkaTawGD9(NFM264UW3)j^wspR10MV1LD6KY;yffPSD7=_{(q@+2-YFppVvy=m1 z& zVN+KS$Mcld4cdYj$`C?6jWMN{DeZn9!Uqbe*$k=1J19w;kCFm)A3cmMQCKJLqnZE0 zoz@i}=Tn*$LGer5k@`(k8I$1DHd9@r<`RjaS435BggEW!jRqnrpPLk)7@=5<^h&nV zy@!Zq2%UsCsi@TuNlEcvsHw;bPHO*;nyi;ODuk`kwQUu@w+)I&Us`J-!kuWvLwFG5 z7{UN1@D#?yCr!9jufOAiLRS2y{)i)^zO^>mLwAXPpgIGj=hsvryD@JDhWE#KpH0vxX8wAh5_jOX>s*XWiWz5Al0bXC-uf;D%~XthU3Wy z8G;HokKBPUyeCK_IC)G;2rf#}gwy$$I5_;kI!wbF%=zK?lvywmMixvM>0?|u%cNy4 z`?<`;Ex`;2l{ihixJoFkr)ra_R5D%HrRz=VXV#q^5d|he<>H0$**7Mr%>vC@pd8Jc zQEPSLn5<2$qe>ik@HK@hnb|Fzw}{!P5zR|$QDgHgmlQ8`l4foKtOAn9bF=lxX!tDd68qB~px*6parD1;e z%DLSuONxW60lDY1wlQ(^uol}uJYCyV-$=gFk*;fK;_TsY-vuisIj-JX9GhJ08)b2L zsUQMsGq2F)Q|kb(;U&CI_jiW+0kkWbLA$uKEoNTcRC#6-`ZEb~pu3gM*^x7oFFJY# zKKc5m+^NZhQv0f57@}b|W-9wCR=tnTj2fA9R?fB*l#|9#9u-~E^B)Av6*`$xjHtrI2Ue6B*2+2|VfndCNE zh!A#od_I@UDWVYA9pClaQiFZ~;+` zGzDoY(ln&$NHs_^kY*yyLYj><2Wc+SJfvEr`A9m_0;D>mg-DB#79%Y|T8gv`X*tpg zq?JhZNDWAhNEabBAvGhlAhja3A+;l2jC2XoDx}p&^iMPW5t-&)5p|nL;gf|eHi{&E z(_#b~3%=FBV@yFA3-k!1f)FRW}mbv(UVSPQhix{`z+o3Bv*e??-SNcp!Su^+q^iTzzK68p&k zB+6mRe+%~6Cw>@-^*W4Hh4chcv3fC?4*6XtzbD~a6JM9-{6JEgp{3_gK6mS#G%?thYac-WkcM?*h{Q3B zIA+^RpirsSh5Q8a2Hs&Vu{B^n!)g`9t`*0T&BEL;)`+$s+=(f4~}I0^g&6h#+3AZ zzC5T?Ra<4-LXGun8ls|8V}piO=y|oGzDS7y*vztAc+3)~;A3tSCl5;6HfCKWj8Q^^ z2RZ9vq11*~V(c?jXm#RYy$-|wdZdLI(yv9hX%KE|ZMYqwZDz6J*NJUtpS|LGj}tFJ z?3z`0Vk5A;&{SS+xC@P>*85a{WRpo8^Oq)}?atR~h0tyFCEZ@m(<29=|&U zziY$wm@Hx1w7X%2zOa7b!lvB~Yj@f9Nv~_D19f*p=kA8u@Gx|~%3Clczk;z$;uOzb zh9#BRSVjrife4{E@Y@u$4YN7S-|~VsHaTQfhlaQv9hShY;&W)nn&m6IBoO^aX|PyM zZTM30Af}!kr#Wp{oI!{9Jm#%72CCZL=*ZZu*)NGrb((3xlY$Zg__VqGyfw>rFFi?v_ z{HNke@T?+rwwPPevyC{FU941b0W2=eH+8UCJS?taJGpMrqK3An)z=#hn+-%qE4IkH z8f1${#x7?D8a!GMX`Q?E+Hj@#GDnF0YX%3`cGiaHh_7&9dflRi%iEfot|xg-CbLWL z+H}#@O|{`!;t|eMkxg*s8d*GduJ|eky|zs2ROU|*Sh060a$%pGeQa_)luKwoyZ_XFtyCt1-N|Sz1Gi;Fz%4$Uq=DCnek_NQ99QmoczBe z>sxNpk5yOKRMw!r_ewg)yT$l(4a3PtwXbO=-BmBHq092$mrD$J{csJzMu*y!{9Jo5 z=sI?xMi<@1U&FvpmM_r5ilX$H7XLli#d5yl&$WHY$HkxP{gVEPzCPtAUzhsf+M@KE=n(lo*yj%pMv^+ zxoCNT?zlMaBOdgxdeA3((5pS@4IcDH54vH;0{zr@malO2M@K_buttUm(bBY7Z_vB; zAB-on&7@YlsV$^VaZ_7Ko$98xkvh#yZ6|fQn|d*+HKew=WticnN*QLlsZxenZmN`F zwwo$tnB%5O8Rn9Dv0H|DZmN`_)=iZ%%y(0z47!^tWmw>*LWU|#P7u}dR;a=RHGd4; zDqNe(9|N%p*Xi=dz^cMEyZkXws>D+3Sn^*ckB2k+VteC9Ls3js(VMJ~r{g{S$>HQa zp0a{PHYSp)$V3Edw406Teeu1?MCNE{I$9GV{>JqFfivlNvNxXAxzKqu6c!Dm6}h9K z2rdj_IrNHQNxNt?0$Nx!jh4vY=Fu|zR^ehHP&UVhv+3Bt(a;3UX%Ln+r?QEIEZsI* zic%AC84=jqd-?|;pJXRS1u`aM-i5Gxic76M{pmy>@}}TgBkX6R>C%r^xvA2AtKC#- zzcp@Z8--ar8kVBJZ?qi0)5WE%{|B&mn>;tvmyPQmiVqAxnNu-QLYI0?ESE_LU@+3b}$zLb6*C%&Od{U&4@zM;$z_cQ(Rcou888&Y~QmDLAR zy@|dN9q0DO2jWnIWU*FH7#s%UnT$R>B%!eOoy|ak52l9oo>)?fkb(>*u9P4(IEcuT zsn-+9Y&<;}?@eIM9K{EEh6iFY!CWsRkzGw41)HhV?E4-6D#t;cshk}$RF6k zSqQEa8yHMwvU)RAlt~T7^`Tfgo6%E!`cMKaEPe6Z81h%@F+B^p`Z0DuwfoU3AjaTO zb_C=DStvh-)J)ELQZD_kggv0%8;27;`}Mu))XmiJ0sV&I!65+Mgi2HU1F?f6dT(kU zhEzSVzMtu_VUQA8j5uOFJ;2jriG9OyJ(ZNDQ=rIG;5CQz|da$uyfu@Tj}VHgUD!H?5$ z7F8A_7ei4dZOi6wjWOdOhxWmD;Tcne&l zCjoQO2P_p|7?lJUug4 z2&?vhO7?By zd6y67MXA?&2gfKdI5Jj&45V(=Vc&E{Z)=CEBr|$*3k=d_C^QsLOZS)FWO)vv+L)#79+E@%5)s`PsB_NJ3(*&$ znf?=g|B_7>wpoDa`xrEuE)n7ZsC_TmM^B^%iGfya9OrWjiCZGmkkpa--YI@w^^NSI zNS8R|pd+xL^P7mV4;W(<24rK&XcFQ%IumBZ`+%0uC}hHkQvfC$$D7;>nQ+z=fC(=G zdo$sbDF736uWGsLrob!7#p+(1Ja6&)QNInxOFw!@6GXV2y{%F!2@g>_6Ec+oIoqnQ^CD{M4%Nu(2# zM(bR#mD{0+Td3urTSC2cNaV4{6zbMnZ_T-dBF!xnX>OrNGh~96mbo;w0$EzVhsG>2 zA7u(Fz}b{lfsT%widP_a@>BT?Q>(wb3hZ=Mpb_R(T3?|A>v?-I_PFf-AC3)0hCt$(G@(yq^ zP~E!6+~3f>50hMn;dUNORtI5{@8Uh`zXnXa>mMqtKX0hF+@>H7Nf;E#jcPQ92kN>! zDt#IO#%a33;L(9%DtJ&~-0WtOQvq^%@WBW3sHOulew%(~N=KUMXQl&^=8k@(Ni=*N ziEKhLkI>G-wYiCy8#Q6wka0j4UAX7_Anx1YJ?CtRT%oTL<>7eWzy0J5+=YyNMi|s~ zG3PIZ4C{Ots^%&gmd5+e{_s=~hD&@HvgsNUmc{%2^Nk+{VYtGFVVlLUJl^+{)4vG9 zu+fL1YT&ZU5$N!jzY4;z#fKpqyHVwec;DMUdnE|N`C!-05jPH4JhGAuG;AI86X(UY>%XZ$ZkFU;u{`%vz) zUzY8z3|EOvf`-EOqln|E!f|vYa;pox29E@-2V@$lNA#l;A4b~eDFR164iPwZwM0-y zrU>fD6hR#wiCpOtp&~a`ijV;`MaW8Vba5q~UmKG9yw^C1Q3gl(ay)@4*QglH9f>S* z@+vKXE;rzugE)gvT@BzIj$!Iu<;rrEu5!A#4sq~$qrBTj)4+G5l%kl8IC-;dbkjRk z&~~S=C9`r7fTv-VINT!%F)|P{tW;qiTG1`aF?wc;RyHw@%E0mpC)-eaZn9*%A6hyi z9UzH&ujvZ9*n!^z@~M}QgrT$1en!+^?PR6R&XtHOV7@HmQX>tXz)72_7S8O9liQpp zhaz}3*~iwL&Y{OSf^~AoI8>Vpn{0-hgiRZ^w!k^}GQp2wmS=$XI+=tfpwMPKn8(NS z4gv_5$&ALvS)JL=I3u&1TpgKCu8vG6S4V}8SqfpdLd;ZtsLW~|iCpHCN1Fp%Z}Yjr7@U zUyixQ{HqR0DD6mOi;KZz^j5_g=*Dz_^4gh%7_dywECo9^%W5B%s@w5knd^Ay#J@v7 zg)FD|uvDFp2TL{b34x`{|4OF%uw<8{T8^XQMdKYtXJ~Pcx(!i-hH{zq6b(61p5TRGFKE^7N=A zMDvdrhykX9-tMaR4Ak4Ip^lof<4dFdY3%n&*7k0YQ(S2wXd^%TG@B>;#WF`XScYqN zR;O5oyZP)#ACFusK5m=S-U+7F`0PNv_DYp+hY?2P-X@6Bix$Brdsm|gC&W!MTv#Q# zLE9($t!9j+?~Tkv0z+d{@mZ~r*(JVCnJFbBX)_{h7%yJ|R*D+ee_s?H2n}QQC(hao9 z?%%&8hgrJpjQz{~o^v_Key0%EiWOiHmn~Q~nDN~Y=4M&Kq?mb{9BrtUZ|13AMuZ?6 z$6EK}hJ*^l8IHL4#)*2ZUaNd^5B^Sfn7^9XiJXWygmE#q(@~C$Az27F@M7c0mdgTo z^aJ;dt9?T;T2#^~CElDQ^MpZT&D=DOirh4gqun%OxoI3@xoNzw#7(2~xM_^6ZW?C} zZW`}naMP$0Hw|~l7tp9HcR4--=B81DA(yUrtD>7Wr3h_m5gO+n_H+LXj{$Il4gc$x zZ@evMNE#ob!lsVGqEmVxOVV;tapd(}j(Lm?owU3tf$jMl6}7EfXXPgCKEeEu%%>HZ z&)=x{KwJ5i=SFs%AUE1FD!z?&!+csXDyBSeOIKw@|2KI)mzJWk6id^h^fV`Ggfb)ySuQ zqN2KC!;b%3P|?YJ);ucDBR0JN*i)+~F^^A4Me(b6(;K4V`I9HblDflP%&(I9Jcroy zjLXFN_^;2z?te*QPelGsJpQ5b=_MN+`FvVzC!PjT`LxqUvFPb@dHzw!U*6RR{`8*9 z9r=7ZDk|SZM|^tH6=wdkl#fqI!HNcddexPV{3$YjKImGgOunJ$Pvjo`>MHRv9z!_` zL*J>bz-tF|Jh?Op-*e@@F8BCteI|%?c!uOjIU(u<2XmVT8A@1H2BJy$XxgV}`ij?J z)-w5myM2)vVjpc}Y?!Vx0@KTmMV26$8HK-3>@jJ#V~yZ;M@d?D>@@<~t?Vixp1k@G zd5z$=iRQ;AvK>Ly@D6UQDWlSOG-pr67DAVd%Dzt>nemZFbl9lWnL0A#Bac*kq*m1t zxv>4JBbKD^@<>HWwp|{nD9M(pj(8s1C683hWSmz=%wtRBk&2h>jnxtJYH-AM&)DaT zJB*oD++mY&#vR5?EAB96I^&LtnP%LfmYi`%#Y}mlFz^}woN-6RO*8H=ZaU+Rikpl( zFC#jA6v}*E#+4Na4va61Hs(jh6qFRuskO%}lO%05%JqFb_XTCwp zdX@WQTzk}~bjjH&*CM%Md3=I(%vtQ78a10`ehEH%s;y(pt29yRob7T9K0e!(N-)-C z-|5<=dp(o$ST~KcSvQSyS~ra|TQ`mKTQ`lfTsMsm5W8udd%0O#Dpu&YUwhh}hffCUr(5HPDqAalTr-9 zKr-w!7{bwf)Y57(o{EgJFdqL%SPB@@`0ZxeiA5Kb7pc2Bz49 zon(Kf!5%K^EpPKGB`+7|*b3K+2e-WSxh-$KCYjRL6;t{-Wq!(FT3MWF`)ai8rk2(< z?W@6;Ou5>&UNrB%W@tU>Kw# zxUOc!2X@AaJ#U?(%#qp36A-#AMHECMyQ0})N9DiKAzBq2JSubpjhzx!-i>I)OC}19 zx9btD%|HWsK(vVtw22aJfq}*)TZAtIjaMZU8ZUVfZI6Kl^nhr*7-rRNl0>UB(8zI9 z9*viC6dDIA%sXtL0X-lZE~VJectI_Su&nIHMdrT(2lzDiit zkIz^WvEM+11Qw#zq~!>}>_cRL=M%|M`5&v;uLue-%qIkryGEG8h{WW z7~pgV;B*PdR>vB05ZCPh!RV2uIzlmQ35V}-2_z}b1g*#_XX1|S3o1~}URI9md;5fYHy z(fb{M9HJ_xnPUKs8h{WW7~mWS;2a5PwnGm2yBu9B-nMT5&NToZG5{e!F~GvEb*=0}uiP1DxjooF@UzcF4&}w*!zj7%G+48i4<6 z078IZfVB?5S_x>jL(YUYIRNM90p}Zl`aIPvAV4s{`3^w5y&2BVcK9-;O|Qc52ST@t zPm4Wbo7jz8=6Ax0b|dY?e$w^1Q55^|Rwo_&>{B?>s6{u86?M}ni<`z~>!z_~*=ckM z9kk63h3R>P>4w6tG!zB}22+^sP?#WgAOtucXvDnG0k}{C znsJ1x-6kGc^6BY!guf-n{fi_Z1Hd8)xC|xK5q)6D7<|UNR>H*BBN{FnP(m@?E+O$CTsu z^jnI?pF$JolS=As92fTg2vk{9B{@O_sIKg$QO$L+hF*e^A7P#{CJO*r{Oc?&z3wS*LccOv+2Zkq6f&c&j delta 1678 zcmb7^UuYav6vn@MclJ+q^JkOnZno(*CN+da+;(QS#UyCEN=pgWZmSzbteDnpTgAN8 zRsy0~!77Sa>czK+Rjl+;*wTkS^}z>0EeMSfOrZ}cX|c3Eh+r@szjJrg)MC-QJNMkV z%=w+~oO5Stzo^>IFC5*J1aQmu{dUu$H`W(*PMw%I{ed&t`lGuK7q4AVrO%JQees$( z?7XE1y6Vf$jZmcaeLuJAH)1_1^j!_6Ek38Txf1`WKHXZ-^+TyQmARgELkdmiX12@x zx@LoUsoRZ*(F%oLpxM0Ny?(-I2gzE<7u#NoSldwxTZ_Qsi%CbM+{dYRKU%Z zDA2Ef{W0Jj+GW~4hIl@f<|VksNC#HOxoC>9Vv!`42EUCmcSPur(5c`NPzi9554NK*Q@0pVKJn?a|M%f7y4zL^}@n?Wbwjkufh z?nvG%R9tt|{#R@bLv-q*TjS0_nvP%x;?^?I+-Vy~@xF_J)(Y4L>Q@Wel&k4T0$L+s zUaSrz|BN*p#4?{$duGy-f<=nWptO6jBp^vm6z?R+_hYQ1_QUKkx1-vU3a(eodtSb< z={D6GqEpH)I>l1wvr86Ah=m>rpbj3slUj6Hh{Y9o)7IP+QSJQ?`L@8;_bH#A6D#DdK!;fyMxw#E2Nhw$rKFxt)Lf&V&7#Y-wL}EHz&4T`t%j&58R3< A9RL6T diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 3d5b67e63..0b6faca0d 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -70,6 +70,7 @@ type procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); override; 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 WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; end; implementation @@ -407,6 +408,21 @@ begin AStream.WriteBuffer(AValue, 8); end; +{******************************************************************* +* TsSpreadBIFF2Writer.WriteDateTime () +* +* DESCRIPTION: Writes a date/time value as a text +* +* No further formatting applied. +* +*******************************************************************} +procedure TsSpreadBIFF2Writer.WriteDateTime(AStream: TStream; + const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); +begin + WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell); +end; + + { TsSpreadBIFF2Reader } procedure TsSpreadBIFF2Reader.ReadFromStream(AStream: TStream; AData: TsWorkbook); diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 743bf1ed8..3056885d8 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -118,6 +118,7 @@ type procedure WriteBOF(AStream: TStream; ADataType: Word); function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; //procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding); this is in xlscommon + procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteEOF(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TFPCustomFont); @@ -875,6 +876,20 @@ begin AStream.WriteBuffer(AValue, 8); end; +{******************************************************************* +* TsSpreadBIFF5Writer.WriteDateTime () +* +* DESCRIPTION: Writes a date/time value as a string +* +* No further formatting of the date +* +*******************************************************************} +procedure TsSpreadBIFF5Writer.WriteDateTime(AStream: TStream; + const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); +begin + WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell); +end; + {******************************************************************* * TsSpreadBIFF5Writer.WriteStyle () * diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index c0a51a00b..02d4ce208 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -87,10 +87,12 @@ type FXFList: TFPList; // of TXFRecordData FFormatList: TFPList; // of TFormatRecordData function DecodeRKValue(const ARK: DWORD): Double; + procedure ExtractNumberFormat(AXFIndex: WORD; + out ANumberFormat: TsNumberFormat; out ADecimals: Word; + out ANumberFormatStr: String); // Tries to find if a number cell is actually a date/datetime/time cell // and retrieve the value - function IsDate(Number: Double; ARow: WORD; - ACol: WORD; AXFIndex: WORD; var ADateTime: TDateTime): boolean; + function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat; var ADateTime: TDateTime): Boolean; function ReadWideString(const AStream: TStream; const ALength: WORD): WideString; overload; function ReadWideString(const AStream: TStream; const AUse8BitLength: Boolean): WideString; overload; procedure ReadWorkbookGlobals(AStream: TStream; AData: TsWorkbook); @@ -350,6 +352,7 @@ var lBorders: TsCellBorders; lAddBackground: Boolean; lBackgroundColor: TsColor; + fmt: String; begin // The first 4 styles were already added for i := 4 to Length(FFormattingStyles) - 1 do @@ -364,13 +367,63 @@ begin // Now apply the modifications. if uffNumberFormat in FFormattingStyles[i].UsedFormattingFields then - begin case FFormattingStyles[i].NumberFormat of - nfGeneral: lFormatIndex := FORMAT_GENERAL; - nfShortDate: lFormatIndex := FORMAT_SHORT_DATE; - nfShortDateTime: lFormatIndex := FORMAT_SHORT_DATETIME; + nfFixed: + case FFormattingStyles[i].NumberDecimals of + 0: lFormatIndex := FORMAT_FIXED_0_DECIMALS; + 2: lFormatIndex := FORMAT_FIXED_2_DECIMALS; + end; + nfFixedTh: + case FFormattingStyles[i].NumberDecimals of + 0: lFormatIndex := FORMAT_FIXED_THOUSANDS_0_DECIMALS; + 2: lFormatIndex := FORMAT_FIXED_THOUSANDS_2_DECIMALS; + end; + nfExp: + lFormatIndex := FORMAT_EXP_2_DECIMALS; + nfSci: + lFormatIndex := FORMAT_SCI_1_DECIMAL; + nfPercentage: + case FFormattingStyles[i].NumberDecimals of + 0: lFormatIndex := FORMAT_PERCENT_0_DECIMALS; + 2: lFormatIndex := FORMAT_PERCENT_2_DECIMALS; + end; + { + nfCurrency: + case FFormattingStyles[i].NumberDecimals of + 0: lFormatIndex := FORMAT_CURRENCY_0_DECIMALS; + 2: lFormatIndex := FORMAT_CURRENCY_2_DECIMALS; + end; + } + nfShortDate: + lFormatIndex := FORMAT_SHORT_DATE; + nfShortTime: + lFormatIndex := FORMAT_SHORT_TIME; + nfLongTime: + lFormatIndex := FORMAT_LONG_TIME; + nfShortTimeAM: + lFormatIndex := FORMAT_SHORT_TIME_AM; + nfLongTimeAM: + lFormatIndex := FORMAT_LONG_TIME_AM; + nfShortDateTime: + lFormatIndex := FORMAT_SHORT_DATETIME; + nfFmtDateTime: + begin + fmt := lowercase(FFormattingStyles[i].NumberFormatStr); + if (fmt = 'dm') or (fmt = 'd-mmm') or (fmt = 'd mmm') or (fmt = 'd. mmm') or (fmt = 'd/mmm') then + lFormatIndex := FORMAT_DATE_DM + else + if (fmt = 'my') or (fmt = 'mmm-yy') or (fmt = 'mmm yy') or (fmt = 'mmm/yy') then + lFormatIndex := FORMAT_DATE_MY + else + if (fmt = 'ms') or (fmt = 'nn:ss') or (fmt = 'mm:ss') then + lFormatIndex := FORMAT_TIME_MS + else + if (fmt = 'msz') or (fmt = 'nn:ss.zzz') or (fmt = 'mm:ss.zzz') or (fmt = 'mm:ss.0') or (fmt = 'mm:ss.z') or (fmt = 'nn:ss.z') then + lFormatIndex := FORMAT_TIME_MSZ + end; + nfTimeInterval: + lFormatIndex := FORMAT_TIME_INTERVAL; end; - end; if uffBorder in FFormattingStyles[i].UsedFormattingFields then lBorders := FFormattingStyles[i].Border; @@ -1451,47 +1504,127 @@ begin Result:=Number; end; -function TsSpreadBIFF8Reader.IsDate(Number: Double; - ARow: WORD; ACol: WORD; AXFIndex: WORD; var ADateTime: TDateTime): boolean; -// Try to find out if a cell has a date/time and return -// TheDate if it is +procedure TsSpreadBIFF8Reader.ExtractNumberFormat(AXFIndex: WORD; + out ANumberFormat: TsNumberFormat; out ADecimals: Word; + out ANumberFormatStr: String); +const + { see ➜ 5.49 } + NOT_USED = nfGeneral; + fmts: array[1..58] of TsNumberFormat = ( + nfFixed, nfFixed, nfFixedTh, nfFixedTh, nfFixedTh, // 1..5 + nfFixedTh, nfFixedTh, nfFixedTh, nfPercentage, nfPercentage, // 6..10 + nfExp, NOT_USED, NOT_USED, nfShortDate, nfShortDate, // 11..15 + nfFmtDateTime, nfFmtDateTime, nfShortTimeAM, nfLongTimeAM, nfShortTime, // 16..20 + nfLongTime, nfShortDateTime, NOT_USED, NOT_USED, NOT_USED, // 21..25 + NOT_USED, NOT_USED, NOT_USED, NOT_USED, NOT_USED, // 26..30 + NOT_USED, NOT_USED, NOT_USED, NOT_USED, NOT_USED, // 31..35 + NOT_USED, nfFixedTh, nfFixedTh, nfFixedTh, nfFixedTh, // 36..40 + nfFixedTh, nfFixedTh, nfFixedTh, nfFixedTh, nfFmtDateTime, // 41..45 + nfTimeInterval, nfFmtDateTime, nfSci, NOT_USED, NOT_USED, // 46..50 + NOT_USED, NOT_USED, NOT_USED, NOT_USED, NOT_USED, // 51..55 + NOT_USED, NOT_USED, NOT_USED // 56..58 + ); + decs: array[1..58] of word = ( + 0, 2, 0, 2, 0, 0, 2, 2, 0, 2, // 1..10 + 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 11..20 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 21..30 + 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, // 31..40 + 0, 0, 2, 2, 0, 3, 0, 1, 0, 0, // 41..50 #48 is "scientific", use "exponential" instead + 0, 0, 0, 0, 0, 0, 0, 0); // 51..58 var lFormatData: TFormatRecordData; lXFData: TXFRecordData; + isAMPM: Boolean; + isLongTime: Boolean; + isMilliSec: Boolean; + t,d: Boolean; begin - result := false; - // Try to figure out if the number is really a number of a date or time value - // See: http://www.gaia-gis.it/FreeXL/freexl-1.0.0a-doxy-doc/Format.html - // Unfornately Excel doesnt give us a direct way to find this, - // we need to guess by the FORMAT field - // Note FindFormatRecordForCell will not retrieve default format numbers + ANumberFormat := nfGeneral; + ANumberFormatStr := ''; + ADecimals := 0; + lFormatData := FindFormatRecordForCell(AXFIndex); {Record FORMAT, BIFF8 (5.49): Offset Size Contents 0 2 Format index used in other records } - if lFormatData=nil then - begin - // No custom format, so first test for default formats - lXFData := TXFRecordData(FXFList.Items[AXFIndex]); - if (lXFData.FormatIndex in [14..22, 27..36, 45, 46, 47, 50..58]) then - begin - ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode); - Exit(true); + if lFormatData = nil then begin + // no custom format, so first test for default formats + lXFData := TXFRecordData (FXFList.Items[AXFIndex]); + case lXFData.FormatIndex of + FORMAT_DATE_DM: + begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'DM'; end; + FORMAT_DATE_MY: + begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'MY'; end; + FORMAT_TIME_MS: + begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'MS'; end; + FORMAT_TIME_MSZ: + begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'MSZ'; end; + else + if (lXFData.FormatIndex > 0) and (lXFData.FormatIndex <= 58) then begin + ANumberFormat := fmts[lXFData.FormatIndex]; + ADecimals := decs[lXFData.FormatIndex]; + end; end; - end + end else + // Check custom formats if they have / in format string (this can fail for + // custom text formats) + if IsPercentNumberFormat(lFormatData.FormatString, ADecimals) then + ANumberFormat := nfPercentage else - begin - // Check custom formats if they - // have / in format string (this can fail for custom text formats) - if (Pos('/', lFormatData.FormatString) > 0) then - begin - ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode); - Exit(true); + if IsExpNumberFormat(lFormatData.Formatstring, ADecimals) then + ANumberFormat := nfExp + else + if IsThousandSepNumberFormat(lFormatData.FormatString, ADecimals) then + ANumberFormat := nfFixedTh + else + if IsFixedNumberFormat(lFormatData.FormatString, ADecimals) then + ANumberFormat := nfFixed + else begin + t := IsTimeFormat(lFormatData.FormatString, isLongTime, isAMPM, isMilliSec); + d := IsDateFormat(lFormatData.FormatString); + if d and t then + ANumberFormat := nfShortDateTime + else + if d then + ANumberFormat := nfShortDate + else + if t then begin + if isAMPM then begin + if isLongTime then + ANumberFormat := nfLongTimeAM + else + ANumberFormat := nfShortTimeAM; + end else begin + if isLongTime then + ANumberFormat := nfLongTime + else + ANumberFormat := nfShortTime; + end; end; end; - ADateTime := 0; +end; + +function TsSpreadBIFF8Reader.IsDateTime(Number: Double; + ANumberFormat: TsNumberFormat; var ADateTime: TDateTime): boolean; +// Convert the number to a date/time and return that if it is +begin + if ANumberFormat in [ + nfShortDateTime, nfFmtDateTime, nfShortDate, + nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM] then + begin + ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode); + Result := true; + end else + if ANumberFormat = nfTimeInterval then begin + ADateTime := Number; + Result := true; + end else + begin + ADateTime := 0; + Result := false; + end; end; function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream; @@ -1718,6 +1851,9 @@ var ARow, ACol, XF: WORD; lDateTime: TDateTime; Number: Double; + nf: TsNumberFormat; // Number format + nd: word; // decimals + nfs: String; // Number format string begin {Retrieve XF record, row and column} ReadRowColXF(AStream,ARow,ACol,XF); @@ -1729,10 +1865,11 @@ begin Number:=DecodeRKValue(RK); {Find out what cell type, set contenttype and value} - if IsDate(Number, ARow, ACol, XF, lDateTime) then - FWorksheet.WriteDateTime(ARow, ACol, lDateTime) + ExtractNumberFormat(XF, nf, nd, nfs); + if IsDateTime(Number, nf, lDateTime) then + FWorksheet.WriteDateTime(ARow, ACol, lDateTime, nf, nfs) else - FWorksheet.WriteNumber(ARow,ACol,Number); + FWorksheet.WriteNumber(ARow, ACol, Number, nf); end; procedure TsSpreadBIFF8Reader.ReadMulRKValues(const AStream: TStream); @@ -1742,6 +1879,9 @@ var Pending: integer; RK: DWORD; Number: Double; + nf: TsNumberFormat; + nd: word; + nfs: String; begin ARow:=WordLEtoN(AStream.ReadWord); fc:=WordLEtoN(AStream.ReadWord); @@ -1751,10 +1891,11 @@ begin RK:=DWordLEtoN(AStream.ReadDWord); Number:=DecodeRKValue(RK); {Find out what cell type, set contenttype and value} - if IsDate(Number, ARow, fc, XF, lDateTime) then - FWorksheet.WriteDateTime(ARow, fc, lDateTime) + ExtractNumberFormat(XF, nf, nd, nfs); + if IsDateTime(Number, nf, lDateTime) then + FWorksheet.WriteDateTime(ARow, fc, lDateTime, nf, nfs) else - FWorksheet.WriteNumber(ARow,fc,Number); + FWorksheet.WriteNumber(ARow, fc, Number, nf, nd); inc(fc); dec(Pending,(sizeof(XF)+sizeof(RK))); end; @@ -1941,6 +2082,9 @@ var ARow, ACol, XF: Word; AValue: Double; lDateTime: TDateTime; + nf: TsNumberFormat; + nd: word; + nfs: String; begin {Retrieve XF record, row and column} ReadRowColXF(AStream,ARow,ACol,XF); @@ -1949,10 +2093,11 @@ begin AStream.ReadBuffer(AValue, 8); {Find out what cell type, set contenttype and value} - if IsDate(AValue, ARow, ACol, XF, lDateTime) then - FWorksheet.WriteDateTime(ARow, ACol, lDateTime) + ExtractNumberFormat(XF, nf, nd, nfs); + if IsDateTime(AValue, nf, lDateTime) then + FWorksheet.WriteDateTime(ARow, ACol, lDateTime, nf, nfs) else - FWorksheet.WriteNumber(ARow,ACol,AValue); + FWorksheet.WriteNumber(ARow,ACol,AValue,nf,nd); end; procedure TsSpreadBIFF8Reader.ReadRichString(const AStream: TStream); diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 51232c182..db8cdc105 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -137,10 +137,30 @@ const DATEMODE_1904_BASE=1462; //1/1/1904 in FPC TDateTime { FORMAT record constants } - // Just a subset; needed for output to date/time records - FORMAT_GENERAL = 0; //general/default format - FORMAT_SHORT_DATE = 14; //short date - FORMAT_SHORT_DATETIME = 22; //short date+time + // Subset of the built-in formats for US Excel, + // including those needed for date/time output + FORMAT_GENERAL = 0; //general/default format + FORMAT_FIXED_0_DECIMALS = 1; //fixed, 0 decimals + FORMAT_FIXED_2_DECIMALS = 2; //fixed, 2 decimals + FORMAT_FIXED_THOUSANDS_0_DECIMALS = 3; //fixed, w/ thousand separator, 0 decs + FORMAT_FIXED_THOUSANDS_2_DECIMALS = 4; //fixed, w/ thousand separator, 2 decs + FORMAT_CURRENCY_0_DECIMALS = 5; //currency (with currency symbol), 0 decs + FORMAT_CURRENCY_2_DECIMALS = 7; //currency (with currency symbol), 2 decs + FORMAT_PERCENT_0_DECIMALS = 9; //percent, 0 decimals + FORMAT_PERCENT_2_DECIMALS = 10; //percent, 2 decimals + FORMAT_EXP_2_DECIMALS = 11; //exponent, 2 decimals + FORMAT_SCI_1_DECIMAL = 48; //scientific, 1 decimal + FORMAT_SHORT_DATE = 14; //short date + FORMAT_DATE_DM = 16; //date D-MMM + FORMAT_DATE_MY = 17; //date MMM-YYYY + FORMAT_SHORT_TIME_AM = 18; //short time H:MM with AM + FORMAT_LONG_TIME_AM = 19; //long time H:MM:SS with AM + FORMAT_SHORT_TIME = 20; //short time H:MM + FORMAT_LONG_TIME = 21; //long time H:MM:SS + FORMAT_SHORT_DATETIME = 22; //short date+time + FORMAT_TIME_MS = 45; //time MM:SS + FORMAT_TIME_MSZ = 47; //time MM:SS.0 + FORMAT_TIME_INTERVAL = 46; //time [hh]:mm:ss, hh can be >24 type @@ -191,6 +211,15 @@ type constructor Create; override; end; +function IsExpNumberFormat(s: String; out Decimals: Word): Boolean; +function IsFixedNumberFormat(s: String; out Decimals: Word): Boolean; +function IsPercentNumberFormat(s: String; out Decimals: Word): Boolean; +function IsThousandSepNumberFormat(s: String; out Decimals: Word): Boolean; + +function IsDateFormat(s: String): Boolean; +function IsTimeFormat(s: String; out isLong, isAMPM, isMillisec: Boolean): Boolean; + + implementation function ConvertExcelDateTimeToDateTime( @@ -467,5 +496,201 @@ begin FDateMode := dm1900; end; + +{ Format checking procedures } + +{ This simple parsing procedure of the Excel format string checks for a fixed + float format s, i.e. s can be '0', '0.00', '000', '0,000', and returns the + number of decimals, i.e. number of zeros behind the decimal point } +function IsFixedNumberFormat(s: String; out Decimals: Word): Boolean; +var + i: Integer; + p: Integer; + decs: String; +begin + Decimals := 0; + + // Check if s is a valid format mask. + try + FormatFloat(s, 1.0); + except + on EConvertError do begin + Result := false; + exit; + end; + end; + + // If it is count the zeros - each one is a decimal. + if s = '0' then + Result := true + else begin + p := pos('.', s); // position of decimal point; + if p = 0 then begin + Result := false; + end else begin + Result := true; + for i:= p+1 to Length(s) do + if s[i] = '0' then begin + inc(Decimals) + end + else + exit; // ignore characters after the last 0 + end; + end; +end; + +{ This function checks whether the format string corresponds to a thousand + separator format like "#,##0.000' and returns the number of fixed decimals + (i.e. zeros after the decimal point) } +function IsThousandSepNumberFormat(s: String; out Decimals: Word): Boolean; +var + i, p: Integer; +begin + Decimals := 0; + + // Check if s is a valid format string + try + FormatFloat(s, 1.0); + except + on EConvertError do begin + Result := false; + exit; + end; + end; + + // If it is look for the thousand separator. If found count decimals. + Result := (Pos(',', s) > 0); + if Result then begin + p := pos('.', s); + if p > 0 then + for i := p+1 to Length(s) do + if s[i] = '0' then + inc(Decimals) + else + exit; // ignore format characters after the last 0 + end; +end; + + +{ This function checks whether the format string corresponds to percent + formatting and determines the number of decimals } +function IsPercentNumberFormat(s: String; out Decimals: Word): Boolean; +var + i, p: Integer; +begin + Decimals := 0; + // The signature of the percent format is a percent sign at the end of the + // format string. + Result := (s <> '') and (s[Length(s)] = '%'); + if Result then begin + // Check for a valid format string + Delete(s, Length(s), 1); + try + FormatDateTime(s, 1.0); + except + on EConvertError do begin + Result := false; + exit; + end; + end; + // Count decimals + p := pos('.', s); + if p > 0 then + for i := p+1 to Length(s)-1 do + if s[i] = '0' then + inc(Decimals) + else + exit; // ignore characters after last 0 + end; +end; + +{ This function checks whether the format string corresponds to exponential + formatting and determines the number decimals } +function IsExpNumberFormat(s: String; out Decimals: Word): Boolean; +var + i, p, pe: Integer; +begin + Decimals := 0; + + // Check for a valid format string + try + FormatDateTime(s, 1.0); + except + on EConvertError do begin + Result := false; + exit; + end; + end; + + // Count decimals + pe := pos('e', lowercase(s)); + result := pe > 0; + if Result then begin + p := pos('.', s); + if (p > 0) then begin + if p < pe then + for i:=1 to pe-1 do + if s[i] = '0' then + inc(Decimals) + else + exit; // ignore characters after last 0 + end; + end; +end; + +{ IsDateFormat checks if the format string s corresponds to a date format } +function IsDateFormat(s: String): Boolean; +begin + // Day, month, year are separated by a slash + Result := (pos('/', s) > 0); + if Result then + // Check validity of format string + try + FormatDateTime(s, now); + except on EConvertError do + Result := false; + end; +end; + +{ IsTimeFormat checks if the format string s is a time format. isLong is + true if the string contains hours, minutes and seconds (two colons). + isAMPM is true if the string contains "AM/PM", "A/P" or "AMPM". + isMilliSec is true if the string ends with a "z". } +function IsTimeFormat(s: String; out isLong, isAMPM, isMillisec: Boolean): Boolean; +var + p, i, count: Integer; +begin + // Time parts are separated by a colon + p := pos(':', s); + isLong := false; + isAMPM := false; + result := p > 0; + + if Result then begin + count := 1; + s := Uppercase(s); + + // If there are is a second colon s is a "long" time format + for i:=p+1 to Length(s) do + if s[i] = ':' then begin + isLong := true; + break; + end; + + // Seek for "AM/PM" etc to detect that specific format + isAMPM := (pos('AM/PM', s) > 0) or (pos('A/P', s) > 0) or (pos('AMPM', s) > 0); + + // Look for the "milliseconds" character z + isMilliSec := (s[Length(s)] = 'Z'); + + // Check validity of format string + try + FormatDateTime(s, now); + except on EConvertError do + Result := false; + end; + end; +end; + end. diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index d11053ce3..2e1e00a06 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -75,6 +75,7 @@ type //todo: add WriteDate 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 WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; end; implementation @@ -517,6 +518,16 @@ begin Format(' %s', [CellPosText, CellValueText]) + LineEnding; end; +{ + Writes the date/time as a text to the sheet. + No further formatting applied. +} +procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream; + const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); +begin + WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell); +end; + { Registers this reader / writer on fpSpreadsheet }