diff --git a/components/fpspreadsheet/source/common/xlscommon.pas b/components/fpspreadsheet/source/common/xlscommon.pas index e038ff031..3cd2ea545 100644 --- a/components/fpspreadsheet/source/common/xlscommon.pas +++ b/components/fpspreadsheet/source/common/xlscommon.pas @@ -499,7 +499,7 @@ type procedure ReadMulBlank(AStream: TStream); // Read multiple RK cells procedure ReadMulRKValues(const AStream: TStream); - // Read floating point number + // Read floating point number (or date/time) procedure ReadNumber(AStream: TStream); override; // Read OBJECTPROTECT record procedure ReadObjectProtect(AStream: TStream; @@ -827,7 +827,6 @@ begin case ADateMode of dm1900: begin - { Result := AExcelDateNum + DATEMODE_1900_BASE - 1.0; // Excel and Lotus 1-2-3 incorrectly assume that 1900 was a leap year // Therefore all dates before March 01 are off by 1. @@ -835,7 +834,7 @@ begin // wrong! if AExcelDateNum < 61 then Result := Result + 1.0; - } + (* // Check for Lotus 1-2-3 bug with 1900 leap year if AExcelDateNum=61.0 then @@ -844,6 +843,7 @@ begin result := 61.0 - 1.0 + DATEMODE_1900_BASE - 1.0 else result := AExcelDateNum + DATEMODE_1900_BASE - 1.0; + *) end; dm1904: result := AExcelDateNum + DATEMODE_1904_BASE; @@ -867,7 +867,7 @@ begin dm1900: begin Result := ADateTime - DATEMODE_1900_BASE + 1.0; - // if Result < 61 then Result := Result - 1.0; + if Result < 61 then Result := Result - 1.0; end; dm1904: Result := ADateTime - DATEMODE_1904_BASE; @@ -2250,7 +2250,7 @@ begin end else cell := sheet.AddCell(ARow, ACol); // "real" cell - if IsDateTime(value, nf, nfs, dt) then + if IsDateTime(value, nf, nfs, dt) then // Year-1900 correction occurs here! sheet.WriteDateTime(cell, dt, nf, nfs) else if nf = nfText then sheet.WriteText(cell, GeneralFormatFloat(value, FWorkbook.FormatSettings)) @@ -4186,8 +4186,17 @@ procedure TsSpreadBIFFWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); var ExcelDateSerial: double; + cf: TsCellFormat; + nfp: TsNumFormatParams; begin - ExcelDateSerial := ConvertDateTimeToExcelDateTime(AValue, FDateMode); + // We must correct the bug of Lotus 1-2-3 which had ignored that year 1900 was + // a leap year, but only for "normal" date format, not for time-interval formats + cf := TsWorksheet(FWorksheet).ReadCellFormat(ACell); + nfp := TsWorkbook(FWorkbook).GetNumberFormat(cf.NumberFormatIndex); + if IsTimeIntervalFormat(nfp) then //or IsTimeFormat(nfp) then + ExcelDateSerial := AValue + else + ExcelDateSerial := ConvertDateTimeToExcelDateTime(AValue, FDateMode); // fpspreadsheet must already have set formatting to a date/datetime format, so // this will get written out as a pointer to the relevant XF record. // In the end, dates in xls are just numbers with a format. Pass it on to WriteNumber: diff --git a/components/fpspreadsheet/source/common/xlsxml.pas b/components/fpspreadsheet/source/common/xlsxml.pas index ae0b76534..144251b91 100644 --- a/components/fpspreadsheet/source/common/xlsxml.pas +++ b/components/fpspreadsheet/source/common/xlsxml.pas @@ -2739,25 +2739,34 @@ end; procedure TsSpreadExcelXMLWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); var - valueStr: String; + valueStr: String = ''; ExcelDate: TDateTime; nfp: TsNumFormatParams; fmt: PsCellFormat; begin Unused(ARow, ACol); - ExcelDate := AValue; fmt := (FWorkbook as TsWorkbook).GetPointerToCellFormat(ACell^.FormatIndex); - // Times have an offset of 1 day! if (fmt <> nil) and (uffNumberFormat in fmt^.UsedFormattingFields) then begin nfp := (FWorkbook as TsWorkbook).GetNumberFormat(fmt^.NumberFormatIndex); + if IsTimeIntervalFormat(nfp) then + valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', AValue); + { if IsTimeIntervalFormat(nfp) or IsTimeFormat(nfp) then + begin case FDateMode of dm1900: ExcelDate := AValue + DATEMODE_1900_BASE; dm1904: ExcelDate := AValue + DATEMODE_1904_BASE; end; + valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', AValue); + end; + } + end; + if valueStr = '' then + begin + ExcelDate := ConvertDateTimeToExcelDateTime(AValue, FDateMode); + valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', ExcelDate); end; - valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', ExcelDate); AppendToStream(AStream, Format(CELL_INDENT + '' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge diff --git a/components/fpspreadsheet/source/common/xlsxooxml.pas b/components/fpspreadsheet/source/common/xlsxooxml.pas index 3094b3fa1..706affd4d 100644 --- a/components/fpspreadsheet/source/common/xlsxooxml.pas +++ b/components/fpspreadsheet/source/common/xlsxooxml.pas @@ -239,7 +239,6 @@ type procedure WriteMedia(AZip: TZipper); protected { Record writing methods } - //todo: add WriteDate procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; @@ -7355,8 +7354,17 @@ procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); var ExcelDateSerial: double; + cf: TsCellFormat; + nfp: TsNumFormatParams; begin - ExcelDateSerial := ConvertDateTimeToExcelDateTime(AValue, FDateMode); + // We must correct the bug of Lotus 1-2-3 which had ignored that year 1900 was + // a leap year, but only for "normal" date format, not for time-interval formats + cf := TsWorksheet(FWorksheet).ReadCellFormat(ACell); + nfp := TsWorkbook(FWorkbook).GetNumberFormat(cf.NumberFormatIndex); + if IsTimeIntervalFormat(nfp) then + ExcelDateSerial := AValue + else + ExcelDateSerial := ConvertDateTimeToExcelDateTime(AValue, FDateMode); WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell); end; diff --git a/components/fpspreadsheet/tests/datetests.pas b/components/fpspreadsheet/tests/datetests.pas index 1ac6732fa..4d865c2a9 100644 --- a/components/fpspreadsheet/tests/datetests.pas +++ b/components/fpspreadsheet/tests/datetests.pas @@ -307,6 +307,23 @@ type procedure TestWriteReadMilliseconds_XML; end; + { TSpreadWriteReadYear1900Tests } + { Tests to check whether the year-1900 bug in Excel is handled correctly } + TSpreadWriteReadYear1900Tests = class(TTestCase) + private + protected + procedure Setup; override; + procedure TearDown; override; + procedure TestWriteReadYear1900Dates(AFormat: TsSpreadsheetFormat); + published + procedure TestWriteReadYear1900Dates_BIFF2; + procedure TestWriteReadYear1900Dates_BIFF5; + procedure TestWriteReadYear1900Dates_BIFF8; + procedure TestWriteReadYear1900Dates_ODS; + procedure TestWriteReadYear1900Dates_OOXML; + procedure TestWriteReadYear1900Dates_XML; + end; + implementation @@ -405,7 +422,11 @@ begin MyWorkSheet:=MyWorkBook.AddWorksheet(DatesSheet); for Row := Low(SollDates) to High(SollDates) do begin - MyWorkSheet.WriteDateTime(Row, 0, SollDates[Row], nfShortDateTime); + // The last two test dates are assumed to be formatted as time-interval + if Row >= High(SollDates) then + MyWorksheet.WriteDateTime(Row, 0, SollDates[Row], nfCustom, '[h]:nn:ss') + else + MyWorkSheet.WriteDateTime(Row, 0, SollDates[Row], nfShortDateTime); // Some checks inside worksheet itself if not(MyWorkSheet.ReadAsDateTime(Row,0,ActualDateTime)) then Fail('Failed writing date time for cell '+CellNotation(MyWorkSheet,Row)); @@ -1828,10 +1849,194 @@ begin end; +{ =============================================================================} + +var + Y1900_SollDates: array of TDate; + Y1900_SollTimes: array of TTime; + Y1900_SollIntervals: array of TDateTime; + +procedure InitY1900_SollDates; +begin + SetLength(Y1900_SollDates, 5); + Y1900_SollDates[0] := EncodeDate(1900, 1, 1); + Y1900_SollDates[1] := EncodeDate(1900, 1, 2); + Y1900_SollDates[2] := EncodeDate(1900, 2, 28); + Y1900_SollDates[3] := Encodedate(1900, 3, 1); + Y1900_SollDates[4] := Encodedate(1900, 3, 2); + + SetLength(Y1900_SollTimes, 3); + Y1900_SollTimes[0] := EncodeTime(0, 0, 0, 0); + Y1900_SollTimes[1] := EncodeTime(12, 0, 0, 0); + Y1900_SollTimes[2] := EncodeTime(23, 59, 59, 0); + + SetlengtH(Y1900_SollIntervals, 7); + Y1900_SollIntervals[0] := EncodeTime(0, 0, 0, 0); + Y1900_SollIntervals[1] := EncodeTime(23, 59, 59, 0); + Y1900_SollIntervals[2] := EncodeTime(23, 59, 59, 0) + 1.0; + Y1900_SollIntervals[3] := EncodeTime(23, 59, 59, 0) + 59.0; + Y1900_SollIntervals[4] := EncodeTime(23, 59, 59, 0) + 60.0; + Y1900_SollIntervals[5] := EncodeTime(23, 59, 59, 0) + 61.0; + Y1900_SollIntervals[6] := EncodeTime(23, 59, 59, 0) + 62.0; +end; + +procedure TSpreadWriteReadYear1900Tests.Setup; +begin + inherited; + InitY1900_SollDates; +end; + +procedure TSpreadWriteReadYear1900Tests.TearDown; +begin + inherited; +end; + +procedure TSpreadWriteReadYear1900Tests.TestWriteReadYear1900Dates(AFormat: TsSpreadsheetFormat); +var + book: TsWorkbook; + sheet: TsWorksheet; + r: Cardinal; + i: Integer; + actualDateTime: TDateTime; + ok: boolean; + cell: PCell; + tempFile: String; + ErrorMargin: TDateTime; //margin for error in comparison test +begin + ErrorMargin := 1E-5/(24*60*60*1000); // = 10 nsec = 1E-8 sec (1 ns fails) + tempFile := NewTempFile; + + book := TsWorkbook.Create; + try + sheet := book.Addworksheet('Year1900'); + r := 0; + for i := Low(Y1900_SollDates) to High(Y1900_SollDates) do + begin + sheet.WriteDateTime(r, 0, Y1900_SollDates[i], nfShortDateTime); + ok := sheet.ReadAsDateTime(r, 0, actualDateTime); + CheckEquals(true, ok, + 'Test date detection error, cell '+CellNotation(sheet, r)); + CheckEquals(Y1900_SollDates[i], actualDateTime, + 'Test date value memory reading mismatch, cell '+CellNotation(sheet, r)); + inc(r); + end; + + for i := Low(Y1900_SollTimes) to High(Y1900_SollTimes) do + begin + sheet.WriteDateTime(r, 0, Y1900_SollTimes[i], nfLongTime); + ok := sheet.ReadAsDateTime(r, 0, actualDateTime); + CheckEquals(true, ok, + 'Test time detection error, cell '+CellNotation(sheet, r)); + CheckEquals(Y1900_SollTimes[i], actualDateTime, ErrorMargin, + 'Test time value memory reading mismatch, cell '+CellNotation(sheet, r)); + inc(r); + end; + + for i := Low(Y1900_SollIntervals) to High(Y1900_SollIntervals) do + begin + sheet.WriteDateTime(r, 0, Y1900_SollIntervals[i], nfCustom, '[h]:nn:ss'); + ok := sheet.ReadAsDateTime(r, 0, actualDateTime); + CheckEquals(true, ok, + 'Test time detection error, cell '+CellNotation(sheet, r)); + CheckEquals(Y1900_SollIntervals[i], actualDateTime, ErrorMargin, + 'Test interval value memory reading mismatch, cell '+CellNotation(sheet, r)); + inc(r); + end; + + book.WriteToFile(tempFile, AFormat, true); + finally + book.Free; + end; + + book := TsWorkbook.Create; + try + book.ReadFromFile(tempFile, AFormat); + sheet := book.GetFirstWorksheet; + r := 0; + for i := Low(Y1900_SollDates) to High(Y1900_SollDates) do + begin + ok := sheet.ReadAsDateTime(r, 0, actualDateTime); + CheckEquals(true, ok, + 'Test date detection error, cell '+CellNotation(sheet, r)); + CheckEquals(Y1900_SollDates[i], actualDateTime, + 'Test date value file reading mismatch, cell '+CellNotation(sheet, r)); + inc(r); + end; + for i := Low(Y1900_SollTimes) to High(Y1900_SollTimes) do + begin + ok := sheet.ReadAsDateTime(r, 0, actualDateTime); + CheckEquals(true, ok, + 'Test time detection error, cell '+CellNotation(sheet, r)); + CheckEquals(Y1900_SollTimes[i], actualDateTime, ErrorMargin, + 'Test time value file reading mismatch, cell '+CellNotation(sheet, r)); + inc(r); + end; + for i := Low(Y1900_SollIntervals) to High(Y1900_SollIntervals) do + begin + ok := sheet.ReadAsDateTime(r, 0, actualDateTime); + CheckEquals(true, ok, + 'Test interval detection error, cell '+CellNotation(sheet, r)); + CheckEquals(Y1900_SollIntervals[i], actualDateTime, ErrorMargin, + 'Test interval value file reading mismatch, cell '+CellNotation(sheet, r)); + inc(r); + end; + finally + book.Free; + end; + DeleteFile(TempFile); +end; + +procedure TSpreadWriteReadYear1900Tests.TestWriteReadYear1900Dates_BIFF2; +begin + TestWriteReadYear1900Dates(sfExcel2); +end; + +procedure TSpreadWriteReadYear1900Tests.TestWriteReadYear1900Dates_BIFF5; +begin + TestWriteReadYear1900Dates(sfExcel5); +end; + +procedure TSpreadWriteReadYear1900Tests.TestWriteReadYear1900Dates_BIFF8; +begin + TestWriteReadYear1900Dates(sfExcel8); +end; + +procedure TSpreadWriteReadYear1900Tests.TestWriteReadYear1900Dates_ODS; +begin + TestWriteReadYear1900Dates(sfOpenDocument); +end; + +procedure TSpreadWriteReadYear1900Tests.TestWriteReadYear1900Dates_OOXML; +begin + TestWriteReadYear1900Dates(sfOOXML); +end; + +procedure TSpreadWriteReadYear1900Tests.TestWriteReadYear1900Dates_XML; +begin + TestWriteReadYear1900Dates(sfExcelXML); +end; + + +{ +begin +end; +published + procedure TestWriteReadYear1900Dates_BIFF2; + procedure TestWriteReadYear1900Dates_BIFF5; + procedure TestWriteReadYear1900Dates_BIFF8; + procedure TestWriteReadYear1900Dates_ODS; + procedure TestWriteReadYear1900Dates_OOXML; + procedure TestWriteReadYear1900Dates_XML; +end; + } + + initialization // Register so these tests are included in a full run RegisterTest(TSpreadReadDateTests); RegisterTest(TSpreadWriteReadDateTests); + RegisterTest(TSpreadWriteReadYear1900Tests); + InitSollDates; //useful to have norm data if other code want to use this unit finalization