pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Fixing Year-1900 date/time issue in Excel files for fps.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8032 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-05-15 17:23:04 +00:00
parent 1a7f560057
commit 1efc3bc6f2
4 changed files with 244 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
components/fpspreadsheet/source/common/xlscommon.pas
View File

@ -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,7 +4186,16 @@ procedure TsSpreadBIFFWriter.WriteDateTime(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
var
ExcelDateSerial: double;
cf: TsCellFormat;
nfp: TsNumFormatParams;
begin
// 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.

15
components/fpspreadsheet/source/common/xlsxml.pas
View File

@ -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;
AppendToStream(AStream, Format(CELL_INDENT +
'<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge

10
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -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,7 +7354,16 @@ procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
var
ExcelDateSerial: double;
cf: TsCellFormat;
nfp: TsNumFormatParams;
begin
// 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;

205
components/fpspreadsheet/tests/datetests.pas
View File

@ -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,6 +422,10 @@ begin
MyWorkSheet:=MyWorkBook.AddWorksheet(DatesSheet);
for Row := Low(SollDates) to High(SollDates) do
begin
// 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
@ -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