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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3073 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-21 16:23:38 +00:00
parent a9df011859
commit 52faebc69e
7 changed files with 127 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

@ -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;

37
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -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

30
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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;

93
components/fpspreadsheet/fpsutils.pas
View File

@ -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.

2
components/fpspreadsheet/tests/formattests.pas
View File

@ -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

1
components/fpspreadsheet/xlsbiff8.pas
View File

@ -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;

25
components/fpspreadsheet/xlscommon.pas
View File

@ -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