fpspreadsheet: Improvements in biff5/8 reading of number formats, a few date/time relatived issues left. biff2 not yet touched.

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

components/fpspreadsheet/examples/excel8demo/excel8write.lpr

@@ -31,6 +31,7 @@ var
   lCol: TCol;
   i: Integer;
   r: Integer = 10;
+  s: String;
 begin
   MyDir := ExtractFilePath(ParamStr(0));
 
@@ -132,7 +133,7 @@ begin
   MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
   MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
 
-
+           (*
   // Uncomment this to test large XLS files
   for i := 50 to 1000 do
   begin
@@ -141,7 +142,7 @@ begin
 //    MyWorksheet.WriteUTF8Text(i, 2, ParamStr(0));
     MyWorksheet.WriteUTF8Text(i, 3, ParamStr(0));
   end;
-
+             *)
 
   // Write the formula E1 = A1 + B1
   SetLength(MyRPNFormula, 3);
@@ -171,6 +172,8 @@ begin
     nil)))));
 
   r := 10;
+  MyWorksheet.WriteUTF8Text(r, 0, 'Writing current date/time:');
+  inc(r, 2);
   // Write current date/time to cells B11:B16
   MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate');
   MyWorksheet.WriteDateTime(r, 1, now, nfShortDate);
@@ -209,9 +212,11 @@ begin
   MyWorksheet.WriteDateTime(r, 1, now, nfFmtDateTime, 'mm:ss.zzz');
 
   // Write formatted numbers
-//  number := 12345.67890123456789;
+  s := '31415.9265359';
-  number := 31415.92;
+  val(s, number, i);
   inc(r, 2);
+  MyWorksheet.WriteUTF8Text(r, 0, 'The number '+s+' is displayed in various formats:');
+  inc(r,2);
   MyWorksheet.WriteUTF8Text(r, 0, 'nfGeneral');
   MyWorksheet.WriteNumber(r, 1, number, nfGeneral);
   MyWorksheet.WriteNumber(r, 2, -number, nfGeneral);
@@ -318,15 +323,15 @@ begin
 
   inc(r,2);
   MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "EUR "#,##0_);("EUR "#,##0)');
-  MyWorksheet.WriteDateTime(r, 1, number);
+  MyWorksheet.WriteNumber(r, 1, number);
   MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"EUR "#,##0_);("EUR "#,##0)');
-  MyWorksheet.WriteDateTime(r, 2, -number);
+  MyWorksheet.WriteNumber(r, 2, -number);
   MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"EUR "#,##0_);("EUR "#,##0)');
   inc(r);
   MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)');
-  MyWorksheet.WriteDateTime(r, 1, number);
+  MyWorksheet.WriteNumber(r, 1, number);
   MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)');
-  MyWorksheet.WriteDateTime(r, 2, -number);
+  MyWorksheet.WriteNumber(r, 2, -number);
   MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)');
 
   inc(r, 2);
@@ -368,10 +373,10 @@ begin
   MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h');
 
   // Set width of columns 0, 1 and 5
-  MyWorksheet.WriteColWidth(0, 25);
+  MyWorksheet.WriteColWidth(0, 30);
-  lCol.Width := 20;
+  lCol.Width := 25;
   MyWorksheet.WriteColInfo(1, lCol);
-  MyWorksheet.WriteColInfo(2, lCol);
+  MyWorksheet.WriteColWidth(2, 15);
   MyWorksheet.WriteColWidth(3, 15);
   MyWorksheet.WriteColWidth(4, 15);
   lCol.Width := 5;
@@ -379,7 +384,7 @@ begin
 
   // Set height of rows 0
   MyWorksheet.WriteRowHeight(0, 30);  // 30 mm
-                                                                    (*
+
   // Creates a new worksheet
   MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);
 
@@ -390,7 +395,7 @@ begin
   MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth);
   MyWorksheet.WriteTextRotation(0, 0, rt90DegreeClockwiseRotation);
   MyWorksheet.WriteUsedFormatting(0, 1, [uffBold]);
-                                                            *)
+
   // Save the spreadsheet to a file
   MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel8, true);
   MyWorkbook.Free;

components/fpspreadsheet/fpsnumformatparser.pas

@@ -79,6 +79,8 @@ type
     procedure ScanText;
 
   public
+    constructor Create(AWorkbook: TsWorkbook; const AFormatString: String;
+      AConversionDirection: TsConversionDirection = cdToFPSpreadsheet); overload;
     constructor Create(AWorkbook: TsWorkbook;
       const AFormatString: String; ANumFormat: TsNumberFormat;
       AConversionDirection: TsConversionDirection = cdToFPSpreadsheet); overload;
@@ -110,6 +112,20 @@ const
 { Creates a number format parser for analyzing a formatstring that has been read
   from a spreadsheet file. The conversion, by default, will go FROM the file TO
   the fpspreadsheet procedures. }
+constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook;
+  const AFormatString: String;
+  AConversionDirection: TsConversionDirection = cdToFPSpreadsheet);
+begin
+  inherited Create;
+  FCreateMethod := 0;
+  FConversionDirection := AConversionDirection;
+  FWorkbook := AWorkbook;
+  FFormatSettings := DefaultFormatSettings;
+  FFormatSettings.DecimalSeparator := '.';
+  FFormatSettings.ThousandSeparator := ',';
+  Parse(AFormatString);
+end;
+
 constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook;
   const AFormatString: String; ANumFormat: TsNumberFormat;
   AConversionDirection: TsConversionDirection = cdToFPSpreadsheet);
@@ -294,7 +310,7 @@ begin
       nfShortDateTime, nfShortDate, nfShortTime, nfShortTimeAM,
       nfLongDate, nfLongTime, nfLongTimeAM, nfTimeInterval, nfFmtDateTime:
         try
-          s := FormatDateTimeEx(FSections[i].FormatString, now(), FWorkbook.FormatSettings);
+          s := FormatDateTime(FSections[i].FormatString, now(), FWorkbook.FormatSettings, [fdoInterval]);
         except
           FStatus := psErrNoValidDateTimeFormat;
           exit;
@@ -310,8 +326,9 @@ begin
   if (ns = 3) and
      (FSections[0].NumFormat = nfCurrency) and
      (FSections[1].NumFormat = nfCurrency) and
-     (FSections[2].NumFormat = nfCurrency)
+     ((FSections[2].NumFormat = nfCurrency) or (FSections[2].FormatString = '-'))
   then begin
+    FNumFormat := nfCurrency;
     if ((FSections[2].FormatString = '-') or (FSections[2].FormatString = '"-"')) then begin
       if (FSections[1].Color = scRed) then
         FNumFormat := nfCurrencyDashRed
@@ -323,8 +340,15 @@ begin
     end;
   end else
   // If there are other multi-section formatstrings they must be a custom format
-  if (ns > 1) then
+  if (ns > 1) then begin
-    FNumFormat := nfCustom
+    for i:=1 to ns-1 do
+      if FSections[i].FormatString <> '' then begin
+        FNumFormat := nfCustom;
+        break;
+      end;
+    if fNumFormat <> nfCustom then
+      FNumFormat := FSections[0].NumFormat;
+  end
   else
     FNumFormat := FSections[0].NumFormat;
 
@@ -721,15 +745,14 @@ begin
            end;
       'E', 'e':
            begin
-             if hasHash and countdecs then isSci := true else isExp := true;
+             if hasHash then isSci := true else isExp := true;
              countdecs := false;
              s := s + token;
            end;
       '+', '-':
            s := s + token;
       '#': begin
-             hasHash := true;
+             if not countdecs then hasHash := true;
-             countdecs := false;
              s := s + token;
            end;
       '%': begin

components/fpspreadsheet/fpspreadsheet.pas

@@ -1277,9 +1277,9 @@ function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
     Result := '';
     if not IsNaN(Value) then begin
       if ANumberFormatStr = '' then
-        Result := FormatDateTime('c', Value)
+        ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat,
-      else
+          Workbook.FormatSettings, ANumberFormatStr);
-        Result := FormatDateTimeEx(ANumberFormatStr, Value);
+      Result := FormatDateTime(ANumberFormatStr, Value, [fdoInterval]);
     end;
   end;
 
@@ -1454,8 +1454,10 @@ begin
   if IsDateTimeFormat(AFormat) then
     raise Exception.Create(lpInvalidNumberFormat);
 
+  {
   if AFormat = nfCustom then
     raise Exception.Create(lpIllegalNumberformat);
+   }
 
   if AFormat <> nfGeneral then begin
     Include(ACell^.UsedFormattingFields, uffNumberFormat);
@@ -2753,12 +2755,13 @@ begin
     if parser.Status = psOK then begin
       ANumFormat := parser.Builtin_NumFormat;
       AFormatString := parser.FormatString;  // This is the converted string.
-      {
+      if ANumFormat <> nfCustom then begin
-      if not (parser.Builtin_NumFormat in [nfCustom, nfFmtDateTime]) then begin
         ADecimals := parser.ParsedSections[0].Decimals;
         ACurrencySymbol := parser.ParsedSections[0].CurrencySymbol;
+      end else begin
+        ADecimals := 0;
+        ACurrencySymbol := '';
       end;
-      }
     end;
   finally
     parser.Free;
@@ -2953,6 +2956,7 @@ var
   fmt: String;
   itemfmt: String;
 begin
+  (*
   // These are pre-defined formats - no need to check format string & decimals
   if ANumFormat in [ nfGeneral, nfShortDateTime, nfShortDate, nfLongDate,
                      nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM ]
@@ -2962,10 +2966,10 @@ begin
       if (item <> nil) and (item.NumFormat = ANumFormat) then
         exit;
     end;
-
+    *)
   if (ANumFormat = nfFmtDateTime) then begin
     fmt := lowercase(AFormatString);
-    for Result := 0 to Count-1 do begin
+    for Result := Count-1 downto 0 do begin
       item := Items[Result];
       if (item <> nil) and (item.NumFormat = nfFmtDateTime) then begin
         itemfmt := lowercase(item.FormatString);
@@ -2996,7 +3000,7 @@ begin
 
   // Check only the format string for nfCustom.
   if (ANumFormat = nfCustom) then
-    for Result := 0 to Count-1 do begin
+    for Result := Count-1 downto 0 do begin
       item := Items[Result];
       if (item <> nil)
          and (item.NumFormat = ANumFormat)
@@ -3006,7 +3010,7 @@ begin
     end;
 
   // The other formats can carry additional information
-  for Result := 0 to Count-1 do begin
+  for Result := Count-1 downto 0 do begin
     item := Items[Result];
     if (item <> nil)
       and (item.NumFormat = ANumFormat)
@@ -3040,7 +3044,9 @@ function TsCustomNumFormatList.Find(AFormatString: String): integer;
 var
   item: TsNumFormatData;
 begin
-  for Result := 0 to Count-1 do begin
+  { We search backwards to find user-defined items first. They usually are
+    more appropriate than built-in items. }
+  for Result := Count-1 downto 0 do begin
     item := Items[Result];
     if item.FormatString = AFormatString then
       exit;
@@ -3192,7 +3198,7 @@ var
 begin
   Result := -1;
 
-  for i := 0 to Length(FFormattingStyles) - 1 do
+  for i := Length(FFormattingStyles) - 1 downto 0 do
   begin
     if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue;
 

components/fpspreadsheet/fpsutils.pas

@@ -19,6 +19,10 @@ type
   TsSelectionDirection = (fpsVerticalSelection, fpsHorizontalSelection);
   TsDecsChars = set of char;
 
+  // to be removed when fpc trunk is stable
+  TFormatDateTimeOption = (fdoInterval);
+  TFormatDateTimeOptions =  set of TFormatDateTimeOption;
+
 const
   // Date formatting string for unambiguous date/time display as strings
   // Can be used for text output when date/time cell support is not available
@@ -90,9 +94,11 @@ function SciFloat(AValue: Double; ADecimals: Byte): String;
 //function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String;
 procedure MakeTimeIntervalMask(Src: String; var Dest: String);
 
-function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime): String; overload;
+// These two functions are copies of fpc trunk until they are available in "stable"
-function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime;
+function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
-  AFormatSettings: TFormatSettings): string; overload;
+  Options : TFormatDateTimeOptions = []): string;
+function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
+  const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
 
 implementation
 
@@ -1048,21 +1054,20 @@ end;
 {******************************************************************************}
 
 // Copied from "fpc/rtl/objpas/sysutils/datei.inc"
-procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime; const FormatSettings: TFormatSettings);
+{   DateTimeToString formats DateTime to the given format in FormatStr   }
+
+procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime;
+  const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []);
 var
   ResultLen: integer;
   ResultBuffer: array[0..255] of char;
   ResultCurrent: pchar;
-
 {$IFDEF MSWindows}
   isEnable_E_Format : Boolean;
   isEnable_G_Format : Boolean;
   eastasiainited : boolean;
 {$ENDIF MSWindows}
-
+             (*    ---- not needed here ---
-(* This part is in the original code. It is not needed here and avoids a
-   dependency on the unit Windows.
-
 {$IFDEF MSWindows}
   procedure InitEastAsia;
   var     ALCID : LCID;
@@ -1095,7 +1100,7 @@ var
     eastasiainited :=true;
   end;
 {$ENDIF MSWindows}
-*)
+                     *)
   procedure StoreStr(Str: PChar; Len: Integer);
   begin
     if ResultLen + Len < SizeOf(ResultBuffer) then
@@ -1136,7 +1141,7 @@ var
 
 var
   Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
-
+  DT : TDateTime;
 
   procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
   var
@@ -1226,9 +1231,9 @@ var
         end ;
         '/': StoreStr(@FormatSettings.DateSeparator, 1);
         ':': StoreStr(@FormatSettings.TimeSeparator, 1);
-        '[': isInterval := true;
+	'[': if (fdoInterval in Options) then isInterval := true else StoreStr(FormatCurrent, 1);
-        ']': isInterval := false;
+	']': if (fdoInterval in Options) then isInterval := false else StoreStr(FormatCurrent, 1);
-        ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y','Z' :
+        ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' :
         begin
           while (P < FormatEnd) and (UpCase(P^) = Token) do
             Inc(P);
@@ -1243,7 +1248,7 @@ var
             end;
             'M': begin
 	      if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
-                StoreInt(Minute + Hour*60 + trunc(DateTime)*24*60, 0)
+	        StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
 	      else
               if (lastformattoken = 'H') or TimeFlag then
               begin
@@ -1276,7 +1281,7 @@ var
             end ;
             'H':
 	      if isInterval then
-                StoreInt(Hour + trunc(DateTime)*24, 0)
+	        StoreInt(Hour + trunc(abs(DateTime))*24, 0)
 	      else
 	      if Clock12 then
               begin
@@ -1294,14 +1299,14 @@ var
                   StoreInt(Hour, 2);
               end;
             'N': if isInterval then
-                   StoreInt(Minute + 60*Hour + 60*24*trunc(DateTime), 0)
+	           StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
 		 else
 		 if Count = 1 then
                    StoreInt(Minute, 0)
                  else
                    StoreInt(Minute, 2);
             'S': if isInterval then
-                   StoreInt(Second + Minute*60 + Hour*60*60 + trunc(DateTime)*24*60*60, 0)
+	           StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
 	         else
 	         if Count = 1 then
                    StoreInt(Second, 0)
@@ -1323,10 +1328,12 @@ var
                       StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
                      end;
                  end;
-
+            'F': begin
-(* This part is in the original code. It is not needed here and avoids a
+                   StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
-   dependency on the unit Windows.
+                   StoreString(' ');
-
+                   StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
+                 end;
+            (* ------------ not needed here...
 {$IFDEF MSWindows}
             'E':
                begin
@@ -1339,6 +1346,7 @@ var
                      Count := P - FormatCurrent;
                      StoreString(ConvertEraYearString(Count,Year,Month,Day));
                    end;
+		 prevlasttoken := lastformattoken;
                  lastformattoken:=token;
                end;
              'G':
@@ -1352,6 +1360,7 @@ var
                      Count := P - FormatCurrent;
                      StoreString(ConvertEraString(Count,Year,Month,Day));
                    end;
+		 prevlasttoken := lastformattoken;
                  lastformattoken:=token;
                end;
 {$ENDIF MSWindows}
@@ -1383,15 +1392,25 @@ begin
   result := StrPas(@ResultBuffer[0]);
 end ;
 
-function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime): string;
+procedure DateTimeToString(out Result: string; const FormatStr: string;
+  const DateTime: TDateTime; Options : TFormatDateTimeOptions = []);
 begin
-  DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings);
+  DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings, Options);
 end;
 
-function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime;
+
-  AFormatSettings: TFormatSettings): string;
+{   FormatDateTime formats DateTime to the given format string FormatStr   }
+
+function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
+  Options : TFormatDateTimeOptions = []): string;
 begin
-  DateTimeToString(Result, FormatStr, DateTime, AFormatSettings);
+  DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings,Options);
+end;
+
+function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
+  const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
+begin
+  DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
 end;
 
 end.

components/fpspreadsheet/tests/formattests.pas

@@ -189,7 +189,7 @@ begin
     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] := FormatDateTime('[h]:mm:ss', SollDateTimes[i]);
+    SollDateTimeStrings[i, 9] := FormatDateTime('[h]:mm:ss', SollDateTimes[i], [fdoInterval]);
   end;
 
   // Column width

components/fpspreadsheet/xlsbiff8.pas

@@ -84,6 +84,7 @@ type
     procedure ReadFormat(AStream: TStream); override;
     procedure ReadLabel(AStream: TStream); override;
     procedure ReadLabelSST(const AStream: TStream);
+    // procedure ReadNumber() --> xlscommon
     procedure ReadRichString(const AStream: TStream);
     procedure ReadSST(const AStream: TStream);
     procedure ReadStringRecord(AStream: TStream); override;

components/fpspreadsheet/xlscommon.pas

@@ -835,25 +835,6 @@ end;
 procedure TsSpreadBIFFReader.ExtractNumberFormat(AXFIndex: WORD;
   out ANumberFormat: TsNumberFormat; out ADecimals: Byte;
   out ACurrencySymbol: String; out ANumberFormatStr: String);
-
-  procedure FixMilliseconds;
-  var
-    isLong, isAMPM, isInterval: Boolean;
-    decs: Byte;
-    i: Integer;
-  begin
-    decs := CountDecs(ANumberFormatStr, ['0', 'z', 'Z']);
-{    if IsTimeFormat(ANumberFormatStr, isLong, isAMPM, isInterval, decs)
-      and (decs > 0)
-    then }
-    if decs > 0 then
-      for i:= Length(ANumberFormatStr) downto 1 do
-        case ANumberFormatStr[i] of
-          '0': ANumberFormatStr[i] := 'z';
-          '.': break;
-        end;
-  end;
-
 var
   lNumFormatData: TsNumFormatData;
 begin
@@ -863,7 +844,6 @@ begin
     ANumberFormatStr := lNumFormatData.FormatString;
     ADecimals := lNumFormatData.Decimals;
     ACurrencySymbol := lNumFormatData.CurrencySymbol;
-    FixMilliseconds;
   end else begin
     ANumberFormat := nfGeneral;
     ANumberFormatStr := '';
@@ -1186,9 +1166,11 @@ begin
   {Find out what cell type, set content type and value}
   ExtractNumberFormat(XF, nf, nd, ncs, nfs);
   if IsDateTime(value, nf, dt) then
-    FWorksheet.WriteDateTime(ARow, ACol, dt, nf, nfs)
+    FWorksheet.WriteDateTime(ARow, ACol, dt) //, nf, nfs)
   else
+  if nf <> nfCustom then
     FWorksheet.WriteNumber(ARow, ACol, value, nf, nd, ncs);
+  FWorksheet.WriteNumberFormat(ARow, ACol, nf, nfs);  // override built-in format string
 
   { Add attributes to cell }
   ApplyCellFormatting(ARow, ACol, XF);
@@ -2055,7 +2037,6 @@ begin
   // But we have to consider that the number formats of the cell is in fpc syntax,
   // but the number format list of the writer is in Excel syntax.
   lCell := ACell^;
-//  CopyCellFormat(ACell, @lCell);
   with lCell do begin
     if NumberFormat <> nfCustom then begin
       if IsDateTimeFormat(NumberFormat) then