fpspreadsheet: Fix reading/writing of milliseconds. Add corresponding test cases. (NOTE: ods cannot display tenths of a second).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6228 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/source/common/fpsnumformat.pas

@@ -1080,9 +1080,9 @@ begin
 
         nftMilliseconds:
           case section.Elements[el].IntValue of
-            1: Result := Result + IntToStr(ms div 100);
+            1: Result := Result + IntToStr(round(ms/100));
-            2: Result := Result + Format('%02d', [ms div 10]);
+            2: Result := Result + Format('%.2d', [round(ms/10)]);
-            3: Result := Result + Format('%03d', [ms]);
+            3: Result := Result + Format('%.3d', [ms]);
           end;
 
         nftAMPM:
@@ -2902,6 +2902,10 @@ begin
           section^.Kind := section^.Kind + [nfkTime];
           if section^.Elements[el].IntValue < 0 then
             section^.Kind := section^.Kind + [nfkTimeInterval];
+          if section^.Elements[el].Token = nftMilliseconds then
+            section^.Decimals := section^.Elements[el].IntValue
+          else
+            section^.Decimals := 0;
         end;
       nftMonthMinute:
         isMonthMinute := true;
@@ -3690,12 +3694,25 @@ begin
         end;
       '.':
         begin
-          token := NextToken;
+          {
-          if token in ['z', '0'] then begin
+          AddElement(nftDecSep, FToken);
-            AddElement(nftDecSep, FToken);
+          FToken := NextToken;
-            FToken := NextToken;
+          if FToken in ['z', 'Z', '0'] then
+          begin
             ScanAndCount(FToken, n);
             AddElement(nftMilliseconds, n);
+          end;
+          }
+
+          token := NextToken;
+          if token in ['z', 'Z', '0'] then begin
+            AddElement(nftDecSep, FToken);
+            FToken := NextToken;
+            if FToken in ['z', 'Z', '0'] then
+              ScanAndCount(FToken, n)
+            else
+              n := 0;
+            AddElement(nftMilliseconds, n+1);
           end else begin
             AddElement(nftDateTimeSep, FToken);
             FToken := token;

components/fpspreadsheet/source/common/fpsopendocument.pas

@@ -689,6 +689,7 @@ var
   ns: Integer;
   clr: TsColor;
   mask: String;
+  s: String;
   timeIntervalStr: String;
   styleMapStr: String;
   int,num,denom: Integer;
@@ -954,9 +955,14 @@ begin
 
         nftSecond:
           begin
+            s := '';
+            if (el < nel - 2) and (Elements[el+1].Token = nftDecSep) and
+              (Elements[el+2].Token = nftMilliseconds)
+            then
+              s := Format('number:decimal-places="%d"', [Elements[el+2].IntValue]);
             case abs(Elements[el].IntValue) of
               1: Result := Result + '<number:seconds />';
-              2: Result := Result + '<number:seconds number:style="long" />';
+              2: Result := Result + '<number:seconds number:style="long" ' + s + '/>';
             end;
             if Elements[el].IntValue < 0 then
               timeIntervalStr := ' number:truncate-on-overflow="false"';
@@ -7898,6 +7904,7 @@ var
   fmt: TsCellFormat;
   numFmtParams: TsNumFormatParams;
   h,m,s,ms: Word;
+  mask: String;
 begin
   Unused(ARow, ACol);
 
@@ -7949,7 +7956,22 @@ begin
       isTimeOnly := Assigned(numFmtParams) and (numFmtParams.Sections[0].Kind * [nfkDate, nfkTime] = [nfkTime])
     else
       isTimeOnly := false;
+    // ODS wants the date/time in the ISO format.
     strValue := FormatDateTime(DATE_FMT[isTimeOnly], AValue);
+    // Add milliseconds; they must be appended as decimals to the seconds.
+    if Assigned(numFmtParams) and (nfkTime in numFmtParams.Sections[0].Kind) and
+       (numFmtParams.Sections[0].Decimals > 0) then
+    begin
+      strValue[Length(strValue)] := '.';  // replace trailing 'S' by '.'
+      // add value of milliseconds, rounded to required decimal places
+      DecodeTime(AValue, h,m,s,ms);
+      case numFmtParams.Sections[0].Decimals of
+        1: strValue := strValue + FormatFloat('0', round(ms/100));
+        2: strValue := strValue + FormatFloat('00', round(ms/10));
+        3: strValue := strValue + FormatFloat('000', ms);
+      end;
+      strValue := strValue + 'S';
+    end;
     displayStr := FWorksheet.ReadAsText(ACell);
     AppendToStream(AStream, Format(
       '<table:table-cell office:value-type="%s" office:%s-value="%s" %s %s>' +

components/fpspreadsheet/tests/datetests.pas

@@ -289,12 +289,20 @@ type
     // Reads dates, date/time and time values from spreadsheet and checks against list
     // One cell per test so some tests can fail and those further below may still work
     procedure TestWriteReadDates(AFormat: TsSpreadsheetFormat);
+    procedure TestWriteReadMilliseconds(AFormat: TsSpreadsheetFormat);
+
   published
     procedure TestWriteReadDates_BIFF2;
     procedure TestWriteReadDates_BIFF5;
     procedure TestWriteReadDates_BIFF8;
     procedure TestWriteReadDates_ODS;
     procedure TestWriteReadDates_OOXML;
+
+    procedure TestWriteReadMilliseconds_BIFF2;
+    procedure TestWriteReadMilliseconds_BIFF5;
+    procedure TestWriteReadMilliseconds_BIFF8;
+    procedure TestWriteReadMilliseconds_ODS;
+    procedure TestWriteReadMilliseconds_OOXML;
   end;
 
 
@@ -407,7 +415,7 @@ begin
     MyWorkbook.Free;
   end;
 
-  // Open the spreadsheet, as biff8
+  // Open the spreadsheet
   MyWorkbook := TsWorkbook.Create;
   try
     MyWorkbook.ReadFromFile(TempFile, AFormat);
@@ -432,6 +440,106 @@ begin
   end;
 end;
 
+procedure TSpreadWriteReadDateTests.TestWriteReadMilliseconds(
+  AFormat: TsSpreadsheetFormat);
+type
+  TMillisecondTestParam = record
+    h, m, s, ms: word;
+    str1, str2, str3: String;
+  end;
+const
+  SOLL_TIMES: array[0..2] of TMillisecondTestParam = (
+    (h:12; m: 0; s: 0; ms:  0; str1:'12:00:00.0'; str2:'12:00:00.00'; str3:'12:00:00.000'),
+    (h:23; m:59; s:59; ms: 10; str1:'23:59:59.0'; str2:'23:59:59.01'; str3:'23:59:59.010'),
+    (h:23; m:59; s:59; ms:191; str1:'23:59:59.2'; str2:'23:59:59.19'; str3:'23:59:59.191')
+  );
+  FORMAT_STRINGS: array[1..3] of string = (
+    'hh:nn:ss.z', 'hh:nn:ss.zz', 'hh:nn:ss.zzz');
+  EPS = 0.0005*60*60*24;  // 0.5 ms
+var
+  MyWorkbook: TsWorkbook;
+  MyWorksheet: TsWorksheet;
+  actualDateTime: TDateTime;
+  actualStr: String;
+  r, c: Cardinal;
+  h, m, s, ms: Word;
+  t: TTime;
+  tempFile: String;
+begin
+  tempFile := NewTempFile;
+
+  // Write out all test values
+  MyWorkbook := TsWorkbook.Create;
+  try
+    MyWorkbook.FormatSettings.DecimalSeparator := '.';
+    MyWorkSheet := MyWorkBook.AddWorksheet(DatesSheet);
+    for r := Low(SOLL_TIMES) to High(SOLL_TIMES) do
+    begin
+      with SOLL_TIMES[r] do t := EncodeTime(h, m, s, ms);
+      for c := Low(FORMAT_STRINGS) to High(FORMAT_STRINGS) do
+      begin
+        MyWorkSheet.WriteDateTime(r, c, t, FORMAT_STRINGS[c]);
+
+        // Some checks inside worksheet itself, before writing
+        if not(MyWorkSheet.ReadAsDateTime(r, c, actualDateTime)) then
+          Fail('Failed writing date time for cell '+CellNotation(MyWorkSheet, r, c));
+        CheckEquals(t, actualDateTime, EPS,
+          'Test date/time value mismatch cell '+CellNotation(MyWorksheet, r, c));
+        actualStr := MyWorksheet.ReadAsText(r, c);
+        case c of
+          1: CheckEquals(SOLL_TIMES[r].str1, actualstr,
+               'Cell string mismatch, cell '+CellNotation(Myworksheet, r, c));
+          2: CheckEquals(SOLL_TIMES[r].str2, actualstr,
+               'Cell string mismatch, cell '+CellNotation(Myworksheet, r, c));
+          3: CheckEquals(SOLL_TIMES[r].str3, actualstr,
+               'Cell string mismatch, cell '+CellNotation(Myworksheet, r, c));
+        end;
+      end;
+    end;
+    MyWorkBook.WriteToFile(TempFile, AFormat, true);
+  finally
+    MyWorkbook.Free;
+  end;
+
+  // Open the spreadsheet
+  MyWorkbook := TsWorkbook.Create;
+  try
+    MyWorkbook.FormatSettings.DecimalSeparator := '.';
+    MyWorkbook.ReadFromFile(TempFile, AFormat);
+    if AFormat = sfExcel2 then
+      MyWorksheet := MyWorkbook.GetFirstWorksheet
+    else
+      MyWorksheet := GetWorksheetByName(MyWorkBook,DatesSheet);
+    if MyWorksheet=nil then
+      fail('Error in test code. Failed to get named worksheet');
+
+    // Read test data from A column & compare if written=original
+    for r := Low(SOLL_TIMES) to High(SOLL_TIMES) do
+    begin
+      with SOLL_TIMES[r] do t := EncodeTime(h, m, s, ms);
+      for c := Low(FORMAT_STRINGS) to High(FORMAT_STRINGS) do begin
+        if not(MyWorkSheet.ReadAsDateTime(r, c, actualDateTime)) then
+          Fail('Could not read date time for cell '+CellNotation(MyWorkSheet, r, c));
+        CheckEquals(r, actualDateTime, EPS,
+          'Test date/time value mismatch cell '+CellNotation(MyWorkSheet, r, c));
+        actualStr := MyWorksheet.ReadAsText(r, c);
+        case c of
+          1: CheckEquals(SOLL_TIMES[r].str1, actualstr,
+               'Cell string mismatch, cell '+CellNotation(Myworksheet, r, c));
+          2: CheckEquals(SOLL_TIMES[r].str2, actualstr,
+               'Cell string mismatch, cell '+CellNotation(Myworksheet, r, c));
+          3: CheckEquals(SOLL_TIMES[r].str3, actualstr,
+               'Cell string mismatch, cell '+CellNotation(Myworksheet, r, c));
+        end;
+      end;
+    end;
+  finally
+    MyWorkbook.Free;
+    DeleteFile(TempFile);
+  end;
+
+end;
+
 procedure TSpreadWriteReadDateTests.TestWriteReadDates_BIFF2;
 begin
   TestWriteReadDates(sfExcel2);
@@ -1680,6 +1788,33 @@ begin
   TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileOOXML_1899,37);
 end;
 
+//------------------------------------------------------------------------------
+
+procedure TSpreadWriteReadDateTests.TestWriteReadMilliseconds_BIFF2;
+begin
+  TestWriteReadMilliseconds(sfExcel2);
+end;
+
+procedure TSpreadWriteReadDateTests.TestWriteReadMilliseconds_BIFF5;
+begin
+  TestWriteReadMilliseconds(sfExcel5);
+end;
+
+procedure TSpreadWriteReadDateTests.TestWriteReadMilliseconds_BIFF8;
+begin
+  TestWriteReadMilliseconds(sfExcel8);
+end;
+
+procedure TSpreadWriteReadDateTests.TestWriteReadMilliseconds_ODS;
+begin
+  TestWriteReadMilliseconds(sfOpenDocument);
+end;
+
+procedure TSpreadWriteReadDateTests.TestWriteReadMilliseconds_OOXML;
+begin
+  TestWriteReadMilliseconds(sfOOXML);
+end;
+
 
 initialization
   // Register so these tests are included in a full run