You've already forked lazarus-ccr
fpspreadsheet: Fixing Year-1900 date/time issue in Excel files for fps.
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
@ -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:
|
||||
|
||||
@ -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 +
|
||||
'<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user