From 52faebc69e439d62d6936eeba062c3649a35ef81 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 21 May 2014 16:23:38 +0000 Subject: [PATCH] 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 --- .../examples/excel8demo/excel8write.lpr | 31 ++++--- .../fpspreadsheet/fpsnumformatparser.pas | 37 ++++++-- components/fpspreadsheet/fpspreadsheet.pas | 30 +++--- components/fpspreadsheet/fpsutils.pas | 93 +++++++++++-------- .../fpspreadsheet/tests/formattests.pas | 2 +- components/fpspreadsheet/xlsbiff8.pas | 1 + components/fpspreadsheet/xlscommon.pas | 25 +---- 7 files changed, 127 insertions(+), 92 deletions(-) diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr index 87db44add..070032a64 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr +++ b/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; - number := 31415.92; + s := '31415.9265359'; + 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); - lCol.Width := 20; + MyWorksheet.WriteColWidth(0, 30); + 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; diff --git a/components/fpspreadsheet/fpsnumformatparser.pas b/components/fpspreadsheet/fpsnumformatparser.pas index ce952014d..e2e15d3ef 100644 --- a/components/fpspreadsheet/fpsnumformatparser.pas +++ b/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 - FNumFormat := nfCustom + if (ns > 1) then begin + 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; - countdecs := false; + if not countdecs then hasHash := true; s := s + token; end; '%': begin diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index b358c29e1..bcca10e88 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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) - else - Result := FormatDateTimeEx(ANumberFormatStr, Value); + ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat, + Workbook.FormatSettings, ANumberFormatStr); + 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 not (parser.Builtin_NumFormat in [nfCustom, nfFmtDateTime]) then begin + if ANumFormat <> nfCustom 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; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 72a461dfc..0bb9568d7 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/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; -function FormatDateTimeEx(const FormatStr: string; DateTime: TDateTime; - AFormatSettings: TFormatSettings): string; overload; +// These two functions are copies of fpc trunk until they are available in "stable" +function FormatDateTime(const FormatStr: string; DateTime: TDateTime; + 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} - -(* This part is in the original code. It is not needed here and avoids a - dependency on the unit Windows. - + (* ---- not needed here --- {$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; - ']': isInterval := false; - ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y','Z' : + '[': if (fdoInterval in Options) then isInterval := true else StoreStr(FormatCurrent, 1); + ']': if (fdoInterval in Options) then isInterval := false else StoreStr(FormatCurrent, 1); + ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' : begin while (P < FormatEnd) and (UpCase(P^) = Token) do Inc(P); @@ -1242,9 +1247,9 @@ var StoreInt(Year mod 100, 2); end; 'M': begin - if isInterval and ((prevlasttoken = 'H') or TimeFlag) then - StoreInt(Minute + Hour*60 + trunc(DateTime)*24*60, 0) - else + if isInterval and ((prevlasttoken = 'H') or TimeFlag) then + StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0) + else if (lastformattoken = 'H') or TimeFlag then begin if Count = 1 then @@ -1275,10 +1280,10 @@ var end ; end ; 'H': - if isInterval then - StoreInt(Hour + trunc(DateTime)*24, 0) - else - if Clock12 then + if isInterval then + StoreInt(Hour + trunc(abs(DateTime))*24, 0) + else + if Clock12 then begin tmp := hour mod 12; if tmp=0 then tmp:=12; @@ -1294,16 +1299,16 @@ var StoreInt(Hour, 2); end; 'N': if isInterval then - StoreInt(Minute + 60*Hour + 60*24*trunc(DateTime), 0) - else - if Count = 1 then + 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) - else - if Count = 1 then + StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0) + else + if Count = 1 then StoreInt(Second, 0) else StoreInt(Second, 2); @@ -1323,10 +1328,12 @@ var StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True); end; end; - -(* This part is in the original code. It is not needed here and avoids a - dependency on the unit Windows. - + 'F': begin + StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False); + 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,12 +1360,13 @@ var Count := P - FormatCurrent; StoreString(ConvertEraString(Count,Year,Month,Day)); end; + prevlasttoken := lastformattoken; lastformattoken:=token; end; {$ENDIF MSWindows} *) end; - prevlasttoken := lastformattoken; + prevlasttoken := lastformattoken; lastformattoken := token; end; else @@ -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. diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index a2d8cb28b..573ecf739 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/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 diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index f5e144b8d..a581f492f 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/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; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 64132a98f..907d8e28d 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/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