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

+ Add support for text/number/date formats in BIFF8/xls.

Browse Source 
+ Add support for writing out date/time to non-BIFF8 xls (though as text only for now)
  Slightly modified patch by wp, thanks a lot. 
  See
  http://forum.lazarus.freepascal.org/index.php/topic,22940.msg136761.html#msg136761

Still to do: add test cases for invalid format strings



git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2863 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
bigchimp
2013-12-22 14:02:04 +00:00
parent b0c00c63e4
commit 7f7d07f151
22 changed files with 1402 additions and 99 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
components/fpspreadsheet/examples/excel2demo/excel2write.lpr
View File

@ -55,8 +55,11 @@ begin
MyWorksheet.WriteUTF8Text(1, 2, 'Third');
MyWorksheet.WriteUTF8Text(1, 3, 'Fourth');
// Write current date/time
MyWorksheet.WriteDateTime(2, 0, now);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test' + STR_EXCEL_EXTENSION, sfExcel2);
MyWorkbook.WriteToFile(MyDir + 'test' + STR_EXCEL_EXTENSION, sfExcel2, true);
MyWorkbook.Free;
end.

12
components/fpspreadsheet/examples/excel5demo/excel5write.lpr
View File

@ -10,8 +10,7 @@ program excel5write;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpspreadsheet, xlsbiff5,
laz_fpspreadsheet, fpsconvencoding;
Classes, SysUtils, fpspreadsheet, xlsbiff5;
const
Str_First = 'First';
@ -40,9 +39,12 @@ begin
MyWorksheet.WriteNumber(0, 2, 3.0);// C1
MyWorksheet.WriteNumber(0, 3, 4.0);// D1
MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5
MyWorksheet.WriteNumber(4, 3, 10); // D5
MyWorksheet.WriteNumber(4, 3, 10); // D5
{ Uncommend this to test large XLS files
// Write current date/time
MyWorksheet.WriteDateTime(5, 0, now);
{ Uncomment this to test large XLS files
for i := 2 to 20 do
begin
MyWorksheet.WriteAnsiText(i, 0, ParamStr(0));
@ -83,7 +85,7 @@ begin
MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel5, False);
MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel5, true);
MyWorkbook.Free;
end.

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

@ -28,6 +28,7 @@ var
MyDir: string;
i: Integer;
lCell: PCell;
number: Double;
begin
MyDir := ExtractFilePath(ParamStr(0));
@ -41,7 +42,7 @@ begin
MyWorksheet.WriteNumber(0, 2, 3.0);// C1
MyWorksheet.WriteNumber(0, 3, 4.0);// D1
MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5
MyWorksheet.WriteNumber(4, 3, 10); // D5
MyWorksheet.WriteNumber(4, 3, 10); // D5
// D6 number with background color
MyWorksheet.WriteNumber(5, 3, 10);
@ -49,7 +50,7 @@ begin
lCell^.BackgroundColor := scPURPLE;
lCell^.UsedFormattingFields := [uffBackgroundColor];
{ Uncommend this to test large XLS files
{ Uncomment this to test large XLS files
for i := 2 to 20 do
begin
MyWorksheet.WriteAnsiText(i, 0, ParamStr(0));
@ -80,6 +81,63 @@ begin
//MyFormula.FormulaStr := '';
// Write current date/time to cells B11:B16
MyWorksheet.WriteUTF8Text(10, 0, 'nfShortDate');
MyWorksheet.WriteDateTime(10, 1, now, nfShortDate);
MyWorksheet.WriteUTF8Text(11, 0, 'nfShortTime');
MyWorksheet.WriteDateTime(11, 1, now, nfShortTime);
MyWorksheet.WriteUTF8Text(12, 0, 'nfLongTime');
MyWorksheet.WriteDateTime(12, 1, now, nfLongTime);
MyWorksheet.WriteUTF8Text(13, 0, 'nfShortDateTime');
MyWorksheet.WriteDateTime(13, 1, now, nfShortDateTime);
MyWorksheet.WriteUTF8Text(14, 0, 'nfFmtDateTime, DM');
MyWorksheet.WriteDateTime(14, 1, now, nfFmtDateTime, 'DM');
MyWorksheet.WriteUTF8Text(15, 0, 'nfFmtDateTime, MY');
MyWorksheet.WriteDateTime(15, 1, now, nfFmtDateTime, 'MY');
MyWorksheet.WriteUTF8Text(16, 0, 'nfShortTimeAM');
MyWorksheet.WriteDateTime(16, 1, now, nfShortTimeAM);
MyWorksheet.WriteUTF8Text(17, 0, 'nfLongTimeAM');
MyWorksheet.WriteDateTime(17, 1, now, nfLongTimeAM);
MyWorksheet.WriteUTF8Text(18, 0, 'nfFmtDateTime, MS');
MyWorksheet.WriteDateTime(18, 1, now, nfFmtDateTime, 'MS');
MyWorksheet.WriteUTF8Text(19, 0, 'nfFmtDateTime, MSZ');
MyWorksheet.WriteDateTime(19, 1, now, nfFmtDateTime, 'MSZ');
// Write formatted numbers
number := 12345.67890123456789;
MyWorksheet.WriteUTF8Text(24, 1, '12345.67890123456789');
MyWorksheet.WriteUTF8Text(24, 2, '-12345.67890123456789');
MyWorksheet.WriteUTF8Text(25, 0, 'nfFixed, 0 decs');
MyWorksheet.WriteNumber(25, 1, number, nfFixed, 0);
MyWorksheet.WriteNumber(25, 2, -number, nfFixed, 0);
MyWorksheet.WriteUTF8Text(26, 0, 'nfFixed, 2 decs');
MyWorksheet.WriteNumber(26, 1, number, nfFixed, 2);
MyWorksheet.WriteNumber(26, 2, -number, nfFixed, 2);
MyWorksheet.WriteUTF8Text(27, 0, 'nfFixedTh, 0 decs');
MyWorksheet.WriteNumber(27, 1, number, nfFixedTh, 0);
MyWorksheet.WriteNumber(27, 2, -number, nfFixedTh, 0);
MyWorksheet.WriteUTF8Text(28, 0, 'nfFixedTh, 2 decs');
MyWorksheet.WriteNumber(28, 1, number, nfFixedTh, 2);
MyWorksheet.WriteNumber(28, 2, -number, nfFixedTh, 2);
MyWorksheet.WriteUTF8Text(29, 0, 'nfSci, 1 dec');
MyWorksheet.WriteNumber(29, 1, number, nfSci);
MyWorksheet.WriteNumber(29, 2, -number, nfSci);
MyWorksheet.WriteNumber(29, 3, 1.0/number, nfSci);
MyWorksheet.WriteNumber(29, 4, -1.0/number, nfSci);
MyWorksheet.WriteUTF8Text(30, 0, 'nfExp, 2 decs');
MyWorksheet.WriteNumber(30, 1, number, nfExp, 2);
MyWorksheet.WriteNumber(30, 2, -number, nfExp, 2);
MyWorksheet.WriteNumber(30, 3, 1.0/number, nfExp, 2);
MyWorksheet.WriteNumber(30, 4, -1.0/number, nfExp, 2);
number := 1.333333333;
MyWorksheet.WriteUTF8Text(35, 0, 'nfPercent, 0 decs');
MyWorksheet.WriteNumber(35, 1, number, nfPercent, 0);
MyWorksheet.WriteUTF8Text(36, 0, 'nfPercent, 2 decs');
MyWorksheet.WriteNumber(36, 1, number, nfPercent, 2);
MyWorksheet.WriteUTF8Text(37, 0, 'nfTimeInterval');
MyWorksheet.WriteDateTime(37, 1, number, nfTimeInterval);
// Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);
@ -92,7 +150,7 @@ begin
MyWorksheet.WriteUsedFormatting(0, 1, [uffBold]);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test2.xls', sfExcel8, False);
MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel8, true);
MyWorkbook.Free;
end.

5
components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr
View File

@ -33,7 +33,7 @@ begin
MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0);
// Uncommend this to test large XLS files
// Uncomment this to test large XLS files
for i := 2 to 2{20} do
begin
MyWorksheet.WriteUTF8Text(i, 0, ParamStr(0));
@ -61,6 +61,9 @@ begin
MyWorksheet.WriteUTF8Text(0, 2, 'Third');
MyWorksheet.WriteUTF8Text(0, 3, 'Fourth');
// Write current date/time
MyWorksheet.WriteDateTime(0, 5, now);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test.xlsx', sfOOXML);
MyWorkbook.Free;

1
components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
View File

@ -31,6 +31,7 @@ begin
MyWorksheet.WriteNumber(0, 3, 4.0);// D1
MyWorksheet.WriteUTF8Text(4, 2, 'Total:');// C5
MyWorksheet.WriteNumber(4, 3, 10); // D5
MyWorksheet.WriteDateTime(5, 0, now);
// Add some formatting
MyWorksheet.WriteUsedFormatting(0, 0, [uffBold]);

11
components/fpspreadsheet/fpsopendocument.pas
View File

@ -89,6 +89,7 @@ type
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
end;
implementation
@ -709,6 +710,16 @@ begin
' </table:table-cell>' + LineEnding;
end;
{
Writes the date/time as a text to the sheet.
Currently, no formatting code is written.
}
procedure TsSpreadOpenDocWriter.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
begin
WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell);
end;
{
Registers this reader / writer on fpSpreadsheet
}

201
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -102,7 +102,9 @@ type
enough to be able to read/write date values.
}
TsNumberFormat = (nfGeneral, nfShortDate, nfShortDateTime);
TsNumberFormat = (nfGeneral, nfFixed, nfFixedTh, nfExp, nfSci, nfPercentage,
nfShortDateTime, nfFmtDateTime, nfShortDate, nfShortTime, nfLongTime,
nfShortTimeAM, nfLongTimeAM, nfTimeInterval);
{@@ Text rotation formatting. The text is rotated relative to the standard
orientation, which is from left to right horizontal: --->
@ -187,6 +189,8 @@ type
Border: TsCellBorders;
BackgroundColor: TsColor;
NumberFormat: TsNumberFormat;
NumberFormatStr: String;
NumberDecimals: Word;
RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR
end;
@ -242,8 +246,10 @@ type
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
procedure RemoveAllCells;
procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double);
procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime);
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2);
procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = '');
procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat);
procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula);
@ -378,10 +384,14 @@ procedure RegisterSpreadFormat(
AWriterClass: TsSpreadWriterClass;
AFormat: TsSpreadsheetFormat);
function SciFloat(AValue: Double; ADecimals: Word): String;
function TimeIntervalToString(AValue: TDateTime): String;
implementation
uses
Math;
Math, StrUtils;
var
{ Translatable strings }
@ -405,6 +415,51 @@ begin
GsSpreadFormats[len].Format := AFormat;
end;
{@@
Formats the number AValue in "scientific" format with the given number of
decimals. "Scientific" is the same as "exponential", but with exponents rounded
to multiples of 3.
}
function SciFloat(AValue: Double; ADecimals: Word): String;
var
m: Double;
ex: Integer;
begin
if AValue = 0 then
Result := '0.0'
else begin
ex := floor(log10(abs(AValue))); // exponent
// round exponent to multiples of 3
ex := (ex div 3) * 3;
if ex < 0 then dec(ex, 3);
m := AValue * Power(10, -ex); // mantisse
Result := Format('%.*fE%d', [ADecimals, m, ex]);
end;
end;
{@@
Formats the number AValue as a time string with hours, minutes and seconds.
Unlike TimeToStr there can be more than 24 hours.
}
function TimeIntervalToString(AValue: TDateTime): String;
var
hrs: Integer;
diff: Double;
h,m,s,z: Word;
ts: String;
begin
ts := DefaultFormatSettings.TimeSeparator;
DecodeTime(frac(abs(AValue)), h, m, s, z);
hrs := h + trunc(abs(AValue))*24;
if z > 499 then inc(s);
if hrs > 0 then
Result := Format('%d%s%.2d%s%.2d', [hrs, ts, m, ts, s])
else
Result := Format('%d%s%.2d', [m, ts, s]);
if AValue < 0.0 then Result := '-' + Result;
end;
{ TsWorksheet }
{@@
@ -673,12 +728,42 @@ end;
@return The text representation of the cell
}
function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
function FloatToStrNoNaN(const Value: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: ansistring): ansistring;
begin
if IsNan(Value) then
Result := ''
else
if ANumberFormat = nfSci then
Result := SciFloat(Value, 1)
else
if (ANumberFormat = nfGeneral) or (ANumberFormatStr = '') then
Result := FloatToStr(Value)
else
if (ANumberFormat = nfPercentage) then
Result := FormatFloat(ANumberFormatStr, Value*100) + '%'
else
Result := FormatFloat(ANumberFormatStr, Value);
end;
function DateTimeToStrNoNaN(const Value: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: String): ansistring;
begin
Result := '';
if not IsNaN(Value) then begin
if ANumberFormat = nfTimeInterval then
Result := TimeIntervalToString(Value)
else
if ANumberFormatStr = '' then
Result := FormatDateTime('c', Value)
else
Result := FormatDateTime(ANumberFormatStr, Value);
end;
end;
var
ACell: PCell;
function FloatToStrNoNaN(const Value: Double): ansistring;
begin
if IsNan(Value) then Result:='' else Result:=FloatToStr(Value);
end;
begin
ACell := FindCell(ARow, ACol);
@ -690,17 +775,9 @@ begin
case ACell^.ContentType of
//cctFormula
cctNumber: Result := FloatToStrNoNaN(ACell^.NumberValue);
cctNumber: Result := FloatToStrNoNaN(ACell^.NumberValue, ACell^.NumberFormat, ACell^.NumberFormatStr);
cctUTF8String: Result := ACell^.UTF8StringValue;
cctDateTime:
begin
Result := SysUtils.DateToStr(ACell^.DateTimeValue);
// User can have specified custom date/time format or one of the other built
// in formats that include time. We can't parse all of them so just return
// time as well unless absolutely sure we only want a date
if ACell^.NumberFormat<>nfShortDate then
Result := Result+' ' + SysUtils.TimeToStr(ACell^.DateTimeValue);
end;
cctDateTime: Result := DateTimeToStrNoNaN(ACell^.DateTimeValue, ACell^.NumberFormat, ACell^.NumberFormatStr);
else
Result := '';
end;
@ -839,35 +916,63 @@ end;
@param ARow The row of the cell
@param ACol The column of the cell
@param ANumber The number to be written
@param AFormat The format identifier, e.g. nfFixed (optional)
@param ADecimals The number of decimals used for formatting (optional)
}
procedure TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double);
procedure TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2);
var
ACell: PCell;
decs: String;
begin
ACell := GetCell(ARow, ACol);
ACell^.ContentType := cctNumber;
ACell^.NumberValue := ANumber;
ACell^.NumberDecimals := ADecimals;
if AFormat <> nfGeneral then begin
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := AFormat;
decs := DupeString('0', ADecimals);
if ADecimals > 0 then decs := '.' + decs;
case AFormat of
nfFixed:
ACell^.NumberFormatStr := '0' + decs;
nfFixedTh:
ACell^.NumberFormatStr := '#,##0' + decs;
nfExp:
ACell^.NumberFormatStr := '0' + decs + 'E+00';
nfSci:
ACell^.NumberFormatStr := '';
nfPercentage:
ACell^.NumberFormatStr := '0' + decs;
end;
end;
end;
{@@
Writes a date/time value to a determined cell
@param ARow The row of the cell
@param ACol The column of the cell
@param AValue The date/time/datetime to be written
@param ARow The row of the cell
@param ACol The column of the cell
@param AValue The date/time/datetime to be written
@param AFormat The format specifier, e.g. nfShortDate (optional)
@param AFormatStr Format string, used only for nfFmtDateTime.
Must follow the rules for "FormatDateTime", or use
"dm" as abbreviation for "d/mmm", "my" for "mmm/yy",
"ms" for "nn:ss", "msz" for "nn:ss.z" (optional)
Note: at least Excel xls does not recognize a separate datetime cell type:
a datetime is stored as a (floating point) Number, and the cell is formatted
as a date (either built-in or a custom format).
This procedure automatically sets the cell format to short date/time. You may
change this format to another date/time format, but changing it to another
format (e.g. General) will likely lead to the cell being written out as a
plain number.
Note: custom formats are currently not supported by the writer.
}
procedure TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime);
procedure TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = '');
var
ACell: PCell;
fmt: String;
begin
ACell := GetCell(ARow, ACol);
@ -876,11 +981,32 @@ begin
// Date/time is actually a number field in Excel.
// To make sure it gets saved correctly, set a date format (instead of General).
// The user can choose another date format if he wants to
if not(uffNumberFormat in ACell^.UsedFormattingFields) or
((uffNumberFormat in ACell^.UsedFormattingFields) and (ACell^.NumberFormat = nfGeneral)) then
begin
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := nfShortDateTime;
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := AFormat;
case AFormat of
nfShortDateTime:
ACell^.NumberFormatStr := FormatSettings.ShortDateFormat + ' ' + FormatSettings.ShortTimeFormat;
nfShortDate:
ACell^.NumberFormatStr := FormatSettings.ShortDateFormat;
nfShortTime:
ACell^.NumberFormatStr := 't';
nfLongTime:
ACell^.NumberFormatStr := 'tt';
nfShortTimeAM:
ACell^.NumberFormatStr := 't am/pm';
nfLongTimeAM:
ACell^.NumberFormatStr := 'tt am/pm';
nfFmtDateTime:
begin
fmt := lowercase(AFormatStr);
if fmt = 'dm' then ACell^.NumberFormatStr := 'd/mmm'
else if fmt = 'my' then ACell^.NumberFormatSTr := 'mmm/yy'
else if fmt = 'ms' then ACell^.NumberFormatStr := 'nn:ss'
else if fmt = 'msz' then ACell^.NumberFormatStr := 'nn:ss.z'
else ACell^.NumberFormatStr := AFormatStr;
end;
nfTimeInterval:
ACell^.NumberFormatStr := '';
end;
end;
@ -1503,8 +1629,16 @@ begin
if uffBackgroundColor in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue;
if uffNumberFormat in AFormat^.UsedFormattingFields then
if uffNumberFormat in AFormat^.UsedFormattingFields then begin
if (FFormattingStyles[i].NumberFormat <> AFormat^.NumberFormat) then Continue;
case AFormat^.NumberFormat of
nfFixed, nfFixedTh, nfPercentage, nfExp:
if (FFormattingStyles[i].NumberDecimals <> AFormat^.NumberDecimals) then Continue;
nfShortDate, nfShortDateTime, nfShortTime, nfLongTime, nfShortTimeAM,
nfLongTimeAM, nfFmtDateTime, nfTimeInterval:
if (FFormattingstyles[i].NumberFormatStr <> AFormat^.NumberFormatStr) then Continue;
end;
end;
// If we arrived here it means that the styles match
Exit(i);
@ -1735,6 +1869,7 @@ begin
// Silently dump the formula; child classes should implement their own support
end;
finalization
SetLength(GsSpreadFormats, 0);

344
components/fpspreadsheet/tests/datetests.pas
View File

@ -22,7 +22,7 @@ uses
var
// Norm to test against - list of dates/times that should occur in spreadsheet
SollDates: array[0..11] of TDateTime; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;)
SollDates: array[0..37] of TDateTime; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.
procedure InitSollDates;
@ -53,6 +53,32 @@ type
procedure TestReadDate9;
procedure TestReadDate10;
procedure TestReadDate11;
procedure TestReadDate12;
procedure TestReadDate13;
procedure TestReadDate14;
procedure TestReadDate15;
procedure TestReadDate16;
procedure TestReadDate17;
procedure TestReadDate18;
procedure TestReadDate19;
procedure TestReadDate20;
procedure TestReadDate21;
procedure TestReadDate22;
procedure TestReadDate23;
procedure TestReadDate24;
procedure TestReadDate25;
procedure TestReadDate26;
procedure TestReadDate27;
procedure TestReadDate28;
procedure TestReadDate29;
procedure TestReadDate30;
procedure TestReadDate31;
procedure TestReadDate32;
procedure TestReadDate33;
procedure TestReadDate34;
procedure TestReadDate35;
procedure TestReadDate36;
procedure TestReadDate37;
procedure TestReadDate1899_0; //same as above except with the 1899/1900 date system set
procedure TestReadDate1899_1;
procedure TestReadDate1899_2;
@ -65,6 +91,32 @@ type
procedure TestReadDate1899_9;
procedure TestReadDate1899_10;
procedure TestReadDate1899_11;
procedure TestReadDate1899_12;
procedure TestReadDate1899_13;
procedure TestReadDate1899_14;
procedure TestReadDate1899_15;
procedure TestReadDate1899_16;
procedure TestReadDate1899_17;
procedure TestReadDate1899_18;
procedure TestReadDate1899_19;
procedure TestReadDate1899_20;
procedure TestReadDate1899_21;
procedure TestReadDate1899_22;
procedure TestReadDate1899_23;
procedure TestReadDate1899_24;
procedure TestReadDate1899_25;
procedure TestReadDate1899_26;
procedure TestReadDate1899_27;
procedure TestReadDate1899_28;
procedure TestReadDate1899_29;
procedure TestReadDate1899_30;
procedure TestReadDate1899_31;
procedure TestReadDate1899_32;
procedure TestReadDate1899_33;
procedure TestReadDate1899_34;
procedure TestReadDate1899_35;
procedure TestReadDate1899_36;
procedure TestReadDate1899_37;
end;
{ TSpreadWriteReadDateTests }
@ -109,6 +161,36 @@ begin
SollDates[9]:=EncodeTime(18,0,0,0);
SollDates[10]:=EncodeTime(23,59,0,0);
SollDates[11]:=EncodeTime(23,59,59,0);
SollDates[12]:=SollDates[1]; // #1 formatted as nfShortDateTime
SollDates[13]:=SollDates[1]; // #1 formatted as nfShortTime
SollDates[14]:=SollDates[1]; // #1 formatted as nfLongTime
SollDates[15]:=SollDates[1]; // #1 formatted as nfShortTimeAM
SollDates[16]:=SollDates[1]; // #1 formatted as nfLongTimeAM
SollDates[17]:=SollDates[1]; // #1 formatted as nfFmtDateTime dm
SollDates[18]:=SollDates[1]; // #1 formatted as nfFmtDateTime my
SollDates[19]:=SollDates[1]; // #1 formatted as nfFmtDateTime ms
SollDates[20]:=SollDates[5]; // #5 formatted as nfShortDateTime
SollDates[21]:=SollDates[5]; // #5 formatted as nfShortTime
SollDates[22]:=SollDates[5]; // #5 formatted as nfLongTime
SollDates[23]:=SollDates[5]; // #5 formatted as nfShortTimeAM
SollDates[24]:=SollDates[5]; // #5 formatted as nfLongTimeAM
SollDates[25]:=SollDates[5]; // #5 formatted as nfFmtDateTime dm
SollDates[26]:=SollDates[5]; // #5 formatted as nfFmtDateTime my
SollDates[27]:=SollDates[5]; // #5 formatted as nfFmtDateTime ms
SollDates[28]:=SollDates[11]; // #11 formatted as nfShortDateTime
SollDates[29]:=SollDates[11]; // #11 formatted as nfShortTime
SollDates[30]:=SollDates[11]; // #11 formatted as nfLongTime
SollDates[31]:=SollDates[11]; // #11 formatted as nfShortTimeAM
SollDates[32]:=SollDates[11]; // #11 formatted as nfLongTimeAM
SollDates[33]:=SollDates[11]; // #11 formatted as nfFmtDateTime dm
SollDates[34]:=SollDates[11]; // #11 formatted as nfFmtDateTime my
SollDates[35]:=SollDates[11]; // #11 formatted as nfFmtDateTime ms
SollDates[36]:=EncodeTime(3,45,12,0); // formatted as nfTimeDuration
SollDates[37]:=EncodeTime(3,45,12,0) + 1 // formatted as nfTimeDuration
end;
{ TSpreadWriteReadDateTests }
@ -270,6 +352,136 @@ begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,11);
end;
procedure TSpreadReadDateTests.TestReadDate12;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,12);
end;
procedure TSpreadReadDateTests.TestReadDate13;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,13);
end;
procedure TSpreadReadDateTests.TestReadDate14;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,14);
end;
procedure TSpreadReadDateTests.TestReadDate15;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,15);
end;
procedure TSpreadReadDateTests.TestReadDate16;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,16);
end;
procedure TSpreadReadDateTests.TestReadDate17;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,17);
end;
procedure TSpreadReadDateTests.TestReadDate18;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,18);
end;
procedure TSpreadReadDateTests.TestReadDate19;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,19);
end;
procedure TSpreadReadDateTests.TestReadDate20;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,20);
end;
procedure TSpreadReadDateTests.TestReadDate21;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,21);
end;
procedure TSpreadReadDateTests.TestReadDate22;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,22);
end;
procedure TSpreadReadDateTests.TestReadDate23;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,23);
end;
procedure TSpreadReadDateTests.TestReadDate24;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,24);
end;
procedure TSpreadReadDateTests.TestReadDate25;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,25);
end;
procedure TSpreadReadDateTests.TestReadDate26;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,26);
end;
procedure TSpreadReadDateTests.TestReadDate27;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,27);
end;
procedure TSpreadReadDateTests.TestReadDate28;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,28);
end;
procedure TSpreadReadDateTests.TestReadDate29;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,29);
end;
procedure TSpreadReadDateTests.TestReadDate30;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,30);
end;
procedure TSpreadReadDateTests.TestReadDate31;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,31);
end;
procedure TSpreadReadDateTests.TestReadDate32;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,32);
end;
procedure TSpreadReadDateTests.TestReadDate33;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,33);
end;
procedure TSpreadReadDateTests.TestReadDate34;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,34);
end;
procedure TSpreadReadDateTests.TestReadDate35;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,35);
end;
procedure TSpreadReadDateTests.TestReadDate36;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,36);
end;
procedure TSpreadReadDateTests.TestReadDate37;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,37);
end;
procedure TSpreadReadDateTests.TestReadDate1899_0;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,0);
@ -330,6 +542,136 @@ begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,11);
end;
procedure TSpreadReadDateTests.TestReadDate1899_12;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,12);
end;
procedure TSpreadReadDateTests.TestReadDate1899_13;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,13);
end;
procedure TSpreadReadDateTests.TestReadDate1899_14;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,14);
end;
procedure TSpreadReadDateTests.TestReadDate1899_15;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,15);
end;
procedure TSpreadReadDateTests.TestReadDate1899_16;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,16);
end;
procedure TSpreadReadDateTests.TestReadDate1899_17;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,17);
end;
procedure TSpreadReadDateTests.TestReadDate1899_18;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,18);
end;
procedure TSpreadReadDateTests.TestReadDate1899_19;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,19);
end;
procedure TSpreadReadDateTests.TestReadDate1899_20;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,20);
end;
procedure TSpreadReadDateTests.TestReadDate1899_21;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,21);
end;
procedure TSpreadReadDateTests.TestReadDate1899_22;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,22);
end;
procedure TSpreadReadDateTests.TestReadDate1899_23;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,23);
end;
procedure TSpreadReadDateTests.TestReadDate1899_24;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,24);
end;
procedure TSpreadReadDateTests.TestReadDate1899_25;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,25);
end;
procedure TSpreadReadDateTests.TestReadDate1899_26;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,26);
end;
procedure TSpreadReadDateTests.TestReadDate1899_27;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,27);
end;
procedure TSpreadReadDateTests.TestReadDate1899_28;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,28);
end;
procedure TSpreadReadDateTests.TestReadDate1899_29;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,29);
end;
procedure TSpreadReadDateTests.TestReadDate1899_30;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,30);
end;
procedure TSpreadReadDateTests.TestReadDate1899_31;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,31);
end;
procedure TSpreadReadDateTests.TestReadDate1899_32;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,32);
end;
procedure TSpreadReadDateTests.TestReadDate1899_33;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,33);
end;
procedure TSpreadReadDateTests.TestReadDate1899_34;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,34);
end;
procedure TSpreadReadDateTests.TestReadDate1899_35;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,35);
end;
procedure TSpreadReadDateTests.TestReadDate1899_36;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,36);
end;
procedure TSpreadReadDateTests.TestReadDate1899_37;
begin
TestReadDate(ExtractFilePath(ParamStr(0)) + TestFileBIFF8_1899,37);
end;
initialization
// Register so these tests are included in a full run

225
components/fpspreadsheet/tests/formattests.pas Normal file
View File

@ -0,0 +1,225 @@
unit formattests;
{$mode objfpc}{$H+}
interface
uses
// Not using lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry,
fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
var
// Norm to test against - list of strings that should occur in spreadsheet
SollNumberStrings: array[0..6, 0..8] of string;
SollNumbers: array[0..6] of Double;
SollNumberFormats: array[0..8] of TsNumberFormat;
SollNumberDecimals: array[0..8] of word;
SollDateTimeStrings: array[0..4, 0..9] of string;
SollDateTimes: array[0..4] of TDateTime;
SollDateTimeFormats: array[0..9] of TsNumberFormat;
SollDateTimeFormatStrings: array[0..9] of String;
procedure InitSollFmtData;
type
{ TSpreadWriteReadFormatTests }
//Write to xls/xml file and read back
TSpreadWriteReadFormatTests = class(TTestCase)
private
protected
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
published
// Writes out numbers & reads back.
// If previous read tests are ok, this effectively tests writing.
procedure TestWriteReadNumberFormats;
// Repeat with date/times
procedure TestWriteReadDateTimeFormats;
end;
implementation
const
FmtNumbersSheet = 'Numbers';
FmtDateTimesSheet = 'Date/Times';
// Initialize array with variables that represent the values
// we expect to be in the test spreadsheet files.
//
// When adding tests, add values to this array
// and increase array size in variable declaration
procedure InitSollFmtData;
var
i: Integer;
begin
// Set up norm - MUST match spreadsheet cells exactly
// Numbers
SollNumbers[0] := 0.0;
SollNumbers[1] := 1.0;
SollNumbers[2] := -1.0;
SollNumbers[3] := 1.2345E6;
SollNumbers[4] := -1.23456E6;
SollNumbers[5] := 1.23456E-6;
SollNumbers[6] := -1.23456E-6;
SollNumberFormats[0] := nfGeneral; SollNumberDecimals[0] := 0;
SollNumberFormats[1] := nfFixed; SollNumberDecimals[1] := 0;
SollNumberFormats[2] := nfFixed; SollNumberDecimals[2] := 2;
SollNumberFormats[3] := nfFixedTh; SollNumberDecimals[3] := 0;
SollNumberFormats[4] := nfFixedTh; SollNumberDecimals[4] := 2;
SollNumberFormats[5] := nfExp; SollNumberDecimals[5] := 2;
SollNumberFormats[6] := nfSci; SollNumberDecimals[6] := 1;
SollNumberFormats[7] := nfPercentage; SollNumberDecimals[7] := 0;
SollNumberFormats[8] := nfPercentage; SollNumberDecimals[8] := 2;
for i:=Low(SollNumbers) to High(SollNumbers) do begin
SollNumberStrings[i, 0] := FloatToStr(SollNumbers[i]);
SollNumberStrings[i, 1] := FormatFloat('0', SollNumbers[i]);
SollNumberStrings[i, 2] := FormatFloat('0.00', SollNumbers[i]);
SollNumberStrings[i, 3] := FormatFloat('#,##0', SollNumbers[i]);
SollNumberStrings[i, 4] := FormatFloat('#,##0.00', SollNumbers[i]);
SollNumberStrings[i, 5] := FormatFloat('0.00E+00', SollNumbers[i]);
SollNumberStrings[i, 6] := SciFloat(SollNumbers[i], 1);
SollNumberStrings[i, 7] := FormatFloat('0', SollNumbers[i]*100) + '%';
SollNumberStrings[i, 8] := FormatFloat('0.00', SollNumbers[i]*100) + '%';
end;
// Date/time values
SollDateTimes[0] := EncodeDate(2012, 1, 12) + EncodeTime(13, 14, 15, 567);
SolLDateTimes[1] := EncodeDate(2012, 2, 29) + EncodeTime(0, 0, 0, 1);
SollDateTimes[2] := EncodeDate(2040, 12, 31) + EncodeTime(12, 0, 0, 0);
SollDateTimes[3] := 1 + EncodeTime(3,45, 0, 0);
SollDateTimes[4] := EncodeTime(12, 0, 0, 0);
SollDateTimeFormats[0] := nfShortDateTime; SollDateTimeFormatStrings[0] := '';
SollDateTimeFormats[1] := nfShortDate; SollDateTimeFormatStrings[1] := '';
SollDateTimeFormats[2] := nfShortTime; SollDateTimeFormatStrings[2] := '';
SollDateTimeFormats[3] := nfLongTime; SollDateTimeFormatStrings[3] := '';
SollDateTimeFormats[4] := nfShortTimeAM; SollDateTimeFormatStrings[4] := '';
SollDateTimeFormats[5] := nfLongTimeAM; SollDateTimeFormatStrings[5] := '';
SollDateTimeFormats[6] := nfFmtDateTime; SollDateTimeFormatStrings[6] := 'dm';
SolLDateTimeFormats[7] := nfFmtDateTime; SollDateTimeFormatStrings[7] := 'my';
SollDateTimeFormats[8] := nfFmtDateTime; SollDateTimeFormatStrings[8] := 'ms';
SollDateTimeFormats[9] := nfTimeInterval; SollDateTimeFormatStrings[9] := '';
for i:=Low(SollDateTimes) to High(SollDateTimes) do begin
SollDateTimeStrings[i, 0] := DateToStr(SollDateTimes[i]) + ' ' + FormatDateTime('t', SollDateTimes[i]);
SollDateTimeStrings[i, 1] := DateToStr(SollDateTimes[i]);
SollDateTimeStrings[i, 2] := FormatDateTime('t', SollDateTimes[i]);
SolLDateTimeStrings[i, 3] := FormatDateTime('tt', SollDateTimes[i]);
SollDateTimeStrings[i, 4] := FormatDateTime('t am/pm', SollDateTimes[i]);
SollDateTimeStrings[i, 5] := FormatDateTime('tt am/pm', SollDateTimes[i]);
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] := TimeIntervalToString(SollDateTimes[i]);
end;
end;
{ TSpreadWriteReadFormatTests }
procedure TSpreadWriteReadFormatTests.SetUp;
begin
inherited SetUp;
InitSollFmtData; //just for security: make sure the variables are reset to default
end;
procedure TSpreadWriteReadFormatTests.TearDown;
begin
inherited TearDown;
end;
procedure TSpreadWriteReadFormatTests.TestWriteReadNumberFormats;
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
ActualString: String;
Row, Col: Integer;
TempFile: string; //write xls/xml to this file and read back from it
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then
DeleteFile(TempFile);
}
// Write out all test values
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(FmtNumbersSheet);
for Row := Low(SollNumbers) to High(SollNumbers) do
for Col := ord(Low(SollNumberFormats)) to ord(High(SollNumberFormats)) do begin
MyWorksheet.WriteNumber(Row, Col, SollNumbers[Row], SollNumberFormats[Col], SollNumberDecimals[Col]);
ActualString := MyWorksheet.ReadAsUTF8Text(Row, Col);
CheckEquals(SollNumberStrings[Row, Col], ActualString, 'Test unsaved string mismatch cell ' + CellNotation(MyWorksheet,Row,Col));
end;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet:=GetWorksheetByName(MyWorkBook, FmtNumbersSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for Row := Low(SollNumbers) to High(SollNumbers) do
for Col := Low(SollNumberFormats) to High(SollNumberFormats) do begin
ActualString := MyWorkSheet.ReadAsUTF8Text(Row,Col);
CheckEquals(SollNumberStrings[Row,Col],ActualString,'Test saved string mismatch cell '+CellNotation(MyWorkSheet,Row,Col));
end;
// Finalization
MyWorkbook.Free;
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadFormatTests.TestWriteReadDateTimeFormats;
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
ActualString: String;
Row,Col: Integer;
TempFile: string; //write xls/xml to this file and read back from it
begin
TempFile:=GetTempFileName;
// Write out all test values
MyWorkbook := TsWorkbook.Create;
MyWorksheet := MyWorkbook.AddWorksheet(FmtDateTimesSheet);
for Row := Low(SollDateTimes) to High(SollDateTimes) do
for Col := Low(SollDateTimeFormats) to High(SollDateTimeFormats) do begin
MyWorksheet.WriteDateTime(Row, Col, SollDateTimes[Row], SollDateTimeFormats[Col], SollDateTimeFormatStrings[Col]);
ActualString := MyWorksheet.ReadAsUTF8Text(Row, Col);
CheckEquals(SollDateTimeStrings[Row, Col], ActualString, 'Test unsaved string mismatch cell ' + CellNotation(MyWorksheet,Row,Col));
end;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet := GetWorksheetByName(MyWorkbook, FmtDateTimesSheet);
if MyWorksheet = nil then
fail('Error in test code. Failed to get named worksheet');
for Row := Low(SollDateTimes) to High(SollDateTimes) do
for Col := Low(SollDateTimeFormats) to High(SollDateTimeFormats) do begin
ActualString := myWorksheet.ReadAsUTF8Text(Row,Col);
CheckEquals(SollDateTimeStrings[Row, Col], ActualString, 'Test saved string mismatch cell '+CellNotation(MyWorksheet,Row,Col));
end;
// Finalization
MyWorkbook.Free;
DeleteFile(TempFile);
end;
initialization
RegisterTest(TSpreadWriteReadFormatTests);
InitSollFmtData;
end.

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

@ -26,7 +26,7 @@ uses
var
// Norm to test against - list of dates/times that should occur in spreadsheet
SollColors: array[0..22] of tsColor; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;)
SollColors: array[0..22] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
SollColorNames: array[0..22] of string; //matching names for SollColors
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.

58
components/fpspreadsheet/tests/numberstests.pas
View File

@ -22,7 +22,7 @@ uses
var
// Norm to test against - list of numbers/times that should occur in spreadsheet
SollNumbers: array[0..12] of double; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;)
SollNumbers: array[0..20] of double; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.
procedure InitSollNumbers;
@ -53,6 +53,14 @@ type
procedure TestReadNumber9;
procedure TestReadNumber10;
procedure TestReadNumber11;
procedure TestReadNumber12;
procedure TestReadNumber13;
procedure TestReadNumber14;
procedure TestReadNumber15;
procedure TestReadNumber16;
procedure TestReadNumber17;
procedure TestReadNumber18;
procedure TestReadNumber19;
end;
{ TSpreadWriteReadNumberTests }
@ -98,6 +106,14 @@ begin
SollNumbers[10]:=3.14159265358979; //some parts of pi
SollNumbers[11]:=59000000; //59 million
SollNumbers[12]:=59000000.1; //same + a tenth
SollNumbers[13]:=0.3536; // 0.3536 formatted as percentage, no decimals
SollNumbers[14]:=0.3536; // 0.3536 formatted as percentage, 2 decimals
SollNumbers[15]:=59000000.1234; // 59 million + 0.1234 formatted with thousand separator, no decimals
SollNumbers[16]:=59000000.1234; // 59 million + 0.1234 formatted with thousand separator, 2 decimals
SollNumbers[17]:=-59000000.1234; // minus 59 million + 0.1234, formatted as "scientific" with 1 decimal
SollNumbers[18]:=-59000000.1234; // minus 59 million + 0.1234, formatted as "exp" with 2 decimals
SollNumbers[19]:=59000000.1234; // 59 million + 0.1234 formatted as currrency (EUROs), 2 decimals
SollNumbers[20]:=59000000.1234; // 59 million + 0.1234 formatted as currrency (Dollars), 2 decimals
end;
{ TSpreadWriteReadNumberTests }
@ -252,6 +268,46 @@ begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,11);
end;
procedure TSpreadReadNumberTests.TestReadNumber12;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,12);
end;
procedure TSpreadReadNumberTests.TestReadNumber13;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,13);
end;
procedure TSpreadReadNumberTests.TestReadNumber14;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,14);
end;
procedure TSpreadReadNumberTests.TestReadNumber15;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,15);
end;
procedure TSpreadReadNumberTests.TestReadNumber16;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,16);
end;
procedure TSpreadReadNumberTests.TestReadNumber17;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,17);
end;
procedure TSpreadReadNumberTests.TestReadNumber18;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,16);
end;
procedure TSpreadReadNumberTests.TestReadNumber19;
begin
TestReadNumber(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,17);
end;
initialization
// Register so these tests are included in a full run

2
components/fpspreadsheet/tests/spreadtestcli.lpr
View File

@ -10,7 +10,7 @@ uses
testregistry,
testdbwriter {used to get results into db},
datetests, manualtests, numberstests, stringtests, internaltests,
testsutility, testutils {the actual tests};
testsutility, testutils, formattests {the actual tests};
const
ShortOpts = 'ac:dhlpr:x';

18
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
@ -21,9 +21,13 @@
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="spreadtestgui"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="units\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
@ -75,7 +79,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="7">
<Units Count="8">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@ -111,6 +115,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -140,7 +149,7 @@
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
@ -150,6 +159,9 @@
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EAssertionFailedError"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

2
components/fpspreadsheet/tests/spreadtestgui.lpr
View File

@ -5,7 +5,7 @@ program spreadtestgui;
uses
Interfaces, Forms, GuiTestRunner,
datetests, stringtests,
numberstests, manualtests, testsutility, internaltests;
numberstests, manualtests, testsutility, internaltests, formattests;
begin
Application.Initialize;

45
components/fpspreadsheet/tests/stringtests.pas
View File

@ -22,7 +22,7 @@ uses
var
// Norm to test against - list of strings that should occur in spreadsheet
SollStrings: array[0..6] of string; //"Soll" is a German word in Dutch accountancy circles meaning "normative value to check against". There ;)
SollStrings: array[0..12] of string; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.
procedure InitSollStrings;
@ -48,6 +48,12 @@ type
procedure TestReadString4;
procedure TestReadString5;
procedure TestReadString6;
procedure TestReadString7;
procedure TestReadString8;
procedure TestReadString9;
procedure TestReadString10;
procedure TestReadString11;
procedure TestReadString12;
end;
{ TSpreadWriteReadStringTests }
@ -84,6 +90,12 @@ begin
SollStrings[4]:='café au lait'; //accent aigue on the e
SollStrings[5]:='водка'; //cyrillic
SollStrings[6]:='wódka'; //Polish o accent aigue
SollStrings[7]:='35%'; // 0.3536 formatted as percentage, no decimals
SollStrings[8]:=FormatFloat('0.00', 35.36)+'%'; // 0.3536 formatted as percentage, 2 decimals
SollStrings[9]:=FormatFloat('#,##0', 59000000.1234); // 59 million + 0.1234 formatted with thousand separator, no decimals
SollStrings[10]:=FormatFloat('#,##0.00', 59000000.1234); // 59 million + 0.1234 formatted with thousand separator, 2 decimals
SollStrings[11]:=SciFloat(-59000000.1234, 1); // minus 59 million + 0.1234, formatted as "scientific" with 1 decimal
SollStrings[12]:=FormatFloat('0.00E+00', -59000000.1234); // minus 59 million + 0.1234, formatted as "exp" with 2 decimals
end;
{ TSpreadWriteReadStringTests }
@ -318,6 +330,37 @@ begin
TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,6);
end;
procedure TSpreadReadStringTests.TestReadString7;
begin
TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,7);
end;
procedure TSpreadReadStringTests.TestReadString8;
begin
TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,8);
end;
procedure TSpreadReadStringTests.TestReadString9;
begin
TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,9);
end;
procedure TSpreadReadStringTests.TestReadString10;
begin
TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,10);
end;
procedure TSpreadReadStringTests.TestReadString11;
begin
TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,11);
end;
procedure TSpreadReadStringTests.TestReadString12;
begin
TestReadString(ExtractFilePath(ParamStr(0)) + TestFileBIFF8,12);
end;
initialization
// Register so these tests are included in a full run
RegisterTest(TSpreadReadStringTests);

BIN
components/fpspreadsheet/tests/testbiff8.xls
View File

Binary file not shown.

BIN
components/fpspreadsheet/tests/testbiff8_1899.xls
View File

Binary file not shown.

16
components/fpspreadsheet/xlsbiff2.pas
View File

@ -70,6 +70,7 @@ type
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
end;
implementation
@ -407,6 +408,21 @@ begin
AStream.WriteBuffer(AValue, 8);
end;
{*******************************************************************
* TsSpreadBIFF2Writer.WriteDateTime ()
*
* DESCRIPTION: Writes a date/time value as a text
*
* No further formatting applied.
*
*******************************************************************}
procedure TsSpreadBIFF2Writer.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
begin
WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell);
end;
{ TsSpreadBIFF2Reader }
procedure TsSpreadBIFF2Reader.ReadFromStream(AStream: TStream; AData: TsWorkbook);

15
components/fpspreadsheet/xlsbiff5.pas
View File

@ -118,6 +118,7 @@ type
procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
//procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding); this is in xlscommon
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TFPCustomFont);
@ -875,6 +876,20 @@ begin
AStream.WriteBuffer(AValue, 8);
end;
{*******************************************************************
* TsSpreadBIFF5Writer.WriteDateTime ()
*
* DESCRIPTION: Writes a date/time value as a string
*
* No further formatting of the date
*
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
begin
WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell);
end;
{*******************************************************************
* TsSpreadBIFF5Writer.WriteStyle ()
*

231
components/fpspreadsheet/xlsbiff8.pas
View File

@ -87,10 +87,12 @@ type
FXFList: TFPList; // of TXFRecordData
FFormatList: TFPList; // of TFormatRecordData
function DecodeRKValue(const ARK: DWORD): Double;
procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ADecimals: Word;
out ANumberFormatStr: String);
// Tries to find if a number cell is actually a date/datetime/time cell
// and retrieve the value
function IsDate(Number: Double; ARow: WORD;
ACol: WORD; AXFIndex: WORD; var ADateTime: TDateTime): boolean;
function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat; var ADateTime: TDateTime): Boolean;
function ReadWideString(const AStream: TStream; const ALength: WORD): WideString; overload;
function ReadWideString(const AStream: TStream; const AUse8BitLength: Boolean): WideString; overload;
procedure ReadWorkbookGlobals(AStream: TStream; AData: TsWorkbook);
@ -350,6 +352,7 @@ var
lBorders: TsCellBorders;
lAddBackground: Boolean;
lBackgroundColor: TsColor;
fmt: String;
begin
// The first 4 styles were already added
for i := 4 to Length(FFormattingStyles) - 1 do
@ -364,13 +367,63 @@ begin
// Now apply the modifications.
if uffNumberFormat in FFormattingStyles[i].UsedFormattingFields then
begin
case FFormattingStyles[i].NumberFormat of
nfGeneral: lFormatIndex := FORMAT_GENERAL;
nfShortDate: lFormatIndex := FORMAT_SHORT_DATE;
nfShortDateTime: lFormatIndex := FORMAT_SHORT_DATETIME;
nfFixed:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_FIXED_0_DECIMALS;
2: lFormatIndex := FORMAT_FIXED_2_DECIMALS;
end;
nfFixedTh:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_FIXED_THOUSANDS_0_DECIMALS;
2: lFormatIndex := FORMAT_FIXED_THOUSANDS_2_DECIMALS;
end;
nfExp:
lFormatIndex := FORMAT_EXP_2_DECIMALS;
nfSci:
lFormatIndex := FORMAT_SCI_1_DECIMAL;
nfPercentage:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_PERCENT_0_DECIMALS;
2: lFormatIndex := FORMAT_PERCENT_2_DECIMALS;
end;
{
nfCurrency:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_CURRENCY_0_DECIMALS;
2: lFormatIndex := FORMAT_CURRENCY_2_DECIMALS;
end;
}
nfShortDate:
lFormatIndex := FORMAT_SHORT_DATE;
nfShortTime:
lFormatIndex := FORMAT_SHORT_TIME;
nfLongTime:
lFormatIndex := FORMAT_LONG_TIME;
nfShortTimeAM:
lFormatIndex := FORMAT_SHORT_TIME_AM;
nfLongTimeAM:
lFormatIndex := FORMAT_LONG_TIME_AM;
nfShortDateTime:
lFormatIndex := FORMAT_SHORT_DATETIME;
nfFmtDateTime:
begin
fmt := lowercase(FFormattingStyles[i].NumberFormatStr);
if (fmt = 'dm') or (fmt = 'd-mmm') or (fmt = 'd mmm') or (fmt = 'd. mmm') or (fmt = 'd/mmm') then
lFormatIndex := FORMAT_DATE_DM
else
if (fmt = 'my') or (fmt = 'mmm-yy') or (fmt = 'mmm yy') or (fmt = 'mmm/yy') then
lFormatIndex := FORMAT_DATE_MY
else
if (fmt = 'ms') or (fmt = 'nn:ss') or (fmt = 'mm:ss') then
lFormatIndex := FORMAT_TIME_MS
else
if (fmt = 'msz') or (fmt = 'nn:ss.zzz') or (fmt = 'mm:ss.zzz') or (fmt = 'mm:ss.0') or (fmt = 'mm:ss.z') or (fmt = 'nn:ss.z') then
lFormatIndex := FORMAT_TIME_MSZ
end;
nfTimeInterval:
lFormatIndex := FORMAT_TIME_INTERVAL;
end;
end;
if uffBorder in FFormattingStyles[i].UsedFormattingFields then
lBorders := FFormattingStyles[i].Border;
@ -1451,47 +1504,127 @@ begin
Result:=Number;
end;
function TsSpreadBIFF8Reader.IsDate(Number: Double;
ARow: WORD; ACol: WORD; AXFIndex: WORD; var ADateTime: TDateTime): boolean;
// Try to find out if a cell has a date/time and return
// TheDate if it is
procedure TsSpreadBIFF8Reader.ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ADecimals: Word;
out ANumberFormatStr: String);
const
{ see ➜ 5.49 }
NOT_USED = nfGeneral;
fmts: array[1..58] of TsNumberFormat = (
nfFixed, nfFixed, nfFixedTh, nfFixedTh, nfFixedTh, // 1..5
nfFixedTh, nfFixedTh, nfFixedTh, nfPercentage, nfPercentage, // 6..10
nfExp, NOT_USED, NOT_USED, nfShortDate, nfShortDate, // 11..15
nfFmtDateTime, nfFmtDateTime, nfShortTimeAM, nfLongTimeAM, nfShortTime, // 16..20
nfLongTime, nfShortDateTime, NOT_USED, NOT_USED, NOT_USED, // 21..25
NOT_USED, NOT_USED, NOT_USED, NOT_USED, NOT_USED, // 26..30
NOT_USED, NOT_USED, NOT_USED, NOT_USED, NOT_USED, // 31..35
NOT_USED, nfFixedTh, nfFixedTh, nfFixedTh, nfFixedTh, // 36..40
nfFixedTh, nfFixedTh, nfFixedTh, nfFixedTh, nfFmtDateTime, // 41..45
nfTimeInterval, nfFmtDateTime, nfSci, NOT_USED, NOT_USED, // 46..50
NOT_USED, NOT_USED, NOT_USED, NOT_USED, NOT_USED, // 51..55
NOT_USED, NOT_USED, NOT_USED // 56..58
);
decs: array[1..58] of word = (
0, 2, 0, 2, 0, 0, 2, 2, 0, 2, // 1..10
2, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 11..20
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 21..30
0, 0, 0, 0, 0, 0, 0, 0, 2, 2, // 31..40
0, 0, 2, 2, 0, 3, 0, 1, 0, 0, // 41..50 #48 is "scientific", use "exponential" instead
0, 0, 0, 0, 0, 0, 0, 0); // 51..58
var
lFormatData: TFormatRecordData;
lXFData: TXFRecordData;
isAMPM: Boolean;
isLongTime: Boolean;
isMilliSec: Boolean;
t,d: Boolean;
begin
result := false;
// Try to figure out if the number is really a number of a date or time value
// See: http://www.gaia-gis.it/FreeXL/freexl-1.0.0a-doxy-doc/Format.html
// Unfornately Excel doesnt give us a direct way to find this,
// we need to guess by the FORMAT field
// Note FindFormatRecordForCell will not retrieve default format numbers
ANumberFormat := nfGeneral;
ANumberFormatStr := '';
ADecimals := 0;
lFormatData := FindFormatRecordForCell(AXFIndex);
{Record FORMAT, BIFF8 (5.49):
Offset Size Contents
0 2 Format index used in other records
}
if lFormatData=nil then
begin
// No custom format, so first test for default formats
lXFData := TXFRecordData(FXFList.Items[AXFIndex]);
if (lXFData.FormatIndex in [14..22, 27..36, 45, 46, 47, 50..58]) then
begin
ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode);
Exit(true);
if lFormatData = nil then begin
// no custom format, so first test for default formats
lXFData := TXFRecordData (FXFList.Items[AXFIndex]);
case lXFData.FormatIndex of
FORMAT_DATE_DM:
begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'DM'; end;
FORMAT_DATE_MY:
begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'MY'; end;
FORMAT_TIME_MS:
begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'MS'; end;
FORMAT_TIME_MSZ:
begin ANumberFormat := nfFmtDateTime; ANumberFormatStr := 'MSZ'; end;
else
if (lXFData.FormatIndex > 0) and (lXFData.FormatIndex <= 58) then begin
ANumberFormat := fmts[lXFData.FormatIndex];
ADecimals := decs[lXFData.FormatIndex];
end;
end;
end
end else
// Check custom formats if they have / in format string (this can fail for
// custom text formats)
if IsPercentNumberFormat(lFormatData.FormatString, ADecimals) then
ANumberFormat := nfPercentage
else
begin
// Check custom formats if they
// have / in format string (this can fail for custom text formats)
if (Pos('/', lFormatData.FormatString) > 0) then
begin
ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode);
Exit(true);
if IsExpNumberFormat(lFormatData.Formatstring, ADecimals) then
ANumberFormat := nfExp
else
if IsThousandSepNumberFormat(lFormatData.FormatString, ADecimals) then
ANumberFormat := nfFixedTh
else
if IsFixedNumberFormat(lFormatData.FormatString, ADecimals) then
ANumberFormat := nfFixed
else begin
t := IsTimeFormat(lFormatData.FormatString, isLongTime, isAMPM, isMilliSec);
d := IsDateFormat(lFormatData.FormatString);
if d and t then
ANumberFormat := nfShortDateTime
else
if d then
ANumberFormat := nfShortDate
else
if t then begin
if isAMPM then begin
if isLongTime then
ANumberFormat := nfLongTimeAM
else
ANumberFormat := nfShortTimeAM;
end else begin
if isLongTime then
ANumberFormat := nfLongTime
else
ANumberFormat := nfShortTime;
end;
end;
end;
ADateTime := 0;
end;
function TsSpreadBIFF8Reader.IsDateTime(Number: Double;
ANumberFormat: TsNumberFormat; var ADateTime: TDateTime): boolean;
// Convert the number to a date/time and return that if it is
begin
if ANumberFormat in [
nfShortDateTime, nfFmtDateTime, nfShortDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM] then
begin
ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode);
Result := true;
end else
if ANumberFormat = nfTimeInterval then begin
ADateTime := Number;
Result := true;
end else
begin
ADateTime := 0;
Result := false;
end;
end;
function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream;
@ -1718,6 +1851,9 @@ var
ARow, ACol, XF: WORD;
lDateTime: TDateTime;
Number: Double;
nf: TsNumberFormat; // Number format
nd: word; // decimals
nfs: String; // Number format string
begin
{Retrieve XF record, row and column}
ReadRowColXF(AStream,ARow,ACol,XF);
@ -1729,10 +1865,11 @@ begin
Number:=DecodeRKValue(RK);
{Find out what cell type, set contenttype and value}
if IsDate(Number, ARow, ACol, XF, lDateTime) then
FWorksheet.WriteDateTime(ARow, ACol, lDateTime)
ExtractNumberFormat(XF, nf, nd, nfs);
if IsDateTime(Number, nf, lDateTime) then
FWorksheet.WriteDateTime(ARow, ACol, lDateTime, nf, nfs)
else
FWorksheet.WriteNumber(ARow,ACol,Number);
FWorksheet.WriteNumber(ARow, ACol, Number, nf);
end;
procedure TsSpreadBIFF8Reader.ReadMulRKValues(const AStream: TStream);
@ -1742,6 +1879,9 @@ var
Pending: integer;
RK: DWORD;
Number: Double;
nf: TsNumberFormat;
nd: word;
nfs: String;
begin
ARow:=WordLEtoN(AStream.ReadWord);
fc:=WordLEtoN(AStream.ReadWord);
@ -1751,10 +1891,11 @@ begin
RK:=DWordLEtoN(AStream.ReadDWord);
Number:=DecodeRKValue(RK);
{Find out what cell type, set contenttype and value}
if IsDate(Number, ARow, fc, XF, lDateTime) then
FWorksheet.WriteDateTime(ARow, fc, lDateTime)
ExtractNumberFormat(XF, nf, nd, nfs);
if IsDateTime(Number, nf, lDateTime) then
FWorksheet.WriteDateTime(ARow, fc, lDateTime, nf, nfs)
else
FWorksheet.WriteNumber(ARow,fc,Number);
FWorksheet.WriteNumber(ARow, fc, Number, nf, nd);
inc(fc);
dec(Pending,(sizeof(XF)+sizeof(RK)));
end;
@ -1941,6 +2082,9 @@ var
ARow, ACol, XF: Word;
AValue: Double;
lDateTime: TDateTime;
nf: TsNumberFormat;
nd: word;
nfs: String;
begin
{Retrieve XF record, row and column}
ReadRowColXF(AStream,ARow,ACol,XF);
@ -1949,10 +2093,11 @@ begin
AStream.ReadBuffer(AValue, 8);
{Find out what cell type, set contenttype and value}
if IsDate(AValue, ARow, ACol, XF, lDateTime) then
FWorksheet.WriteDateTime(ARow, ACol, lDateTime)
ExtractNumberFormat(XF, nf, nd, nfs);
if IsDateTime(AValue, nf, lDateTime) then
FWorksheet.WriteDateTime(ARow, ACol, lDateTime, nf, nfs)
else
FWorksheet.WriteNumber(ARow,ACol,AValue);
FWorksheet.WriteNumber(ARow,ACol,AValue,nf,nd);
end;
procedure TsSpreadBIFF8Reader.ReadRichString(const AStream: TStream);

233
components/fpspreadsheet/xlscommon.pas
View File

@ -137,10 +137,30 @@ const
DATEMODE_1904_BASE=1462; //1/1/1904 in FPC TDateTime
{ FORMAT record constants }
// Just a subset; needed for output to date/time records
FORMAT_GENERAL = 0; //general/default format
FORMAT_SHORT_DATE = 14; //short date
FORMAT_SHORT_DATETIME = 22; //short date+time
// Subset of the built-in formats for US Excel,
// including those needed for date/time output
FORMAT_GENERAL = 0; //general/default format
FORMAT_FIXED_0_DECIMALS = 1; //fixed, 0 decimals
FORMAT_FIXED_2_DECIMALS = 2; //fixed, 2 decimals
FORMAT_FIXED_THOUSANDS_0_DECIMALS = 3; //fixed, w/ thousand separator, 0 decs
FORMAT_FIXED_THOUSANDS_2_DECIMALS = 4; //fixed, w/ thousand separator, 2 decs
FORMAT_CURRENCY_0_DECIMALS = 5; //currency (with currency symbol), 0 decs
FORMAT_CURRENCY_2_DECIMALS = 7; //currency (with currency symbol), 2 decs
FORMAT_PERCENT_0_DECIMALS = 9; //percent, 0 decimals
FORMAT_PERCENT_2_DECIMALS = 10; //percent, 2 decimals
FORMAT_EXP_2_DECIMALS = 11; //exponent, 2 decimals
FORMAT_SCI_1_DECIMAL = 48; //scientific, 1 decimal
FORMAT_SHORT_DATE = 14; //short date
FORMAT_DATE_DM = 16; //date D-MMM
FORMAT_DATE_MY = 17; //date MMM-YYYY
FORMAT_SHORT_TIME_AM = 18; //short time H:MM with AM
FORMAT_LONG_TIME_AM = 19; //long time H:MM:SS with AM
FORMAT_SHORT_TIME = 20; //short time H:MM
FORMAT_LONG_TIME = 21; //long time H:MM:SS
FORMAT_SHORT_DATETIME = 22; //short date+time
FORMAT_TIME_MS = 45; //time MM:SS
FORMAT_TIME_MSZ = 47; //time MM:SS.0
FORMAT_TIME_INTERVAL = 46; //time [hh]:mm:ss, hh can be >24
type
@ -191,6 +211,15 @@ type
constructor Create; override;
end;
function IsExpNumberFormat(s: String; out Decimals: Word): Boolean;
function IsFixedNumberFormat(s: String; out Decimals: Word): Boolean;
function IsPercentNumberFormat(s: String; out Decimals: Word): Boolean;
function IsThousandSepNumberFormat(s: String; out Decimals: Word): Boolean;
function IsDateFormat(s: String): Boolean;
function IsTimeFormat(s: String; out isLong, isAMPM, isMillisec: Boolean): Boolean;
implementation
function ConvertExcelDateTimeToDateTime(
@ -467,5 +496,201 @@ begin
FDateMode := dm1900;
end;
{ Format checking procedures }
{ This simple parsing procedure of the Excel format string checks for a fixed
float format s, i.e. s can be '0', '0.00', '000', '0,000', and returns the
number of decimals, i.e. number of zeros behind the decimal point }
function IsFixedNumberFormat(s: String; out Decimals: Word): Boolean;
var
i: Integer;
p: Integer;
decs: String;
begin
Decimals := 0;
// Check if s is a valid format mask.
try
FormatFloat(s, 1.0);
except
on EConvertError do begin
Result := false;
exit;
end;
end;
// If it is count the zeros - each one is a decimal.
if s = '0' then
Result := true
else begin
p := pos('.', s); // position of decimal point;
if p = 0 then begin
Result := false;
end else begin
Result := true;
for i:= p+1 to Length(s) do
if s[i] = '0' then begin
inc(Decimals)
end
else
exit; // ignore characters after the last 0
end;
end;
end;
{ This function checks whether the format string corresponds to a thousand
separator format like "#,##0.000' and returns the number of fixed decimals
(i.e. zeros after the decimal point) }
function IsThousandSepNumberFormat(s: String; out Decimals: Word): Boolean;
var
i, p: Integer;
begin
Decimals := 0;
// Check if s is a valid format string
try
FormatFloat(s, 1.0);
except
on EConvertError do begin
Result := false;
exit;
end;
end;
// If it is look for the thousand separator. If found count decimals.
Result := (Pos(',', s) > 0);
if Result then begin
p := pos('.', s);
if p > 0 then
for i := p+1 to Length(s) do
if s[i] = '0' then
inc(Decimals)
else
exit; // ignore format characters after the last 0
end;
end;
{ This function checks whether the format string corresponds to percent
formatting and determines the number of decimals }
function IsPercentNumberFormat(s: String; out Decimals: Word): Boolean;
var
i, p: Integer;
begin
Decimals := 0;
// The signature of the percent format is a percent sign at the end of the
// format string.
Result := (s <> '') and (s[Length(s)] = '%');
if Result then begin
// Check for a valid format string
Delete(s, Length(s), 1);
try
FormatDateTime(s, 1.0);
except
on EConvertError do begin
Result := false;
exit;
end;
end;
// Count decimals
p := pos('.', s);
if p > 0 then
for i := p+1 to Length(s)-1 do
if s[i] = '0' then
inc(Decimals)
else
exit; // ignore characters after last 0
end;
end;
{ This function checks whether the format string corresponds to exponential
formatting and determines the number decimals }
function IsExpNumberFormat(s: String; out Decimals: Word): Boolean;
var
i, p, pe: Integer;
begin
Decimals := 0;
// Check for a valid format string
try
FormatDateTime(s, 1.0);
except
on EConvertError do begin
Result := false;
exit;
end;
end;
// Count decimals
pe := pos('e', lowercase(s));
result := pe > 0;
if Result then begin
p := pos('.', s);
if (p > 0) then begin
if p < pe then
for i:=1 to pe-1 do
if s[i] = '0' then
inc(Decimals)
else
exit; // ignore characters after last 0
end;
end;
end;
{ IsDateFormat checks if the format string s corresponds to a date format }
function IsDateFormat(s: String): Boolean;
begin
// Day, month, year are separated by a slash
Result := (pos('/', s) > 0);
if Result then
// Check validity of format string
try
FormatDateTime(s, now);
except on EConvertError do
Result := false;
end;
end;
{ IsTimeFormat checks if the format string s is a time format. isLong is
true if the string contains hours, minutes and seconds (two colons).
isAMPM is true if the string contains "AM/PM", "A/P" or "AMPM".
isMilliSec is true if the string ends with a "z". }
function IsTimeFormat(s: String; out isLong, isAMPM, isMillisec: Boolean): Boolean;
var
p, i, count: Integer;
begin
// Time parts are separated by a colon
p := pos(':', s);
isLong := false;
isAMPM := false;
result := p > 0;
if Result then begin
count := 1;
s := Uppercase(s);
// If there are is a second colon s is a "long" time format
for i:=p+1 to Length(s) do
if s[i] = ':' then begin
isLong := true;
break;
end;
// Seek for "AM/PM" etc to detect that specific format
isAMPM := (pos('AM/PM', s) > 0) or (pos('A/P', s) > 0) or (pos('AMPM', s) > 0);
// Look for the "milliseconds" character z
isMilliSec := (s[Length(s)] = 'Z');
// Check validity of format string
try
FormatDateTime(s, now);
except on EConvertError do
Result := false;
end;
end;
end;
end.

11
components/fpspreadsheet/xlsxooxml.pas
View File

@ -75,6 +75,7 @@ type
//todo: add WriteDate
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
end;
implementation
@ -517,6 +518,16 @@ begin
Format(' <c r="%s" s="0" t="n"><v>%s</v></c>', [CellPosText, CellValueText]) + LineEnding;
end;
{
Writes the date/time as a text to the sheet.
No further formatting applied.
}
procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
begin
WriteLabel(AStream, ARow, ACol, FormatDateTime('c', AValue), ACell);
end;
{
Registers this reader / writer on fpSpreadsheet
}