fpspreadsheet: Improved number format parser

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4082 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-04-18 14:58:38 +00:00
parent 088f219acc
commit 03b7dedde7
34 changed files with 3077 additions and 2559 deletions

View File

@ -110,5 +110,8 @@ begin
workbook.Free; workbook.Free;
end; end;
WriteLn('Press ENTER to quit...');
ReadLn;
end. end.

View File

@ -14,7 +14,6 @@ uses
var var
MyWorkbook: TsWorkbook; MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;
MyRPNFormula: TsRPNFormula;
MyDir: string; MyDir: string;
number: Double; number: Double;
lCol: TCol; lCol: TCol;

View File

@ -12,6 +12,9 @@ program excel2write;
uses uses
Classes, SysUtils, fpsTypes, fpspreadsheet, xlsbiff2; Classes, SysUtils, fpsTypes, fpspreadsheet, xlsbiff2;
const
NA_COLOR = scCyan; // Color if number format is not available in biff2
var var
MyWorkbook: TsWorkbook; MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;
@ -89,10 +92,10 @@ begin
// Write cell with background color // Write cell with background color
MyWorksheet.WriteUTF8Text(3, 0, 'Text'); MyWorksheet.WriteUTF8Text(3, 0, 'Text');
MyWorksheet.WriteBackgroundColor(3, 0, scSilver); MyWorksheet.WriteBackgroundColor(3, 0, NA_COLOR);
// Empty cell with background color // Empty cell with background color
MyWorksheet.WriteBackgroundColor(3, 1, scGrey); MyWorksheet.WriteBackgroundColor(3, 1, NA_COLOR);
// Cell2 with top and bottom borders // Cell2 with top and bottom borders
MyWorksheet.WriteUTF8Text(4, 0, 'Text'); MyWorksheet.WriteUTF8Text(4, 0, 'Text');
@ -121,7 +124,7 @@ begin
r:= 10; r:= 10;
// Write current date/time and test numbers for various formatting options // Write current date/time and test numbers for various formatting options
MyWorksheet.WriteUTF8Text(r, 1, 'Formats in gray cells are not supported by BIFF2'); MyWorksheet.WriteUTF8Text(r, 1, 'Formats in cyan cells are not supported by BIFF2');
inc(r, 2); inc(r, 2);
MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate'); MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDate');
@ -139,11 +142,11 @@ begin
MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDateTime'); MyWorksheet.WriteUTF8Text(r, 0, 'nfShortDateTime');
MyWorksheet.WriteDateTime(r, 1, now, nfShortDateTime); MyWorksheet.WriteDateTime(r, 1, now, nfShortDateTime);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''dd/mmm'''); MyWorksheet.WriteUTF8Text(r, 0, 'nfDayMonth');
MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'dd/mmm'''); MyWorksheet.WriteDateTime(r, 1, now, nfDayMonth);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, ''mmm/yy'''); MyWorksheet.WriteUTF8Text(r, 0, 'nfMonthYear');
MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mmm/yy'); MyWorksheet.WriteDateTime(r, 1, now, nfMonthYear);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTimeAM'); MyWorksheet.WriteUTF8Text(r, 0, 'nfShortTimeAM');
MyWorksheet.WriteDateTime(r, 1, now, nfShortTimeAM); MyWorksheet.WriteDateTime(r, 1, now, nfShortTimeAM);
@ -153,15 +156,15 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, nn:ss'); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, nn:ss');
MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'nn:ss'); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'nn:ss');
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, nn:ss.z'); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, nn:ss.z');
MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'nn:ss.z'); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'nn:ss.z');
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, mm:ss.zzz'); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, mm:ss.zzz');
MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.zzz'); MyWorksheet.WriteDateTime(r, 1, now, nfCustom, 'mm:ss.zzz');
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
// Write formatted numbers // Write formatted numbers
number := 12345.67890123456789; number := 12345.67890123456789;
@ -179,9 +182,9 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 1 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 1 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixed, 1); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 1);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 1); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 1);
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 2 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 2 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixed, 2); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 2);
@ -189,9 +192,9 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 3 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixed, 3 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixed, 3); MyWorksheet.WriteNumber(r, 1, number, nfFixed, 3);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 3); MyWorksheet.WriteNumber(r, 2, -number, nfFixed, 3);
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 0 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 0 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 0); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 0);
@ -199,9 +202,9 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 1 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 1 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 1); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 1);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 1); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 1);
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 2 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 2 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 2); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 2);
@ -209,19 +212,19 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 3 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfFixedTh, 3 decs');
MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 3); MyWorksheet.WriteNumber(r, 1, number, nfFixedTh, 3);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 3); MyWorksheet.WriteNumber(r, 2, -number, nfFixedTh, 3);
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 1 dec'); MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 1 dec');
MyWorksheet.WriteNumber(r, 1, number, nfExp, 1); MyWorksheet.WriteNumber(r, 1, number, nfExp, 1);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number, nfExp, 1); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 1);
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 1); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 1);
MyWorksheet.WriteFontColor(r, 3, scGray); MyWorksheet.WriteFontColor(r, 3, NA_COLOR);
MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 1); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 1);
MyWorksheet.WriteFontColor(r, 4, scGray); MyWorksheet.WriteFontColor(r, 4, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 2 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 2 decs');
MyWorksheet.WriteNumber(r, 1, number, nfExp, 2); MyWorksheet.WriteNumber(r, 1, number, nfExp, 2);
@ -231,13 +234,13 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 3 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfExp, 3 decs');
MyWorksheet.WriteNumber(r, 1, number, nfExp, 3); MyWorksheet.WriteNumber(r, 1, number, nfExp, 3);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number, nfExp, 3); MyWorksheet.WriteNumber(r, 2, -number, nfExp, 3);
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 3); MyWorksheet.WriteNumber(r, 3, 1.0/number, nfExp, 3);
MyWorksheet.WriteFontColor(r, 3, scGray); MyWorksheet.WriteFontColor(r, 3, NA_COLOR);
MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 3); MyWorksheet.WriteNumber(r, 4, -1.0/number, nfExp, 3);
MyWorksheet.WriteFontColor(r, 4, scGray); MyWorksheet.WriteFontColor(r, 4, NA_COLOR);
inc(r,2); inc(r,2);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrency, 0 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrency, 0 decs');
MyWorksheet.WriteCurrency(r, 1, number, nfCurrency, 0, '$'); MyWorksheet.WriteCurrency(r, 1, number, nfCurrency, 0, '$');
@ -251,45 +254,45 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0_);("$"#,##0)'); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0_);("$"#,##0)');
MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumber(r, 1, number);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0_);("$"#,##0)'); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0_);("$"#,##0)');
MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumber(r, 2, -number);
MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"$"#,##0_);("$"#,##0)'); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"$"#,##0_);("$"#,##0)');
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)'); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "$"#,##0.0_);[Red]("$"#,##0.0)');
MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumber(r, 1, number);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)'); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)');
MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumber(r, 2, -number);
MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)'); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '"$"#,##0.0_);[Red]("$"#,##0.0)');
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
fmt := '"€"#,##0.0_);[Red]("€"#,##0.0)'; fmt := '"€"#,##0.0_);[Red]("€"#,##0.0)';
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, '+fmt); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, '+fmt);
MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumber(r, 1, number);
MyWorksheet.WriteNumberFormat(r, 1, nfCustom, UTF8ToAnsi(fmt)); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, UTF8ToAnsi(fmt));
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumber(r, 2, -number);
MyWorksheet.WriteNumberFormat(r, 2, nfCustom, UTF8ToAnsi(fmt)); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, UTF8ToAnsi(fmt));
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
fmt := '[Green]"¥"#,##0.0_);[Red]-"¥"#,##0.0'; fmt := '[Green]"¥"#,##0.0_);[Red]-"¥"#,##0.0';
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, '+fmt); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, '+fmt);
MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumber(r, 1, number);
MyWorksheet.WriteNumberFormat(r, 1, nfCustom, UTF8ToAnsi(fmt)); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, UTF8ToAnsi(fmt));
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumber(r, 2, -number);
MyWorksheet.WriteNumberFormat(r, 2, nfCustom, UTF8ToAnsi(fmt)); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, UTF8ToAnsi(fmt));
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, _("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)'); MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, _("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)');
MyWorksheet.WriteNumber(r, 1, number); MyWorksheet.WriteNumber(r, 1, number);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '_("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)'); MyWorksheet.WriteNumberFormat(r, 1, nfCustom, '_("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)');
MyWorksheet.WriteNumber(r, 2, -number); MyWorksheet.WriteNumber(r, 2, -number);
MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '_("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)'); MyWorksheet.WriteNumberFormat(r, 2, nfCustom, '_("$"* #,##0_);_("$"* (#,##0);_("$"* "-"_);_(@_)');
MyWorksheet.WriteFontColor(r, 2, scGray); MyWorksheet.WriteFontColor(r, 2, NA_COLOR);
inc(r, 2); inc(r, 2);
number := 1.333333333; number := 1.333333333;
MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 0 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 0 decs');
@ -297,34 +300,34 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 1 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 1 decs');
MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 1); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 1);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 2 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 2 decs');
MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 2); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 2);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 3 decs'); MyWorksheet.WriteUTF8Text(r, 0, 'nfPercentage, 3 decs');
MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 3); MyWorksheet.WriteNumber(r, 1, number, nfPercentage, 3);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm:ss'); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm:ss');
MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval);
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m:s'); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m:s');
MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'H:M:s'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'H:M:s');
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm'); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, hh:mm');
MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'hh:mm'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'hh:mm');
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m'); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h:m');
MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:m'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h:m');
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h'); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h');
MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h');
MyWorksheet.WriteFontColor(r, 1, scGray); MyWorksheet.WriteFontColor(r, 1, NA_COLOR);
inc(r); inc(r);
// Set width of columns 0 to 3 // Set width of columns 0 to 3

View File

@ -336,6 +336,15 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h'); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, h');
MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, 'h');
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, ??/??');
MyWorksheet.WriteNumber(r, 1, number);
MyWorksheet.WriteFractionFormat(r, 1, false, 2, 2);
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, # ??/??');
MyWorksheet.WriteNumber(r, 1, number);
MyWorksheet.WriteFractionFormat(r, 1, true, 2, 2);
//MyFormula.FormulaStr := ''; //MyFormula.FormulaStr := '';

View File

@ -361,6 +361,12 @@ begin
inc(r); inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [ss]'); MyWorksheet.WriteUTF8Text(r, 0, 'nfTimeInterval, [ss]');
MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[ss]'); MyWorksheet.WriteDateTime(r, 1, number, nfTimeInterval, '[ss]');
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, ??/??');
Myworksheet.WriteNumber(r, 1, number, nfFraction, '??/??');
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfFraction, # ??/??');
Myworksheet.WriteNumber(r, 1, number, nfFraction, '# ??/??');
// Set width of columns 0, 1 and 5 // Set width of columns 0, 1 and 5
MyWorksheet.WriteColWidth(0, 30); MyWorksheet.WriteColWidth(0, 30);

View File

@ -105,6 +105,7 @@ begin
Myworksheet.Writenumber(5, 6, 12345.6789, nfExp, 4); Myworksheet.Writenumber(5, 6, 12345.6789, nfExp, 4);
MyWorksheet.WriteCurrency(6, 6,-12345.6789, nfCurrency, 2); MyWorksheet.WriteCurrency(6, 6,-12345.6789, nfCurrency, 2);
MyWorksheet.WriteCurrency(7, 6,-12345.6789, nfCurrencyRed, 2); MyWorksheet.WriteCurrency(7, 6,-12345.6789, nfCurrencyRed, 2);
MyWorksheet.WriteNumber(8, 6, 1.66666667, nfFraction, '# ?/?');
// Save the spreadsheet to a file // Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test.xlsx', sfOOXML); MyWorkbook.WriteToFile(MyDir + 'test.xlsx', sfOOXML);

View File

@ -203,6 +203,16 @@ begin
MyWorksheet.WriteCurrency(row, 6, number6, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); MyWorksheet.WriteCurrency(row, 6, number6, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB);
MyWorksheet.WriteCurrency(row, 7, number7, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); MyWorksheet.WriteCurrency(row, 7, number7, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB);
MyWorksheet.WriteCurrency(row, 8, number8, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB); MyWorksheet.WriteCurrency(row, 8, number8, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB);
inc(row);
MyWorksheet.WriteUTF8Text(row, 0, 'nfFraction, 2 digits');
MyWorksheet.WriteNumber(row, 1, number1, nfFraction, '# ???/???');
MyWorksheet.WriteNumber(row, 2, number2, nfFraction, '# ???/???');
MyWorksheet.WriteNumber(row, 3, number3, nfFraction, '# ???/???');
MyWorksheet.WriteNumber(row, 4, number4, nfFraction, '# ???/???');
MyWorksheet.WriteNumber(row, 5, number5, nfFraction, '# ???/???');
MyWorksheet.WriteNumber(row, 6, number6, nfFraction, '# ???/???');
MyWorksheet.WriteNumber(row, 7, number7, nfFraction, '# ???/???');
MyWorksheet.WriteNumber(row, 8, number8, nfFraction, '# ???/???');
inc(row,2); inc(row,2);
MyWorksheet.WriteUTF8Text(row, 0, 'Some date/time values in various formats:'); MyWorksheet.WriteUTF8Text(row, 0, 'Some date/time values in various formats:');

View File

@ -109,7 +109,6 @@
<ComponentName Value="HyperlinkForm"/> <ComponentName Value="HyperlinkForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="sHyperlinkForm"/>
</Unit6> </Unit6>
</Units> </Units>
</ProjectOptions> </ProjectOptions>

View File

@ -837,6 +837,7 @@ object MainForm: TMainForm
Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia' Dialog.Filter = 'Excel XML spreadsheet (*.xlsx)|*.xlsx|Excel 97-2003 spreadsheets (*.xls)|*.xls|Excel 5 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheets (*.xls)|*.xls|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited files (*.csv)|*.csv|WikiTable (WikiMedia-Format, *.wikitable_wikimedia)|*.wikitable_wikimedia'
Hint = 'Save spreadsheet' Hint = 'Save spreadsheet'
ImageIndex = 45 ImageIndex = 45
BeforeExecute = AcFileSaveAsBeforeExecute
OnAccept = AcFileSaveAsAccept OnAccept = AcFileSaveAsAccept
end end
object AcViewInspector: TAction object AcViewInspector: TAction

View File

@ -312,6 +312,7 @@ type
procedure AcColDeleteExecute(Sender: TObject); procedure AcColDeleteExecute(Sender: TObject);
procedure AcFileOpenAccept(Sender: TObject); procedure AcFileOpenAccept(Sender: TObject);
procedure AcFileSaveAsAccept(Sender: TObject); procedure AcFileSaveAsAccept(Sender: TObject);
procedure AcFileSaveAsBeforeExecute(Sender: TObject);
procedure AcRowAddExecute(Sender: TObject); procedure AcRowAddExecute(Sender: TObject);
procedure AcRowDeleteExecute(Sender: TObject); procedure AcRowDeleteExecute(Sender: TObject);
procedure AcSettingsCSVParamsExecute(Sender: TObject); procedure AcSettingsCSVParamsExecute(Sender: TObject);
@ -405,6 +406,14 @@ begin
end; end;
end; end;
procedure TMainForm.AcFileSaveAsBeforeExecute(Sender: TObject);
begin
if WorkbookSource.FileName = '' then
exit;
AcfileSaveAs.Dialog.InitialDir := ExtractFileDir(WorkbookSource.FileName);
AcFileSaveAs.Dialog.FileName := ExtractFileName(WorkbookSource.FileName);
end;
{ Adds a row before the active cell } { Adds a row before the active cell }
procedure TMainForm.AcRowAddExecute(Sender: TObject); procedure TMainForm.AcRowAddExecute(Sender: TObject);
begin begin

View File

@ -27,6 +27,13 @@
<OtherUnitFiles Value="../..;../shared"/> <OtherUnitFiles Value="../..;../shared"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions> </CompilerOptions>
</Item2> </Item2>
<Item3 Name="Release"> <Item3 Name="Release">

View File

@ -1003,7 +1003,8 @@ var
nfs: String; nfs: String;
begin begin
Worksheet.ReadNumFormat(ACell, nf, nfs); Worksheet.ReadNumFormat(ACell, nf, nfs);
Checked := (ACell <> nil) and (nf = FNumberFormat) and (nfs = FNumberFormatStr); Checked := (ACell <> nil) and (nf = FNumberFormat) and
((FNumberFormatStr = '') or (nfs = FNumberFormatStr));
end; end;
@ -1341,8 +1342,6 @@ var
txt: String; txt: String;
cellStr: String; cellStr: String;
hyperlink: TsHyperlink; hyperlink: TsHyperlink;
displayText: String;
cell: PCell;
begin begin
Unused(Target); Unused(Target);

View File

@ -290,7 +290,7 @@ begin
if FCurrentNode <> nil then if FCurrentNode <> nil then
begin begin
curr := PsRowCol(FCurrentNode.Data); curr := PsRowCol(FCurrentNode.Data);
if (curr^.Col < FStartCol) then if (LongInt(curr^.Col) < FStartCol) then
while (FCurrentNode <> nil) and not InRange(curr^.Col, FStartCol, FEndCol) do while (FCurrentNode <> nil) and not InRange(curr^.Col, FStartCol, FEndCol) do
begin begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode); FCurrentNode := FTree.FindSuccessor(FCurrentNode);

View File

@ -38,7 +38,7 @@ var
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure RegisterCurrency(ACurrencySymbol: String); procedure RegisterCurrency(ACurrencySymbol: String);
begin begin
if not CurrencyRegistered(ACurrencySymbol) then if not CurrencyRegistered(ACurrencySymbol) and (ACurrencySymbol <> '') then
CurrencyList.Add(ACurrencySymbol); CurrencyList.Add(ACurrencySymbol);
end; end;

View File

@ -11,132 +11,52 @@ uses
fpstypes, fpspreadsheet; fpstypes, fpspreadsheet;
type type
{@@ Contents of a number format record } { TsNumFormatList }
TsNumFormatData = class
public
{@@ Excel refers to a number format by means of the format "index". }
Index: Integer;
{@@ OpenDocument refers to a number format by means of the format "name". }
Name: String;
{@@ Identifier of a built-in number format, see TsNumberFormat }
NumFormat: TsNumberFormat;
{@@ String of format codes, such as '#,##0.00', or 'hh:nn'. }
FormatString: string;
end;
{@@ Specialized list for number format items } TsNumFormatList = class(TFPList)
TsCustomNumFormatList = class(TFPList)
private private
function GetItem(AIndex: Integer): TsNumFormatData; FOwnsData: Boolean;
procedure SetItem(AIndex: Integer; AValue: TsNumFormatData); function GetItem(AIndex: Integer): TsNumFormatParams;
procedure SetItem(AIndex: Integer; const AValue: TsNumFormatParams);
protected protected
{@@ Workbook from which the number formats are collected in the list. It is
mainly needed to get access to the FormatSettings for easy localization of some
formatting strings. }
FWorkbook: TsWorkbook; FWorkbook: TsWorkbook;
{@@ Identifies the first number format item that is written to the file. Items FClass: TsNumFormatParamsClass;
having a smaller index are not written. }
FFirstNumFormatIndexInFile: Integer;
{@@ Identifies the index of the next Excel number format item to be written.
Needed for auto-creating of the user-defined Excel number format indexes }
FNextNumFormatIndex: Integer;
procedure AddBuiltinFormats; virtual; procedure AddBuiltinFormats; virtual;
procedure RemoveFormat(AIndex: Integer);
public public
constructor Create(AWorkbook: TsWorkbook); constructor Create(AWorkbook: TsWorkbook; AOwnsData: Boolean);
destructor Destroy; override; destructor Destroy; override;
function AddFormat(AFormatIndex: Integer; AFormatName: String; function AddFormat(ASections: TsNumFormatSections): Integer; overload;
ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; function AddFormat(AFormatStr: String; ADialect: TsNumFormatDialect): Integer; overload;
function AddFormat(AFormatIndex: Integer; ANumFormat: TsNumberFormat;
AFormatString: String): Integer; overload;
function AddFormat(AFormatName: String; ANumFormat: TsNumberFormat;
AFormatString: String): Integer; overload;
function AddFormat(ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload;
procedure AnalyzeAndAdd(AFormatIndex: Integer; AFormatString: String);
procedure Clear; procedure Clear;
procedure ConvertAfterReading(AFormatIndex: Integer; var AFormatString: String;
var ANumFormat: TsNumberFormat); virtual;
procedure ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat); virtual;
procedure Delete(AIndex: Integer); procedure Delete(AIndex: Integer);
function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; virtual; function Find(ASections: TsNumFormatSections): Integer;
function FindByFormatStr(AFormatString: String): Integer; property Items[AIndex: Integer]: TsNumFormatParams read GetItem write SetItem; default;
function FindByIndex(AFormatIndex: Integer): Integer;
function FindByName(AFormatName: String): Integer;
function FormatStringForWriting(AIndex: Integer): String; virtual;
procedure Sort;
{@@ Workbook from which the number formats are collected in the list. It is {@@ Workbook from which the number formats are collected in the list. It is
mainly needed to get access to the FormatSettings for easy localization of some mainly needed to get access to the FormatSettings for easy localization of
formatting strings. } some formatting strings. }
property Workbook: TsWorkbook read FWorkbook; property Workbook: TsWorkbook read FWorkbook;
{@@ Identifies the first number format item that is written to the file. Items
having a smaller index are not written. }
property FirstNumFormatIndexInFile: Integer read FFirstNumFormatIndexInFile;
{@@ Number format items contained in the list }
property Items[AIndex: Integer]: TsNumFormatData read GetItem write SetItem; default;
end; end;
function FormatAsFraction(ANumFormatStr: String; AValue: Double): String;
function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; function IsCurrencyFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsCurrencyFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload; function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsDateTimeFormat(AFormatStr: String): Boolean; overload; function IsDateTimeFormat(AFormatStr: String): Boolean; overload;
function IsDateTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload; function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsTimeFormat(AFormatStr: String): Boolean; overload; function IsTimeFormat(AFormatStr: String): Boolean; overload;
function IsTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean;
implementation implementation
uses uses
Math,
fpsUtils, fpsNumFormatParser; fpsUtils, fpsNumFormatParser;
{@@ ----------------------------------------------------------------------------
Formats a floating point value as a fraction according to the specified
formatting string.
@param ANumFormatStr String with formatting codes
-------------------------------------------------------------------------------}
function FormatAsFraction(ANumFormatStr: String; AValue: Double): String;
var
parser: TsNumFormatParser;
int,num,denom: Integer;
maxNum, maxDenom: Integer;
isNeg: Boolean;
begin
if AValue < 0 then begin
isNeg := true;
AValue := abs(AValue);
end else
isNeg := false;
parser := TsNumFormatParser.Create(nil, ANumFormatStr);
try
if parser.NumFormat <> nfFraction then
raise Exception.Create('[FormatAsFraction] No formatting string for fractions.');
if parser.FracInt = 0 then
int := 0
else
begin
int := trunc(AValue);
AValue := frac(AValue);
end;
maxNum := Round(IntPower(10, parser.FracNumerator));
maxDenom := Round(IntPower(10, parser.FracDenominator));
FloatToFraction(AValue, maxNum, maxDenom, num, denom);
if int = 0 then
Result := Format('%d/%d', [num, denom])
else
Result := Format('%d %d/%d', [int, num, denom]);
if isNeg then Result := '-' + Result;
finally
parser.Free;
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Checks whether the given number format code is for currency, Checks whether the given number format code is for currency,
i.e. requires currency symbol. i.e. requires currency symbol.
@ -149,6 +69,19 @@ begin
Result := AFormat in [nfCurrency, nfCurrencyRed]; Result := AFormat in [nfCurrency, nfCurrencyRed];
end; end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to currency values.
@param ANumFormat Number format parameters
@return True if Kind of the 1st format parameter section contains the
nfkCurrency elements; false otherwise
-------------------------------------------------------------------------------}
function IsCurrencyFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkCurrency] <> []);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Checks whether the given number format code is for date/time values. Checks whether the given number format code is for date/time values.
@ -158,8 +91,9 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
begin begin
Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate, Result := AFormat in [nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval]; nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM,
nfDayMonth, nfMonthYear, nfTimeInterval];
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -181,6 +115,19 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to date/time values.
@param ANumFormat Number format parameters
@return True if Kind of the 1st format parameter section contains the
nfkDate or nfkTime elements; false otherwise
-------------------------------------------------------------------------------}
function IsDateTimeFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkDate, nfkTime] <> []);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Checks whether the given built-in number format code is for time values. Checks whether the given built-in number format code is for time values.
@ -211,398 +158,128 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to time values.
{******************************************************************************* @param ANumFormat Number format parameters
* TsCustomNumFormatList * @return True if Kind of the 1st format parameter section contains the
*******************************************************************************} nfkTime elements; false otherwise
-------------------------------------------------------------------------------}
function IsTimeFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkTime] <> []);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Constructor of the number format list. Checks whether the specified number format parameters is a time interval
format.
@param AWorkbook The workbook is needed to get access to its "FormatSettings" @param ANumFormat Number format parameters
for localization of some formatting strings. @return True if Kind of the 1st format parameter section contains the
nfkTimeInterval elements; false otherwise
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
constructor TsCustomNumFormatList.Create(AWorkbook: TsWorkbook); function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean;
begin
Result := (ANumFormat <> nil) and
(ANumFormat.Sections[0].Kind * [nfkTimeInterval] <> []);
end;
{ TsNumFormatList }
constructor TsNumFormatList.Create(AWorkbook: TsWorkbook; AOwnsData: Boolean);
begin begin
inherited Create; inherited Create;
FClass := TsNumFormatParams;
FWorkbook := AWorkbook; FWorkbook := AWorkbook;
AddBuiltinFormats; FOwnsData := AOwnsData;
end; end;
{@@ ---------------------------------------------------------------------------- destructor TsNumFormatList.Destroy;
Destructor of the number format list: clears the list and destroys the
format items
-------------------------------------------------------------------------------}
destructor TsCustomNumFormatList.Destroy;
begin begin
Clear; Clear;
inherited Destroy; inherited;
end; end;
{@@ ---------------------------------------------------------------------------- function TsNumFormatList.AddFormat(ASections: TsNumFormatSections): Integer;
Adds a number format described by the Excel format index, the ODF format
name, the format string, and the built-in format identifier to the list
and returns the index of the new item.
@param AFormatIndex Format index to be used by Excel
@param AFormatName Format name to be used by OpenDocument
@param AFormatString String of formatting codes
@param ANumFormat Identifier for built-in number format
@return List index of the new item
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer;
AFormatName: String; ANumFormat: TsNumberFormat; AFormatString: String): Integer;
var var
item: TsNumFormatData; item: TsNumFormatParams;
begin begin
item := TsNumFormatData.Create; Result := Find(ASections);
item.Index := AFormatIndex; if Result = -1 then begin
item.Name := AFormatName; item := FClass.Create;
item.NumFormat := ANumFormat; item.Sections := ASections;
item.FormatString := AFormatString;
Result := inherited Add(item); Result := inherited Add(item);
end; end;
{@@ ----------------------------------------------------------------------------
Adds a number format described by the Excel format index, the format string,
and the built-in format identifier to the list and returns the index of
the new item in the format list. To be used when writing an Excel file.
@param AFormatIndex Format index to be used by Excel
@param ANumFormat Identifier for built-in number format
@param AFormatString String of formatting codes
@return Index of the new item in the format list
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.AddFormat(AFormatIndex: Integer;
ANumFormat: TsNumberFormat; AFormatString: String): integer;
begin
Result := AddFormat(AFormatIndex, '', ANumFormat, AFormatString);
end; end;
{@@ ---------------------------------------------------------------------------- function TsNumFormatList.AddFormat(AFormatStr: String;
Adds a number format described by the ODF format name, the format string, ADialect: TsNumFormatDialect): Integer;
and the built-in format identifier to the list and returns the index of
the new item in the format list. To be used when writing an ODS file.
@param AFormatName Format name to be used by OpenDocument
@param AFormatString String of formatting codes
@param ANumFormat Identifier for built-in number format
@return Index of the new item in the format list
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.AddFormat(AFormatName: String;
ANumFormat: TsNumberFormat; AFormatString: String): Integer;
begin
if (AFormatString = '') and (ANumFormat <> nfGeneral) then
begin
Result := 0;
exit;
end;
Result := AddFormat(FNextNumFormatIndex, AFormatName, ANumFormat, AFormatString);
inc(FNextNumFormatIndex);
end;
{@@ ----------------------------------------------------------------------------
Adds a number format described by the format string, and the built-in
format identifier to the format list and returns the index of the new
item in the list. The Excel format index and ODS format name are auto-generated.
@param ANumFormat Identifier for built-in number format
@param AFormatString String of formatting codes
@return Index of the new item in the list
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.AddFormat(ANumFormat: TsNumberFormat;
AFormatString: String): Integer;
begin
Result := AddFormat('', ANumFormat, AFormatString);
end;
{@@ ----------------------------------------------------------------------------
Adds the builtin format items to the list. The formats must be specified in
a way that is compatible with fpc syntax.
Conversion of the formatstrings to the syntax used in the destination file
can be done by calling "ConvertAfterReadung" bzw. "ConvertBeforeWriting".
"AddBuiltInFormats" must be called before user items are added.
Must specify FFirstNumFormatIndexInFile (BIFF5-8, e.g. don't save formats <164)
and must initialize the index of the first user format (FNextNumFormatIndex)
which is automatically incremented when adding user formats.
In TsCustomNumFormatList nothing is added.
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.AddBuiltinFormats;
begin
// must be overridden - see xlscommon as an example.
end;
{@@ ----------------------------------------------------------------------------
Called from the reader when a format item has been read from an Excel file.
Determines the number format type, format string etc and converts the
format string to fpc syntax which is used directly for getting the cell text.
@param AFormatIndex Excel index of the number format read from the file
@param AFormatString String of formatting codes as read fromt the file.
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.AnalyzeAndAdd(AFormatIndex: Integer;
AFormatString: String);
var
nf: TsNumberFormat = nfGeneral;
begin
if FindByIndex(AFormatIndex) > -1 then
exit;
// Analyze & convert the format string, extract infos for internal formatting
ConvertAfterReading(AFormatIndex, AFormatString, nf);
// Add the new item
AddFormat(AFormatIndex, nf, AFormatString);
end;
{@@ ----------------------------------------------------------------------------
Clears the number format list and frees memory occupied by the format items.
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.Clear;
var
i: Integer;
begin
for i:=0 to Count-1 do RemoveFormat(i);
inherited Clear;
end;
{@@ ----------------------------------------------------------------------------
Takes the format string as it is read from the file and extracts the
built-in number format identifier out of it for use by fpc.
The method also converts the format string to a form that can be used
by fpc's FormatDateTime and FormatFloat.
The method should be overridden in a class that knows knows more about the
details of the spreadsheet file format.
@param AFormatIndex Excel index of the number format read
@param AFormatString string of formatting codes extracted from the file data
@param ANumFormat identifier for built-in fpspreadsheet format extracted
from the file data
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.ConvertAfterReading(AFormatIndex: Integer;
var AFormatString: String; var ANumFormat: TsNumberFormat);
var var
parser: TsNumFormatParser; parser: TsNumFormatParser;
fmt: String; newSections: TsNumFormatSections;
lFormatData: TsNumFormatData;
i: Integer; i: Integer;
begin begin
i := FindByIndex(AFormatIndex); parser := TsNumFormatParser.Create(FWorkbook, AFormatStr, ADialect);
if i > 0 then
begin
lFormatData := Items[i];
fmt := lFormatData.FormatString;
end else
fmt := AFormatString;
// Analyzes the format string and tries to convert it to fpSpreadsheet format.
parser := TsNumFormatParser.Create(Workbook, fmt);
try try
if parser.Status = psOK then SetLength(newSections, parser.ParsedSectionCount);
for i:=0 to High(newSections) do
begin begin
ANumFormat := parser.NumFormat; newSections[i] := parser.ParsedSections[i];
AFormatString := parser.FormatString[nfdDefault];
end else
begin
// Show an error here?
end; end;
Result := AddFormat(newSections);
finally finally
parser.Free; parser.Free;
end; end;
end; end;
{@@ ---------------------------------------------------------------------------- procedure TsNumFormatList.AddBuiltinFormats;
Is called before collecting all number formats of the spreadsheet and before
writing them to file. Its purpose is to convert the format string as used by fpc
to a format compatible with the spreadsheet file format.
Nothing is changed in the TsCustomNumFormatList, the method needs to be
overridden by a descendant class which known more about the details of the
destination file format.
Needs to be overridden by a class knowing more about the destination file
format.
@param AFormatString String of formatting codes. On input in fpc syntax. Is
overwritten on output by format string compatible with
the destination file.
@param ANumFormat Identifier for built-in fpspreadsheet number format
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat);
begin begin
Unused(AFormatString, ANumFormat);
// nothing to do here. But see, e.g., xlscommon.TsBIFFNumFormatList
end; end;
procedure TsNumFormatList.Clear;
{@@ ----------------------------------------------------------------------------
Deletes a format item from the list, and makes sure that its memory is
released.
@param AIndex List index of the item to be deleted.
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.Delete(AIndex: Integer);
begin
RemoveFormat(AIndex);
Delete(AIndex);
end;
{@@ ----------------------------------------------------------------------------
Seeks a format item with the given properties and returns its list index,
or -1 if not found.
@param ANumFormat Built-in format identifier
@param AFormatString String of formatting codes
@return Index of the format item in the format list,
or -1 if not found.
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.Find(ANumFormat: TsNumberFormat;
AFormatString: String): Integer;
var var
item: TsNumFormatData; i: Integer;
begin begin
for Result := Count-1 downto 0 do for i := Count-1 downto 0 do Delete(i);
begin inherited;
item := Items[Result];
if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString)
then exit;
end;
Result := -1;
end; end;
{@@ ---------------------------------------------------------------------------- procedure TsNumFormatList.Delete(AIndex: Integer);
Finds the item with the given format string and returns its index in the
format list, or -1 if not found.
@param AFormatString string of formatting codes to be searched in the list.
@return Index of the format item in the format list, or -1 if not found.
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.FindByFormatStr(AFormatString: String): integer;
var var
item: TsNumFormatData; p: TsNumFormatParams;
begin begin
{ We search backwards to find user-defined items first. They usually are if FOwnsData then
more appropriate than built-in items. }
for Result := Count-1 downto 0 do
begin begin
item := Items[Result]; p := GetItem(AIndex);
if item.FormatString = AFormatString then if p <> nil then p.Free;
end;
inherited Delete(AIndex);
end;
function TsNumFormatList.Find(ASections: TsNumFormatSections): Integer;
var
item: TsNumFormatParams;
begin
for Result := 0 to Count-1 do begin
item := GetItem(Result);
if item.SectionsEqualTo(ASections) then
exit; exit;
end; end;
Result := -1; Result := -1;
end; end;
{@@ ---------------------------------------------------------------------------- function TsNumFormatList.GetItem(AIndex: Integer): TsNumFormatParams;
Finds the item with the given Excel format index and returns its index in
the format list, or -1 if not found.
Is used by BIFF file formats.
@param AFormatIndex Excel format index to the searched
@return Index of the format item in the format list, or -1 if not found.
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.FindByIndex(AFormatIndex: Integer): integer;
var
item: TsNumFormatData;
begin begin
for Result := 0 to Count-1 do Result := TsNumFormatParams(inherited Items[AIndex]);
begin
item := Items[Result];
if item.Index = AFormatIndex then
exit;
end;
Result := -1;
end; end;
{@@ ---------------------------------------------------------------------------- procedure TsNumFormatList.SetItem(AIndex: Integer;
Finds the item with the given ODS format name and returns its index in const AValue: TsNumFormatParams);
the format list (or -1, if not found)
To be used by OpenDocument file format.
@param AFormatName Format name as used by OpenDocument to identify a
number format
@return Index of the format item in the list, or -1 if not found
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.FindByName(AFormatName: String): integer;
var
item: TsNumFormatData;
begin
for Result := 0 to Count-1 do
begin
item := Items[Result];
if item.Name = AFormatName then
exit;
end;
Result := -1;
end;
{@@ ----------------------------------------------------------------------------
Determines the format string to be written into the spreadsheet file. Calls
ConvertBeforeWriting in order to convert the fpc format strings to the dialect
used in the file.
@param AIndex Index of the format item under consideration.
@return String of formatting codes that will be written to the file.
-------------------------------------------------------------------------------}
function TsCustomNumFormatList.FormatStringForWriting(AIndex: Integer): String;
var
item: TsNumFormatdata;
nf: TsNumberFormat;
begin
item := Items[AIndex];
if item <> nil then
begin
Result := item.FormatString;
nf := item.NumFormat;
ConvertBeforeWriting(Result, nf);
end else
Result := '';
end;
function TsCustomNumFormatList.GetItem(AIndex: Integer): TsNumFormatData;
begin
Result := TsNumFormatData(inherited Items[AIndex]);
end;
{@@ ----------------------------------------------------------------------------
Deletes the memory occupied by the formatting data, but keeps an empty item in
the list to retain the indexes of following items.
@param AIndex The number format item at this index will be removed.
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.RemoveFormat(AIndex: Integer);
var
item: TsNumFormatData;
begin
item := GetItem(AIndex);
if item <> nil then
begin
item.Free;
SetItem(AIndex, nil);
end;
end;
procedure TsCustomNumFormatList.SetItem(AIndex: Integer; AValue: TsNumFormatData);
begin begin
inherited Items[AIndex] := AValue; inherited Items[AIndex] := AValue;
end; end;
function CompareNumFormatData(Item1, Item2: Pointer): Integer;
begin
Result := CompareValue(TsNumFormatData(Item1).Index, TsNumFormatData(Item2).Index);
end;
{@@ ----------------------------------------------------------------------------
Sorts the format data items in ascending order of the Excel format indexes.
-------------------------------------------------------------------------------}
procedure TsCustomNumFormatList.Sort;
begin
inherited Sort(@CompareNumFormatData);
end;
end. end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -98,9 +98,6 @@ type
FLeftPaneWidth: Integer; FLeftPaneWidth: Integer;
FTopPaneHeight: Integer; FTopPaneHeight: Integer;
FOptions: TsSheetOptions; FOptions: TsSheetOptions;
// FLastFoundCell: PCell;
// FLastFoundRow: Cardinal;
// FLastFoundCol: Cardinal;
FFirstRowIndex: Cardinal; FFirstRowIndex: Cardinal;
FFirstColIndex: Cardinal; FFirstColIndex: Cardinal;
FLastRowIndex: Cardinal; FLastRowIndex: Cardinal;
@ -204,10 +201,12 @@ type
procedure WriteCurrency(ACell: PCell; AValue: Double; procedure WriteCurrency(ACell: PCell; AValue: Double;
ANumFormat: TsNumberFormat; ANumFormatString: String); overload; ANumFormat: TsNumberFormat; ANumFormatString: String); overload;
function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime): PCell; overload;
procedure WriteDateTime(ACell: PCell; AValue: TDateTime); overload;
function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''): PCell; overload; ANumFormat: TsNumberFormat; ANumFormatStr: String = ''): PCell; overload;
procedure WriteDateTime(ACell: PCell; AValue: TDateTime; procedure WriteDateTime(ACell: PCell; AValue: TDateTime;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''); overload; ANumFormat: TsNumberFormat; ANumFormatStr: String = ''); overload;
function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
ANumFormatStr: String): PCell; overload; ANumFormatStr: String): PCell; overload;
procedure WriteDateTime(ACell: PCell; AValue: TDateTime; procedure WriteDateTime(ACell: PCell; AValue: TDateTime;
@ -358,11 +357,8 @@ type
function FindCell(AddressStr: String): PCell; overload; function FindCell(AddressStr: String): PCell; overload;
function GetCell(ARow, ACol: Cardinal): PCell; overload; function GetCell(ARow, ACol: Cardinal): PCell; overload;
function GetCell(AddressStr: String): PCell; overload; function GetCell(AddressStr: String): PCell; overload;
function GetCellCount: Cardinal; function GetCellCount: Cardinal;
// function GetFirstCellOfRow(ARow: Cardinal): PCell;
// function GetLastCellOfRow(ARow: Cardinal): PCell;
function GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal; function GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastColIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastColIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex'; function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex';
@ -439,7 +435,7 @@ type
procedure UnmergeCells(ARow, ACol: Cardinal); overload; procedure UnmergeCells(ARow, ACol: Cardinal); overload;
procedure UnmergeCells(ARange: String); overload; procedure UnmergeCells(ARange: String); overload;
// Notification of changed cells content and format // Notification of changed cells
procedure ChangedCell(ARow, ACol: Cardinal); procedure ChangedCell(ARow, ACol: Cardinal);
procedure ChangedFont(ARow, ACol: Cardinal); procedure ChangedFont(ARow, ACol: Cardinal);
@ -580,8 +576,9 @@ type
procedure RemoveWorksheetsCallback(data, arg: pointer); procedure RemoveWorksheetsCallback(data, arg: pointer);
protected protected
FCellFormatList: TsCellFormatList;
FFontList: TFPList; FFontList: TFPList;
FNumFormatList: TFPList;
FCellFormatList: TsCellFormatList;
{ Internal methods } { Internal methods }
procedure GetLastRowColIndex(out ALastRow, ALastCol: Cardinal); procedure GetLastRowColIndex(out ALastRow, ALastCol: Cardinal);
@ -664,6 +661,11 @@ type
ASize: Single; AStyle: TsFontStyles; AColor: TsColor); ASize: Single; AStyle: TsFontStyles; AColor: TsColor);
procedure SetDefaultFont(const AFontName: String; ASize: Single); procedure SetDefaultFont(const AFontName: String; ASize: Single);
{ Number format handling }
function AddNumberFormat(AFormatStr: String): Integer;
function GetNumberFormat(AIndex: Integer): TsNumFormatParams;
function GetNumberFormatCount: Integer;
{ Color handling } { Color handling }
function AddColorToPalette(AColorValue: TsColorValue): TsColor; function AddColorToPalette(AColorValue: TsColorValue): TsColor;
function FindClosestColor(AColorValue: TsColorValue; function FindClosestColor(AColorValue: TsColorValue;
@ -690,12 +692,6 @@ type
{@@ Identifies the "active" worksheet (only for visual controls)} {@@ Identifies the "active" worksheet (only for visual controls)}
property ActiveWorksheet: TsWorksheet read FActiveWorksheet; property ActiveWorksheet: TsWorksheet read FActiveWorksheet;
(*
{@@ This property is only used for formats which don't support unicode
and support a single encoding for the whole document, like Excel 2 to 5 }
property CodePage: String read FCodePage write FCodepage;
*)
// property Encoding: TsEncoding read FEncoding write FEncoding;
{@@ Retrieves error messages collected during reading/writing } {@@ Retrieves error messages collected during reading/writing }
property ErrorMsg: String read GetErrorMsg; property ErrorMsg: String read GetErrorMsg;
{@@ Filename of the saved workbook } {@@ Filename of the saved workbook }
@ -1112,10 +1108,6 @@ begin
FActiveCellRow := Cardinal(-1); FActiveCellRow := Cardinal(-1);
FActiveCellCol := Cardinal(-1); FActiveCellCol := Cardinal(-1);
{ FLastFoundCell := nil;
FLastFoundRow := Cardinal(-1);
FLastFoundCol := Cardinal(-1);}
FOptions := [soShowGridLines, soShowHeaders]; FOptions := [soShowGridLines, soShowHeaders];
end; end;
@ -2090,17 +2082,6 @@ end;
function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell; function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell;
begin begin
Result := PCell(FCells.FindByRowCol(ARow, ACol)); Result := PCell(FCells.FindByRowCol(ARow, ACol));
{
if (ARow = FLastFoundRow) and (ACol = FLastFoundCol) then
Result := FLastFoundCell
else
begin
Result := PCell(FCells.Find(ARow, ACol));
FLastFoundCell := Result;
FLastFoundRow := ARow;
FLastFoundCol := ACol;
end;
}
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -2361,29 +2342,7 @@ begin
for cell in FCells do for cell in FCells do
Result := Math.Max(Result, cell^.Col); Result := Math.Max(Result, cell^.Col);
end; end;
(*
{@@ ----------------------------------------------------------------------------
Finds the first cell with contents in a given row
@param ARow Index of the row considered
@return Pointer to the first cell in this row, or nil if the row is empty.
-------------------------------------------------------------------------------}
function TsWorksheet.GetFirstCellOfRow(ARow: Cardinal): PCell;
begin
Result := FCells.GetFirstCellOfRow(ARow);
end;
{@@ ----------------------------------------------------------------------------
Finds the last cell with data or formatting in a given row
@param ARow Index of the row considered
@return Pointer to the last cell in this row, or nil if the row is empty.
-------------------------------------------------------------------------------}
function TsWorksheet.GetLastCellOfRow(ARow: Cardinal): PCell;
begin
Result := FCells.GetLastCellOfRow(ARow);
end;
*)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Returns the 0-based index of the first row with a cell with data or formatting. Returns the 0-based index of the first row with a cell with data or formatting.
If no cells have contents, -1 will be returned. If no cells have contents, -1 will be returned.
@ -2513,70 +2472,25 @@ begin
Result := ReadAsUTF8Text(ACell, FWorkbook.FormatSettings); Result := ReadAsUTF8Text(ACell, FWorkbook.FormatSettings);
end; end;
{@@ ----------------------------------------------------------------------------
Reads the contents of a cell and returns an user readable text
representing the contents of the cell.
The resulting string is UTF-8 encoded.
@param ACell Pointer to the cell
@param AFormatSettings Format settings to be used for string conversion
of numbers and date/times.
@return The text representation of the cell
-------------------------------------------------------------------------------}
function TsWorksheet.ReadAsUTF8Text(ACell: PCell; function TsWorksheet.ReadAsUTF8Text(ACell: PCell;
AFormatSettings: TFormatSettings): string; //ansistring; AFormatSettings: TFormatSettings): string;
function FloatToStrNoNaN(const AValue: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: string): string; //ansistring;
var
i: Integer;
begin
if IsNan(AValue) then
Result := ''
else
if (ANumberFormat = nfGeneral) or (ANumberFormatStr = '') then
Result := FloatToStr(AValue, AFormatSettings)
else
if (ANumberFormat = nfPercentage) then
Result := FormatFloat(ANumberFormatStr, AValue*100, AFormatSettings)
else
if (ANumberFormat = nfFraction) then
Result := FormatAsFraction(ANumberFormatStr, AValue)
else
if IsCurrencyFormat(ANumberFormat) then
Result := FormatCurr(ANumberFormatStr, AValue, AFormatSettings)
else
Result := FormatFloat(ANumberFormatStr, AValue, AFormatSettings)
end;
function DateTimeToStrNoNaN(const Value: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: String): string; //ansistring;
var
fmtp, fmtn, fmt0: String;
begin
Result := '';
if not IsNaN(Value) then
begin
if (ANumberFormat = nfGeneral) then
begin
if frac(Value) = 0 then // date only
ANumberFormatStr := AFormatSettings.ShortDateFormat
else if trunc(Value) = 0 then // time only
ANumberFormatStr := AFormatSettings.LongTimeFormat
else
ANumberFormatStr := 'cc'
end else
if ANumberFormatStr = '' then
ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat,
AFormatSettings, ANumberFormatStr);
// Saw strange cases in ods where date/time formats contained pos/neg/zero parts.
// Split to be on the safe side.
SplitFormatString(ANumberFormatStr, fmtp, fmtn, fmt0);
if (Value > 0) or ((Value = 0) and (fmt0 = '')) or ((Value < 0) and (fmtn = '')) then
Result := FormatDateTime(fmtp, Value, [fdoInterval])
else
if (Value < 0) then
Result := FormatDateTime(fmtn, Value, [fdoInterval])
else
if (Value = 0) then
Result := FormatDateTime(fmt0, Value, [fdoInterval]);
end;
end;
var var
fmt: PsCellFormat; fmt: PsCellFormat;
hyperlink: PsHyperlink; hyperlink: PsHyperlink;
numFmt: TsNumFormatParams;
nf: TsNumberFormat;
nfs: String;
begin begin
Result := ''; Result := '';
@ -2584,16 +2498,36 @@ begin
Exit; Exit;
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
with ACell^ do with ACell^ do
case ContentType of case ContentType of
cctNumber:
Result := FloatToStrNoNaN(NumberValue, fmt^.NumberFormat, fmt^.NumberFormatStr);
cctUTF8String: cctUTF8String:
Result := UTF8StringValue; Result := UTF8StringValue;
cctNumber:
Result := ConvertFloatToStr(NumberValue, numFmt, AFormatSettings);
cctDateTime: cctDateTime:
Result := DateTimeToStrNoNaN(DateTimeValue, fmt^.NumberFormat, fmt^.NumberFormatStr); if Assigned(numFmt) then
Result := ConvertFloatToStr(DateTimeValue, numFmt, AFormatSettings)
else
if not IsNaN(DateTimeValue) then
begin
if frac(DateTimeValue) = 0 then // date only
nf := nfShortDate
else
if trunc(DateTimeValue) = 0 then // time only
nf := nfLongTime
else
nf := nfShortDateTime;
nfs := BuildDateTimeFormatString(nf, AFormatSettings);
Result := FormatDateTime(nfs, DateTimeValue, AFormatSettings);
end;
cctBool: cctBool:
Result := StrUtils.IfThen(BoolValue, rsTRUE, rsFALSE); Result := StrUtils.IfThen(BoolValue, rsTRUE, rsFALSE);
cctError: cctError:
case TsErrorValue(ErrorValue) of case TsErrorValue(ErrorValue) of
errEmptyIntersection : Result := rsErrEmptyIntersection; errEmptyIntersection : Result := rsErrEmptyIntersection;
@ -2605,7 +2539,8 @@ begin
errArgError : Result := rsErrArgError; errArgError : Result := rsErrArgError;
errFormulaNotSupported: Result := rsErrFormulaNotSupported; errFormulaNotSupported: Result := rsErrFormulaNotSupported;
end; end;
else
else // blank --> display hyperlink target if available
Result := ''; Result := '';
if HasHyperlink(ACell) then if HasHyperlink(ACell) then
begin begin
@ -2773,20 +2708,6 @@ begin
end else end else
Result := False; Result := False;
end; end;
(*
{@@ ----------------------------------------------------------------------------
Returns the comment assigned to a cell
@param ACell Pointer to the cell considered
@return String attached to the cell as a comment
-------------------------------------------------------------------------------}
function TsWorksheet.ReadComment(ACell: PCell): String;
begin
if ACell <> nil then
Result := ACell^.Comment
else
Result := '';
end; *)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Converts an RPN formula (as read from an xls biff file, for example) to a Converts an RPN formula (as read from an xls biff file, for example) to a
@ -2992,11 +2913,6 @@ begin
if ACell <> nil then if ACell <> nil then
begin begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
{
if (uffBold in fmt^.UsedFormattingFields) then
Result := Workbook.GetFont(BOLD_FONTINDEX)
else
}
Result := Workbook.GetFont(fmt^.FontIndex); Result := Workbook.GetFont(fmt^.FontIndex);
end; end;
if Result = nil then if Result = nil then
@ -3034,6 +2950,7 @@ procedure TsWorksheet.ReadNumFormat(ACell: PCell; out ANumFormat: TsNumberFormat
out ANumFormatStr: String); out ANumFormatStr: String);
var var
fmt: PsCellFormat; fmt: PsCellFormat;
numFmt: TsNumFormatParams;
begin begin
ANumFormat := nfGeneral; ANumFormat := nfGeneral;
ANumFormatStr := ''; ANumFormatStr := '';
@ -3042,8 +2959,16 @@ begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
if (uffNumberFormat in fmt^.UsedFormattingFields) then if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin begin
ANumFormat := fmt^.NumberFormat; numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
ANumFormatStr := fmt^.NumberFormatStr; if numFmt <> nil then
begin
ANumFormat := numFmt.NumFormat;
ANumFormatStr := numFmt.NumFormatStr[nfdDefault];
end else
begin
ANumFormat := nfGeneral;
ANumFormatStr := '';
end;
end; end;
end; end;
end; end;
@ -3294,7 +3219,6 @@ begin
Result := (ACell <> nil) and (cfMerged in ACell^.Flags); Result := (ACell <> nil) and (cfMerged in ACell^.Flags);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Removes the comment from a cell and releases the memory occupied by the node. Removes the comment from a cell and releases the memory occupied by the node.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
@ -3595,22 +3519,12 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
function ContainsMergedCells: boolean; function ContainsMergedCells: boolean;
var var
//r,c: Cardinal;
cell: PCell; cell: PCell;
begin begin
result := false; result := false;
for cell in Cells.GetRangeEnumerator(ARowFrom, AColFrom, ARowTo, AColTo) do for cell in Cells.GetRangeEnumerator(ARowFrom, AColFrom, ARowTo, AColTo) do
if IsMerged(cell) then if IsMerged(cell) then
exit(true); exit(true);
{
for r := ARowFrom to ARowTo do
for c := AColFrom to AColTo do
begin
cell := FindCell(r, c);
if IsMerged(cell) then
exit(true);
end;
}
end; end;
begin begin
@ -3781,7 +3695,7 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes a floating-point number to a cell. Does not change number format. Writes a floating-point number to a cell, does not change the number format
@param ARow Cell row index @param ARow Cell row index
@param ACol Cell column index @param ACol Cell column index
@ -3795,13 +3709,12 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes a floating-point number to a cell. Does not change number format. Writes a floating-point number to a cell, does not change the number format
@param ARow Cell row index @param ACell Pointer to the cell
@param ACol Cell column index
@param ANumber Number to be written @param ANumber Number to be written
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: double); procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double);
begin begin
if ACell <> nil then begin if ACell <> nil then begin
ACell^.ContentType := cctNumber; ACell^.ContentType := cctNumber;
@ -3822,7 +3735,7 @@ end;
@see TsNumberFormat @see TsNumberFormat
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double; function TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double;
ANumFormat: TsNumberFormat; ADecimals: Byte = 2): PCell; ANumFormat: TsNumberFormat = nfGeneral; ADecimals: Byte = 2): PCell;
begin begin
Result := GetCell(ARow, ACol); Result := GetCell(ARow, ACol);
WriteNumber(Result, ANumber, ANumFormat, ADecimals); WriteNumber(Result, ANumber, ANumFormat, ADecimals);
@ -3835,12 +3748,15 @@ end;
@param ANumber Number to be written @param ANumber Number to be written
@param ANumFormat Identifier for a built-in number format, e.g. nfFixed @param ANumFormat Identifier for a built-in number format, e.g. nfFixed
@param ADecimals Optional number of decimal places used for formatting @param ADecimals Optional number of decimal places used for formatting
If ANumFormat is nfFraction the ADecimals defines the
digits of Numerator and denominator.
@see TsNumberFormat @see TsNumberFormat
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double; procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double;
ANumFormat: TsNumberFormat; ADecimals: Byte = 2); ANumFormat: TsNumberFormat; ADecimals: Byte = 2);
var var
fmt: TsCellFormat; fmt: TsCellFormat;
nfs: String;
begin begin
if IsDateTimeFormat(ANumFormat) or IsCurrencyFormat(ANumFormat) then if IsDateTimeFormat(ANumFormat) or IsCurrencyFormat(ANumFormat) then
raise Exception.Create(rsInvalidNumberFormat); raise Exception.Create(rsInvalidNumberFormat);
@ -3853,11 +3769,16 @@ begin
fmt.NumberFormat := ANumFormat; fmt.NumberFormat := ANumFormat;
if ANumFormat <> nfGeneral then begin if ANumFormat <> nfGeneral then begin
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := BuildNumberFormatString(fmt.NumberFormat, if ANumFormat = nfFraction then
Workbook.FormatSettings, ADecimals); begin
if ADecimals = 0 then ADecimals := 1;
nfs := '# ' + DupeString('?', ADecimals) + '/' + DupeString('?', ADecimals);
end else
nfs := BuildNumberFormatString(fmt.NumberFormat, Workbook.FormatSettings, ADecimals);
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
end else begin end else begin
Exclude(fmt.UsedFormattingFields, uffNumberFormat); Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := ''; fmt.NumberFormatIndex := -1;
end; end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -3921,13 +3842,12 @@ begin
ACell^.NumberValue := ANumber; ACell^.NumberValue := ANumber;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormat := ANumFormat;
if ANumFormat <> nfGeneral then begin if ANumFormat <> nfGeneral then begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(ANumFormatString);
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := ANumFormatString;
end else begin end else begin
Exclude(fmt.UsedFormattingFields, uffNumberFormat); Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := ''; fmt.NumberFormatIndex := -1;
end; end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -4222,20 +4142,51 @@ procedure TsWorksheet.WriteCurrency(ACell: PCell; AValue: Double;
var var
fmt: TsCellFormat; fmt: TsCellFormat;
begin begin
if not (ANumFormat in [nfCurrency, nfCurrencyRed]) then
raise Exception.Create('[TsWorksheet.WriteCurrency] ANumFormat can only be nfCurrency or nfCurrencyRed');
if (ACell <> nil) and IsCurrencyFormat(ANumFormat) then begin if (ACell <> nil) and IsCurrencyFormat(ANumFormat) then begin
ACell^.ContentType := cctNumber; ACell^.ContentType := cctNumber;
ACell^.NumberValue := AValue; ACell^.NumberValue := AValue;
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormatIndex := Workbook.AddNumberFormat(ANumFormatString);
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormat := ANumFormat;
fmt.NumberFormatStr := ANumFormatString;
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt); ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col); ChangedCell(ACell^.Row, ACell^.Col);
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Writes a date/time value to a cell, does not change number format
@param ARow The row of the cell
@param ACol The column of the cell
@param AValue The date/time/datetime to be written
@return Pointer to the cell
-------------------------------------------------------------------------------}
function TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime): PCell;
begin
Result := GetCell(ARow, ACol);
WriteDateTime(Result, AValue);
end;
{@@ ----------------------------------------------------------------------------
Writes a date/time value to a cell. Does not change number format
@param ACell Pointer to the cell considered
@param AValue The date/time/datetime to be written
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime);
begin
if ACell <> nil then begin
ACell^.ContentType := cctDateTime;
ACell^.DateTimeValue := AValue;
ChangedCell(ACell^.Row, ACell^.Col);
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes a date/time value to a cell Writes a date/time value to a cell
@ -4252,7 +4203,7 @@ end;
as a date (either built-in or a custom format). as a date (either built-in or a custom format).
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; function TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''): PCell; ANumFormat: TsNumberFormat; ANumFormatStr: String = ''): PCell;
begin begin
Result := GetCell(ARow, ACol); Result := GetCell(ARow, ACol);
WriteDateTime(Result, AValue, ANumFormat, ANumFormatStr); WriteDateTime(Result, AValue, ANumFormat, ANumFormatStr);
@ -4272,7 +4223,7 @@ end;
as a date (either built-in or a custom format). as a date (either built-in or a custom format).
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime; procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''); ANumFormat: TsNumberFormat; ANumFormatStr: String = '');
var var
parser: TsNumFormatParser; parser: TsNumFormatParser;
fmt: TsCellFormat; fmt: TsCellFormat;
@ -4320,6 +4271,7 @@ begin
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormat := ANumFormat; fmt.NumberFormat := ANumFormat;
fmt.NumberFormatStr := ANumFormatStr; fmt.NumberFormatStr := ANumFormatStr;
fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmt.NumberFormatStr);
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt); ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col); ChangedCell(ACell^.Row, ACell^.Col);
@ -4452,27 +4404,25 @@ procedure TsWorksheet.WriteDecimals(ACell: PCell; ADecimals: Byte);
var var
parser: TsNumFormatParser; parser: TsNumFormatParser;
fmt: TsCellFormat; fmt: TsCellFormat;
numFmt: TsNumFormatParams;
numFmtStr: String;
begin begin
if (ACell = nil) then if (ACell = nil) then
exit; exit;
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if (uffNumberFormat in fmt.UsedFormattingFields) or (fmt.NumberFormat = nfGeneral) numFmt := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex);
then numFmtStr := numFmt.NumFormatStr[nfdDefault];
WriteNumberFormat(ACell, nfFixed, ADecimals) parser := TsNumFormatParser.Create(Workbook, numFmtStr);
else
if fmt.NumberFormat <> nfCustom then
begin
parser := TsNumFormatParser.Create(Workbook, fmt.NumberFormatStr);
try try
parser.Decimals := ADecimals; parser.Decimals := ADecimals;
fmt.NumberFormatStr := parser.FormatString[nfdDefault]; numFmtStr := parser.FormatString[nfdDefault];
finally fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr);
parser.Free;
end;
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col); ChangedCell(ACell^.Row, ACell^.Col);
finally
parser.Free;
end; end;
end; end;
@ -4606,6 +4556,7 @@ procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1); APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1);
var var
fmt: TsCellFormat; fmt: TsCellFormat;
fmtStr: String;
begin begin
if ACell = nil then if ACell = nil then
exit; exit;
@ -4616,16 +4567,17 @@ begin
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
if ANumFormat in [nfCurrency, nfCurrencyRed] then if ANumFormat in [nfCurrency, nfCurrencyRed] then
begin begin
fmt.NumberFormatStr := BuildCurrencyFormatString(nfdDefault, ANumFormat, RegisterCurrency(ACurrencySymbol);
fmtStr := BuildCurrencyFormatString(nfdDefault, ANumFormat,
Workbook.FormatSettings, ADecimals, Workbook.FormatSettings, ADecimals,
APosCurrFormat, ANegCurrFormat, ACurrencySymbol); APosCurrFormat, ANegCurrFormat, ACurrencySymbol);
RegisterCurrency(ACurrencySymbol);
end else end else
fmt.NumberFormatStr := BuildNumberFormatString(ANumFormat, fmtStr := BuildNumberFormatString(ANumFormat,
Workbook.FormatSettings, ADecimals); Workbook.FormatSettings, ADecimals);
fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
end else begin end else begin
Exclude(fmt.UsedFormattingFields, uffNumberFormat); Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := ''; fmt.NumberFormatIndex := -1;
end; end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -4667,14 +4619,14 @@ procedure TsWorksheet.WriteFractionFormat(ACell: PCell;
AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer); AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer);
var var
fmt: TsCellFormat; fmt: TsCellFormat;
nfs: String;
begin begin
if ACell = nil then if ACell = nil then
exit; exit;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormat := nfFraction; nfs := BuildFractionFormatString(AMixedFraction, ANumeratorDigits, ADenominatorDigits);
fmt.NumberFormatStr := BuildFractionFormatString(AMixedFraction, fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
ANumeratorDigits, ADenominatorDigits);
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -4714,21 +4666,22 @@ procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
ANumFormat: TsNumberFormat; const ANumFormatString: String = ''); ANumFormat: TsNumberFormat; const ANumFormatString: String = '');
var var
fmt: TsCellFormat; fmt: TsCellFormat;
fmtStr: String;
begin begin
if ACell = nil then if ACell = nil then
exit; exit;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormat := ANumFormat;
if ANumFormat <> nfGeneral then begin if ANumFormat <> nfGeneral then begin
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
if (ANumFormatString = '') then if (ANumFormatString = '') then
fmt.NumberFormatStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings) fmtStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings)
else else
fmt.NumberFormatStr := ANumFormatString; fmtStr := ANumFormatString;
fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
end else begin end else begin
Exclude(fmt.UsedFormattingFields, uffNumberFormat); Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := ''; fmt.NumberFormatIndex := -1;
end; end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -5112,7 +5065,6 @@ begin
ChangedCell(ACell^.Row, ACell^.Col); ChangedCell(ACell^.Row, ACell^.Col);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Defines a background pattern for a cell Defines a background pattern for a cell
@ -6334,6 +6286,7 @@ begin
SetDefaultFont(DEFAULT_FONTNAME, DEFAULT_FONTSIZE); SetDefaultFont(DEFAULT_FONTNAME, DEFAULT_FONTSIZE);
InitFonts; InitFonts;
FNumFormatList := TsNumFormatList.Create(self, true);
FCellFormatList := TsCellFormatList.Create(false); FCellFormatList := TsCellFormatList.Create(false);
// Add default cell format // Add default cell format
@ -6351,6 +6304,7 @@ begin
FWorksheets.Free; FWorksheets.Free;
FCellFormatList.Free; FCellFormatList.Free;
FNumFormatList.Free;
FFontList.Free; FFontList.Free;
FLog.Free; FLog.Free;
@ -6700,6 +6654,7 @@ begin
AWriter := CreateSpreadWriter(AFormat); AWriter := CreateSpreadWriter(AFormat);
try try
FFileName := AFileName; FFileName := AFileName;
FFormat := AFormat;
PrepareBeforeSaving; PrepareBeforeSaving;
AWriter.CheckLimitations; AWriter.CheckLimitations;
FReadWriteFlag := rwfWrite; FReadWriteFlag := rwfWrite;
@ -7202,16 +7157,13 @@ var
fmt: PsCellFormat; fmt: PsCellFormat;
cb: TsCellBorder; cb: TsCellBorder;
s: String; s: String;
numFmt: TsNumFormatParams;
begin begin
Result := ''; Result := '';
fmt := GetPointerToCellFormat(AIndex); fmt := GetPointerToCellFormat(AIndex);
if fmt = nil then if fmt = nil then
exit; exit;
{
if (uffBold in fmt^.UsedFormattingFields) then
Result := Format('%s; bold', [Result]);
}
if (uffFont in fmt^.UsedFormattingFields) then if (uffFont in fmt^.UsedFormattingFields) then
Result := Format('%s; Font%d', [Result, fmt^.FontIndex]); Result := Format('%s; Font%d', [Result, fmt^.FontIndex]);
if (uffBackground in fmt^.UsedFormattingFields) then begin if (uffBackground in fmt^.UsedFormattingFields) then begin
@ -7226,10 +7178,17 @@ begin
if (uffWordwrap in fmt^.UsedFormattingFields) then if (uffWordwrap in fmt^.UsedFormattingFields) then
Result := Format('%s; Word-wrap', [Result]); Result := Format('%s; Word-wrap', [Result]);
if (uffNumberFormat in fmt^.UsedFormattingFields) then if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin
numFmt := GetNumberFormat(fmt^.NumberFormatIndex);
if numFmt <> nil then
Result := Format('%s; %s (%s)', [Result, Result := Format('%s; %s (%s)', [Result,
GetEnumName(TypeInfo(TsNumberFormat), ord(fmt^.NumberFormat)), GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat)),
fmt^.NumberFormatStr numFmt.NumFormatStr[nfdDefault]
]); ])
else
Result := Format('%s; %s', [Result, 'nfGeneral']);
end else
Result := Format('%s; %s', [Result, 'nfGeneral']);
if (uffBorder in fmt^.UsedFormattingFields) then if (uffBorder in fmt^.UsedFormattingFields) then
begin begin
s := ''; s := '';
@ -7505,6 +7464,39 @@ begin
end; end;
{@@ ----------------------------------------------------------------------------
Adds a number format to the internal list. Returns the list index if already
present, or creates a new format item and returns its index.
-------------------------------------------------------------------------------}
function TsWorkbook.AddNumberFormat(AFormatStr: String): Integer;
begin
if AFormatStr = '' then
Result := -1 // General number format is not stored
else
Result := TsNumFormatList(FNumFormatList).AddFormat(AFormatStr, nfdDefault);
end;
{@@ ----------------------------------------------------------------------------
Returns the parameters of the number format stored in the NumFormatList at the
specified index.
"General" number format is returned as nil.
-------------------------------------------------------------------------------}
function TsWorkbook.GetNumberFormat(AIndex: Integer): TsNumFormatParams;
begin
if (AIndex >= 0) and (AIndex < FNumFormatList.Count) then
Result := TsNumFormatParams(FNumFormatList.Items[AIndex])
else
Result := nil;
end;
{@@ ----------------------------------------------------------------------------
Returns the count of number format records stored in the NumFormatList
-------------------------------------------------------------------------------}
function TsWorkbook.GetNumberFormatCount: Integer;
begin
Result := FNumFormatList.Count;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Adds a color to the palette and returns its palette index, but only if the Adds a color to the palette and returns its palette index, but only if the
color does not already exist - in this case, it returns the index of the color does not already exist - in this case, it returns the index of the

View File

@ -957,6 +957,8 @@ procedure TsWorkbookSource.SaveToSpreadsheetFile(AFileName: String;
begin begin
if FWorkbook <> nil then begin if FWorkbook <> nil then begin
FWorkbook.WriteToFile(AFileName, AFormat, AOverwriteExisting); FWorkbook.WriteToFile(AFileName, AFormat, AOverwriteExisting);
FFileName := AFilename;
FFileFormat := AFormat;
// If required, display loading error message // If required, display loading error message
if FWorkbook.ErrorMsg <> '' then if FWorkbook.ErrorMsg <> '' then
@ -1210,13 +1212,13 @@ begin
begin begin
rng := FWorksheet.GetSelection[j]; rng := FWorksheet.GetSelection[j];
r := rng.Row1; r := rng.Row1;
while (r <= rng.Row2) do begin while (r <= longInt(rng.Row2)) do begin
c := rng.Col1; c := rng.Col1;
while (c <= rng.Col2) do begin while (c <= LongInt(rng.Col2)) do begin
for i:=0 to CellClipboard.Count-1 do begin for i:=0 to CellClipboard.Count-1 do begin
cell := CellClipboard.CellByIndex[i]; cell := CellClipboard.CellByIndex[i];
destRow := r + LongInt(cell^.Row) - baserng.Row1; destRow := r + LongInt(cell^.Row) - LongInt(baserng.Row1);
destCol := c + LongInt(cell^.Col) - baserng.Col1; destCol := c + LongInt(cell^.Col) - LongInt(baserng.Col1);
case AItem of case AItem of
coCopyCell: coCopyCell:
FWorksheet.CopyCell(cell^.Row, cell^.Col, destRow, destCol); FWorksheet.CopyCell(cell^.Row, cell^.Col, destRow, destCol);
@ -2613,6 +2615,7 @@ var
cb: TsCellBorder; cb: TsCellBorder;
r1, r2, c1, c2: Cardinal; r1, r2, c1, c2: Cardinal;
fmt: TsCellFormat; fmt: TsCellFormat;
numFmt: TsNumFormatParams;
begin begin
if (ACell <> nil) then if (ACell <> nil) then
fmt := Workbook.GetCellFormat(ACell^.FormatIndex) fmt := Workbook.GetCellFormat(ACell^.FormatIndex)
@ -2687,13 +2690,16 @@ begin
if (ACell = nil) or not (uffNumberFormat in fmt.UsedFormattingFields) then if (ACell = nil) or not (uffNumberFormat in fmt.UsedFormattingFields) then
begin begin
AStrings.Add('NumberFormatIndex=-1');
AStrings.Add('NumberFormat=(default)'); AStrings.Add('NumberFormat=(default)');
AStrings.Add('NumberFormatStr=(none)'); AStrings.Add('NumberFormatStr=(none)');
end else end else
begin begin
AStrings.Add(Format('NumberFormatIndex=%d', [fmt.NumberFormatIndex]));
numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
AStrings.Add(Format('NumberFormat=%s', [ AStrings.Add(Format('NumberFormat=%s', [
GetEnumName(TypeInfo(TsNumberFormat), ord(fmt.NumberFormat))])); GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat))]));
AStrings.Add('NumberFormatStr=' + fmt.NumberFormatStr); AStrings.Add('NumberFormatStr=' + numFmt.NumFormatStr[nfdDefault]);
end; end;
if (Worksheet = nil) or not Worksheet.IsMerged(ACell) then if (Worksheet = nil) or not Worksheet.IsMerged(ACell) then

View File

@ -19,7 +19,11 @@ unit fpspreadsheetgrid;
- When Lazarus 1.4 comes out remove the workaround for the RGB2HLS bug in - When Lazarus 1.4 comes out remove the workaround for the RGB2HLS bug in
FindNearestPaletteIndex. FindNearestPaletteIndex.
- Arial bold is not shown as such if loaded from ods - Arial bold is not shown as such if loaded from ods
- Background color of first cell is ignored. } - Background color of first cell is ignored.
- Enter 1234567890 into a cell. reduce col width with mouse. Immediately
before display becomes #### there is 11E09 in the cell - it should be 1E09.
Cell not correctly erased? }
interface interface
@ -585,7 +589,7 @@ procedure Register;
implementation implementation
uses uses
Types, LCLType, LCLIntf, LCLProc, Math, Types, LCLType, LCLIntf, LCLProc, Math, StrUtils,
fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils; fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils;
const const
@ -1334,6 +1338,9 @@ var
style: TFontStyles; style: TFontStyles;
isSelected: Boolean; isSelected: Boolean;
fgcolor, bgcolor: TColor; fgcolor, bgcolor: TColor;
numFmt: TsNumFormatParams;
sidx: Integer;
clr: Integer;
begin begin
GetSelectedState(AState, isSelected); GetSelectedState(AState, isSelected);
Canvas.Font.Assign(Font); Canvas.Font.Assign(Font);
@ -1367,6 +1374,7 @@ begin
if lCell <> nil then if lCell <> nil then
begin begin
fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex); fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex);
numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
// Background color // Background color
if (uffBackground in fmt^.UsedFormattingFields) then if (uffBackground in fmt^.UsedFormattingFields) then
@ -1424,10 +1432,26 @@ begin
if fssStrikeout in fnt.Style then Include(style, fsStrikeout); if fssStrikeout in fnt.Style then Include(style, fsStrikeout);
Canvas.Font.Style := style; Canvas.Font.Style := style;
end; end;
if not IsNaN(lCell^.NumberValue) and (numFmt <> nil) then
begin
sidx := 0;
if (Length(numFmt.Sections) > 1) and (lCell^.NumberValue < 0) then
sidx := 1
else
if (Length(numFmt.Sections) > 2) and (lCell^.NumberValue = 0) then
sidx := 2;
if numFmt.Sections[sidx].Elements[0].Token = nftColor then
begin
clr := numFmt.Sections[sidx].Elements[0].IntValue;
Canvas.Font.Color := Workbook.GetPaletteColor(clr);
end;
end;
{
if (fmt^.NumberFormat = nfCurrencyRed) and if (fmt^.NumberFormat = nfCurrencyRed) and
not IsNaN(lCell^.NumberValue) and (lCell^.NumberValue < 0) not IsNaN(lCell^.NumberValue) and (lCell^.NumberValue < 0)
then then
Canvas.Font.Color := Workbook.GetPaletteColor(scRed); Canvas.Font.Color := Workbook.GetPaletteColor(scRed);
}
// Wordwrap, text alignment and text rotation are handled by "DrawTextInCell". // Wordwrap, text alignment and text rotation are handled by "DrawTextInCell".
end; end;
end; end;
@ -3834,8 +3858,10 @@ var
p: Integer; p: Integer;
isRotated: Boolean; isRotated: Boolean;
isStacked: Boolean; isStacked: Boolean;
tr: TsTextRotation;
fmt: PsCellFormat; fmt: PsCellFormat;
numFmt: TsNumFormatParams;
nfs: String;
isGeneralFmt: Boolean;
begin begin
Result := Worksheet.ReadAsUTF8Text(ACell); Result := Worksheet.ReadAsUTF8Text(ACell);
if (Result = '') or ((ACell <> nil) and (ACell^.ContentType = cctUTF8String)) if (Result = '') or ((ACell <> nil) and (ACell^.ContentType = cctUTF8String))
@ -3843,11 +3869,10 @@ begin
exit; exit;
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
tr := fmt^.TextRotation; isRotated := (fmt^.TextRotation <> trHorizontal);
isRotated := (tr <> trHorizontal); isStacked := (fmt^.TextRotation = rtStacked);
isStacked := (tr = rtStacked); numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
// isRotated := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation <> trHorizontal); isGeneralFmt := (numFmt = nil);
// isStacked := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation = rtStacked);
// Determine space available in cell // Determine space available in cell
if isRotated then if isRotated then
@ -3865,7 +3890,7 @@ begin
if txtSize <= cellSize then if txtSize <= cellSize then
exit; exit;
if (ACell^.ContentType = cctNumber) and (fmt^.NumberFormat = nfGeneral) then if (ACell^.ContentType = cctNumber) and isGeneralFmt then
begin begin
// Determine number of decimal places // Determine number of decimal places
p := pos(Workbook.FormatSettings.DecimalSeparator, Result); p := pos(Workbook.FormatSettings.DecimalSeparator, Result);
@ -3893,7 +3918,9 @@ begin
while decs > 0 do while decs > 0 do
begin begin
dec(decs); dec(decs);
Result := Format('%.*e', [decs, ACell^.NumberValue], Workbook.FormatSettings); nfs := '0.' + DupeString('0', decs) + 'E-00';
Result := FormatFloat(nfs, ACell^.NumberValue, Workbook.FormatSettings);
// Result := Format('%.*e', [decs, ACell^.NumberValue], Workbook.FormatSettings);
if isStacked then if isStacked then
txtSize := Length(Result) * Canvas.TextHeight('A') txtSize := Length(Result) * Canvas.TextHeight('A')
else else
@ -3966,6 +3993,8 @@ var
lRow: PRow; lRow: PRow;
h: Integer; h: Integer;
begin begin
Unused(AStartIndex);
{ {
BeginUpdate; BeginUpdate;
if AStartIndex <= 0 then AStartIndex := FHeaderCount; if AStartIndex <= 0 then AStartIndex := FHeaderCount;

View File

@ -20,7 +20,7 @@ interface
uses uses
Classes, Sysutils, AVL_Tree, Classes, Sysutils, AVL_Tree,
fpsTypes, fpsClasses, fpSpreadsheet, fpsNumFormat; fpsTypes, fpsClasses, fpSpreadsheet;
type type
{@@ {@@
@ -38,10 +38,11 @@ type
FVirtualCell: TCell; FVirtualCell: TCell;
{@@ Stores if the reader is in virtual mode } {@@ Stores if the reader is in virtual mode }
FIsVirtualMode: Boolean; FIsVirtualMode: Boolean;
{@@ List of number formats found in the file } {@@ List of number formats }
FNumFormatList: TsCustomNumFormatList; FNumFormatList: TStringList;
{ Helper methods } { Helper methods }
procedure AddBuiltinNumFormats; virtual;
{@@ Removes column records if all of them have the same column width } {@@ Removes column records if all of them have the same column width }
procedure FixCols(AWorksheet: TsWorksheet); procedure FixCols(AWorksheet: TsWorksheet);
{@@ Removes row records if all of them have the same row height } {@@ Removes row records if all of them have the same row height }
@ -59,8 +60,6 @@ type
{@@ Abstract method for reading a number cell. Must be overridden by descendent classes. } {@@ Abstract method for reading a number cell. Must be overridden by descendent classes. }
procedure ReadNumber(AStream: TStream); virtual; abstract; procedure ReadNumber(AStream: TStream); virtual; abstract;
procedure CreateNumFormatList; virtual;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
@ -71,7 +70,7 @@ type
procedure ReadFromStrings(AStrings: TStrings); override; procedure ReadFromStrings(AStrings: TStrings); override;
{@@ List of number formats found in the workbook. } {@@ List of number formats found in the workbook. }
property NumFormatList: TsCustomNumFormatList read FNumFormatList; property NumFormatList: TStringList read FNumFormatList;
end; end;
@ -92,14 +91,15 @@ type
TsCustomSpreadWriter = class(TsBasicSpreadWriter) TsCustomSpreadWriter = class(TsBasicSpreadWriter)
protected protected
{@@ List of number formats found in the file } {@@ List of number formats found in the file }
FNumFormatList: TsCustomNumFormatList; FNumFormatList: TStringList;
procedure CreateNumFormatList; virtual; procedure AddBuiltinNumFormats; virtual;
function FindNumFormatInList(ANumFormatStr: String): Integer;
function FixColor(AColor: TsColor): TsColor; virtual; function FixColor(AColor: TsColor): TsColor; virtual;
procedure FixFormat(ACell: PCell); virtual; procedure FixFormat(ACell: PCell); virtual;
procedure GetSheetDimensions(AWorksheet: TsWorksheet; procedure GetSheetDimensions(AWorksheet: TsWorksheet;
out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual;
procedure ListAllNumFormats; virtual; procedure ListAllNumFormats(ADialect: TsNumFormatDialect); virtual;
{ Helpers for writing } { Helpers for writing }
procedure WriteCellToStream(AStream: TStream; ACell: PCell); procedure WriteCellToStream(AStream: TStream; ACell: PCell);
@ -133,7 +133,7 @@ type
procedure WriteToStrings(AStrings: TStrings); override; procedure WriteToStrings(AStrings: TStrings); override;
{@@ List of number formats found in the workbook. } {@@ List of number formats found in the workbook. }
property NumFormatList: TsCustomNumFormatList read FNumFormatList; property NumFormatList: TStringList read FNumFormatList;
end; end;
{@@ List of registered formats } {@@ List of registered formats }
@ -195,7 +195,8 @@ begin
// Font list // Font list
FFontList := TFPList.Create; FFontList := TFPList.Create;
// Number formats // Number formats
CreateNumFormatList; FNumFormatList := TStringList.Create;
AddBuiltinNumFormats;
// Virtual mode // Virtual mode
FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and FIsVirtualMode := (boVirtualMode in FWorkbook.Options) and
Assigned(FWorkbook.OnReadCellData); Assigned(FWorkbook.OnReadCellData);
@ -219,15 +220,14 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Creates an instance of the number format list which contains prototypes of Adds the built-in number formats to the internal NumFormatList.
all number formats found in the the file (when reading).
The method has to be overridden because the descendants know the special Must be overridden by descendants because they know about the details of
requirements of the file format. the file format.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadReader.CreateNumFormatList; procedure TsCustomSpreadReader.AddBuiltinNumFormats;
begin begin
// nothing to do here // to be overridden by descendants
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -368,12 +368,13 @@ constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
// Number formats // Number formats
CreateNumFormatList; FNumFormatList := TStringList.Create;
AddBuiltinNumFormats;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Destructor of the writer. Destructor of the writer.
Destroys the internal number format list and the error log list. Destroys the internal number format list.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
destructor TsCustomSpreadWriter.Destroy; destructor TsCustomSpreadWriter.Destroy;
begin begin
@ -382,15 +383,26 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Creates an instance of the number format list which contains prototypes of Adds the built-in number formats to the NumFormatList
all number formats found in the workbook .
The method has to be overridden because the descendants know the special The method has to be overridden because the descendants know the special
requirements of the file format. requirements of the file format.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.CreateNumFormatList; procedure TsCustomSpreadWriter.AddBuiltinNumFormats;
begin begin
// nothing to do here // to be overridden by descendents
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format string is already contained in the
the writer's internal number format list. If yes, the list index is returned.
-------------------------------------------------------------------------------}
function TsCustomSpreadWriter.FindNumFormatInList(ANumFormatStr: String): Integer;
begin
for Result:=0 to FNumFormatList.Count-1 do
if SameText(ANumFormatStr, FNumFormatList[Result]) then
exit;
Result := -1;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -467,21 +479,24 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Iterates through all cells and collects the number formats in Copies the format strings from the workbook's NumFormatList to the writer's
FNumFormatList (without duplicates). internal NumFormatList.
The index of the list item is needed for the field FormatIndex of the XF record.
At the time when the method is called the formats are still in fpc dialect.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.ListAllNumFormats; procedure TsCustomSpreadWriter.ListAllNumFormats(ADialect: TsNumFormatDialect);
var var
i: Integer; i: Integer;
fmt: PsCellFormat; numFmt: TsNumFormatParams;
numFmtStr: String;
begin begin
for i:=0 to Workbook.GetNumCellFormats - 1 do for i:=0 to Workbook.GetNumberFormatCount - 1 do
begin begin
fmt := Workbook.GetPointerToCellFormat(i); numFmt := Workbook.GetNumberFormat(i);
if FNumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr) = -1 then if numFmt <> nil then
FNumFormatList.AddFormat(fmt^.NumberFormat, fmt^.NumberFormatStr); begin
numFmtStr := numFmt.NumFormatStr[ADialect];
if FindNumFormatInList(numFmtStr) = -1 then
FNumFormatList.Add(numFmtStr);
end;
end; end;
end; end;
@ -534,7 +549,6 @@ var
begin begin
for cell in ACells do for cell in ACells do
WriteCellToStream(AStream, cell); WriteCellToStream(AStream, cell);
// IterateThroughCells(AStream, ACells, WriteCellCallback);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------

View File

@ -31,6 +31,7 @@ resourcestring
rsInvalidNumberFormat = 'Trying to use an incompatible number format.'; rsInvalidNumberFormat = 'Trying to use an incompatible number format.';
rsInvalidDateTimeFormat = 'Trying to use an incompatible date/time format.'; rsInvalidDateTimeFormat = 'Trying to use an incompatible date/time format.';
rsNoValidNumberFormatString = 'No valid number format string.'; rsNoValidNumberFormatString = 'No valid number format string.';
rsIsNoValidNumberFormatString = '%s is not a valid number format string.';
rsNoValidCellAddress = '"%s" is not a valid cell address.'; rsNoValidCellAddress = '"%s" is not a valid cell address.';
rsNoValidCellRangeAddress = '"%s" is not a valid cell range address.'; rsNoValidCellRangeAddress = '"%s" is not a valid cell range address.';
rsNoValidCellRangeOrCellAddress = '"%s" is not a valid cell or cell range address.'; rsNoValidCellRangeOrCellAddress = '"%s" is not a valid cell or cell range address.';
@ -77,11 +78,6 @@ resourcestring
rsErrArgError = '#N/A'; rsErrArgError = '#N/A';
rsErrFormulaNotSupported = '<FORMULA?>'; rsErrFormulaNotSupported = '<FORMULA?>';
(*
{%H-}rsNoValidDateTimeFormatString = 'No valid date/time format string.';
{%H-}rsIllegalNumberFormat = 'Illegal number format.';
*)
implementation implementation
end. end.

View File

@ -196,27 +196,6 @@ type
{@@ Describes which formatting fields are active } {@@ Describes which formatting fields are active }
TsUsedFormattingFields = set of TsUsedFormattingField; TsUsedFormattingFields = set of TsUsedFormattingField;
{@@ Number/cell formatting. Only uses a subset of the default formats,
enough to be able to read/write date/time values.
nfCustom allows to apply a format string directly. }
TsNumberFormat = (
// general-purpose for all numbers
nfGeneral,
// numbers
nfFixed, nfFixedTh, nfExp, nfPercentage, nfFraction,
// currency
nfCurrency, nfCurrencyRed,
// dates and times
nfShortDateTime, {nfFmtDateTime, }nfShortDate, nfLongDate, nfShortTime, nfLongTime,
nfShortTimeAM, nfLongTimeAM, nfTimeInterval,
// other (format string goes directly into the file)
nfCustom);
{@@ Identifies which "dialect" is used in the format strings:
nfdDefault is the dialect used by fpc
fndExcel is the dialect used by Excel }
TsNumFormatDialect = (nfdDefault, nfdExcel);
const const
{ @@ Codes for curreny format according to FormatSettings.CurrencyFormat: { @@ Codes for curreny format according to FormatSettings.CurrencyFormat:
"C" = currency symbol, "V" = currency value, "S" = space character "C" = currency symbol, "V" = currency value, "S" = space character
@ -450,6 +429,112 @@ type
coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual
); );
{@@ Number/cell formatting. Only uses a subset of the default formats,
enough to be able to read/write date/time values.
nfCustom allows to apply a format string directly. }
TsNumberFormat = (
// general-purpose for all numbers
nfGeneral,
// numbers
nfFixed, nfFixedTh, nfExp, nfPercentage, nfFraction,
// currency
nfCurrency, nfCurrencyRed,
// dates and times
nfShortDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime,
nfShortTimeAM, nfLongTimeAM, nfDayMonth, nfMonthYear, nfTimeInterval,
// other (format string goes directly into the file)
nfCustom);
{@@ Identifies which "dialect" is used in the format strings:
nfdDefault is the dialect used by fpc
fndExcel is the dialect used by Excel }
TsNumFormatDialect = (nfdDefault, nfdExcel);
TsNumFormatToken = (
nftText, // must be quoted, stored in TextValue
nftThSep, // ',', replaced by FormatSettings.ThousandSeparator
nftDecSep, // '.', replaced by FormatSettings.DecimalSeparator
nftYear, // 'y' or 'Y', count stored in IntValue
nftMonth, // 'm' or 'M', count stored in IntValue
nftDay, // 'd' or 'D', count stored in IntValue
nftHour, // 'h' or 'H', count stored in IntValue
nftMinute, // 'n' or 'N' (or 'm'/'M'), count stored in IntValue
nftSecond, // 's' or 'S', count stored in IntValue
nftMilliseconds, // 'z', 'Z', '0', count stored in IntValue
nftAMPM, //
nftMonthMinute, // 'm'/'M' or 'n'/'N', meaning depending on context
nftDateTimeSep, // '/' or ':', replaced by value from FormatSettings, stored in TextValue
nftSign, // '+' or '-', stored in TextValue
nftSignBracket, // '(' or ')' for negative values, stored in TextValue
nftIntOptDigit, // '#', count stored in IntValue
nftIntZeroDigit, // '0', count stored in IntValue
nftIntSpaceDigit, // '?', count stored in IntValue
nftIntTh, // '#,##0' sequence for nfFixed, count of 0 stored in IntValue
nftZeroDecs, // '0' after dec sep, count stored in IntValue
nftOptDecs, // '#' after dec sep, count stored in IntValue
nftSpaceDecs, // '?' after dec sep, count stored in IntValue
nftExpChar, // 'e' or 'E', stored in TextValue
nftExpSign, // '+' or '-' in exponent
nftExpDigits, // '0' digits in exponent, count stored in IntValue
nftPercent, // '%' percent symbol
nftFracSymbol, // '/' fraction symbol
nftFracNumOptDigit, // '#' in numerator, count stored in IntValue
nftFracNumSpaceDigit, // '?' in numerator, count stored in IntValue
nftFracNumZeroDigit, // '0' in numerator, count stored in IntValue
nftFracDenomOptDigit, // '#' in denominator, count stored in IntValue
nftFracDenomSpaceDigit,// '?' in denominator, count stored in IntValue
nftFracDenomZeroDigit, // '0' in denominator, count stored in IntValue
nftCurrSymbol, // e.g., '"$"', stored in TextValue
nftCountry,
nftColor, // e.g., '[red]', Color in IntValue
nftCompareOp,
nftCompareValue,
nftSpace,
nftEscaped, // '\'
nftRepeat,
nftEmptyCharWidth,
nftTextFormat);
TsNumFormatElement = record
Token: TsNumFormatToken;
IntValue: Integer;
FloatValue: Double;
TextValue: String;
end;
TsNumFormatElements = array of TsNumFormatElement;
TsNumFormatKind = (nfkPercent, nfkExp, nfkCurrency, nfkFraction, nfkDate, nfkTime, nfkTimeInterval);
TsNumFormatKinds = set of TsNumFormatKind;
TsNumFormatSection = record
Elements: TsNumFormatElements;
Kind: TsNumFormatKinds;
NumFormat: TsNumberFormat;
Decimals: Byte;
FracInt: Integer;
FracNumerator: Integer;
FracDenominator: Integer;
CurrencySymbol: String;
Color: TsColor;
end;
PsNumFormatSection = ^TsNumFormatSection;
TsNumFormatSections = array of TsNumFormatSection;
TsNumFormatParams = class(TObject)
protected
function GetNumFormat: TsNumberFormat; virtual;
function GetNumFormatStr(ADialect: TsNumFormatDialect): String; virtual;
public
Sections: TsNumFormatSections;
function SectionsEqualTo(ASections: TsNumFormatSections): Boolean;
property NumFormat: TsNumberFormat read GetNumFormat;
property NumFormatStr[ADialect: TsNumFormatDialect]: String read GetNumFormatStr;
end;
TsNumFormatParamsClass = class of TsNumFormatParams;
{@@ Cell calculation state } {@@ Cell calculation state }
TsCalcState = (csNotCalculated, csCalculating, csCalculated); TsCalcState = (csNotCalculated, csCalculating, csCalculated);
@ -512,6 +597,8 @@ type
Border: TsCellBorders; Border: TsCellBorders;
BorderStyles: TsCelLBorderStyles; BorderStyles: TsCelLBorderStyles;
Background: TsFillPattern; Background: TsFillPattern;
NumberFormatIndex: Integer;
// next two are deprecated...
NumberFormat: TsNumberFormat; NumberFormat: TsNumberFormat;
NumberFormatStr: String; NumberFormatStr: String;
end; end;
@ -573,9 +660,15 @@ type
cctError : (ErrorValue: TsErrorValue); cctError : (ErrorValue: TsErrorValue);
end; end;
function BuildFormatStringFromSection(const ASection: TsNumFormatSection;
ADialect: TsNumFormatDialect): String;
implementation implementation
uses
StrUtils;
{ TsCellFormatList } { TsCellFormatList }
constructor TsCellFormatList.Create(AAllowDuplicates: Boolean); constructor TsCellFormatList.Create(AAllowDuplicates: Boolean);
@ -610,6 +703,7 @@ begin
P^.Border := AItem.Border; P^.Border := AItem.Border;
P^.BorderStyles := AItem.BorderStyles; P^.BorderStyles := AItem.BorderStyles;
P^.Background := AItem.Background; P^.Background := AItem.Background;
P^.NumberFormatIndex := AItem.NumberFormatIndex;
P^.NumberFormat := AItem.NumberFormat; P^.NumberFormat := AItem.NumberFormat;
P^.NumberFormatStr := AItem.NumberFormatStr; P^.NumberFormatStr := AItem.NumberFormatStr;
Result := inherited Add(P); Result := inherited Add(P);
@ -725,6 +819,7 @@ begin
end; end;
if (uffNumberFormat in AItem.UsedFormattingFields) then begin if (uffNumberFormat in AItem.UsedFormattingFields) then begin
if (P^.NumberFormatIndex <> AItem.NumberFormatIndex) then continue;
if (P^.NumberFormat <> AItem.NumberFormat) then continue; if (P^.NumberFormat <> AItem.NumberFormat) then continue;
if (P^.NumberFormatStr <> AItem.NumberFormatStr) then continue; if (P^.NumberFormatStr <> AItem.NumberFormatStr) then continue;
end; end;
@ -743,5 +838,202 @@ begin
end; end;
{ Creates a format string for the given section. This implementation covers
the formatstring dialects of fpc (nfdDefault) and Excel (nfdExcel). }
function BuildFormatStringFromSection(const ASection: TsNumFormatSection;
ADialect: TsNumFormatDialect): String;
var
element: TsNumFormatElement;
i: Integer;
begin
Result := '';
for i := 0 to High(ASection.Elements) do begin
element := ASection.Elements[i];
case element.Token of
nftIntOptDigit, nftOptDecs, nftFracNumOptDigit, nftFracDenomOptDigit:
if element.IntValue > 0 then
Result := Result + DupeString('#', element.IntValue);
nftIntZeroDigit, nftZeroDecs, nftFracNumZeroDigit, nftFracDenomZeroDigit, nftExpDigits:
if element.IntValue > 0 then
Result := result + DupeString('0', element.IntValue);
nftIntSpaceDigit, nftSpaceDecs, nftFracNumSpaceDigit, nftFracDenomSpaceDigit:
if element.Intvalue > 0 then
Result := result + DupeString('?', element.IntValue);
nftIntTh:
case element.Intvalue of
0: Result := Result + '#,###';
1: Result := Result + '#,##0';
2: Result := Result + '#,#00';
3: Result := Result + '#,000';
end;
nftDecSep:
Result := Result + '.';
nftThSep:
Result := Result + ',';
nftFracSymbol:
Result := Result + '/';
nftPercent:
Result := Result + '%';
nftSpace:
Result := Result + ' ';
nftText:
if element.TextValue <> '' then result := Result + '"' + element.TextValue + '"';
nftYear:
Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'Y', 'y'), element.IntValue);
nftMonth:
Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'M', 'm'), element.IntValue);
nftDay:
Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'D', 'd'), element.IntValue);
nftHour:
if element.IntValue < 0
then Result := Result + '[' + DupeString('h', -element.IntValue) + ']'
else Result := Result + DupeString('h', element.IntValue);
nftMinute:
if element.IntValue < 0
then Result := result + '[' + DupeString(IfThen(ADialect = nfdExcel, 'm', 'n'), -element.IntValue) + ']'
else Result := Result + DupeString(IfThen(ADialect = nfdExcel, 'm', 'n'), element.IntValue);
nftSecond:
if element.IntValue < 0
then Result := Result + '[' + DupeString('s', -element.IntValue) + ']'
else Result := Result + DupeString('s', element.IntValue);
nftMilliseconds:
if ADialect = nfdExcel then
Result := Result + Dupestring('0', element.IntValue)
else
Result := Result + DupeString('z', element.IntValue);
nftSign, nftSignBracket, nftExpChar, nftExpSign, nftAMPM, nftDateTimeSep:
if element.TextValue <> '' then Result := Result + element.TextValue;
nftCurrSymbol:
if element.TextValue <> '' then begin
if ADialect = nfdExcel then
Result := Result + '[$' + element.TextValue + ']'
else
Result := Result + '"' + element.TextValue + '"';
end;
nftEscaped:
if element.TextValue <> '' then begin
if ADialect = nfdExcel then
Result := Result + '\' + element.TextValue
else
Result := Result + element.TextValue;
end;
nftTextFormat:
if element.TextValue <> '' then
if ADialect = nfdExcel then Result := Result + element.TextValue;
nftRepeat:
if element.TextValue <> '' then Result := Result + '*' + element.TextValue;
nftColor:
if ADialect = nfdExcel then begin
case element.IntValue of
scBlack : Result := '[black]';
scWhite : Result := '[white]';
scRed : Result := '[red]';
scBlue : Result := '[blue]';
scGreen : Result := '[green]';
scYellow : Result := '[yellow]';
scMagenta: Result := '[magenta]';
scCyan : Result := '[cyan]';
else Result := Format('[Color%d]', [element.IntValue]);
end;
end;
end;
end;
end;
{ TsNumFormatParams }
function TsNumFormatParams.GetNumFormat: TsNumberFormat;
begin
Result := nfCustom;
case Length(Sections) of
0: Result := nfGeneral;
1: Result := Sections[0].NumFormat;
2: if (Sections[0].NumFormat = Sections[1].NumFormat) and
(Sections[0].NumFormat in [nfCurrency, nfCurrencyRed])
then
Result := Sections[0].NumFormat;
3: if (Sections[0].NumFormat = Sections[1].NumFormat) and
(Sections[1].NumFormat = Sections[2].NumFormat) and
(Sections[0].NumFormat in [nfCurrency, nfCurrencyRed])
then
Result := Sections[0].NumFormat;
end;
end;
function TsNumFormatParams.GetNumFormatStr(ADialect: TsNumFormatDialect): String;
var
i: Integer;
begin
if Length(Sections) > 0 then begin
Result := BuildFormatStringFromSection(Sections[0], ADialect);
for i := 1 to High(Sections) do
Result := Result + ';' + BuildFormatStringFromSection(Sections[i], ADialect);
end else
Result := '';
end;
function TsNumFormatParams.SectionsEqualTo(ASections: TsNumFormatSections): Boolean;
var
i, j: Integer;
begin
Result := false;
if Length(ASections) <> Length(Sections) then
exit;
for i := 0 to High(Sections) do begin
if Length(Sections[i].Elements) <> Length(ASections[i].Elements) then
exit;
for j:=0 to High(Sections[i].Elements) do
begin
if Sections[i].Elements[j].Token <> ASections[i].Elements[j].Token then
exit;
if Sections[i].NumFormat <> ASections[i].NumFormat then
exit;
if Sections[i].Decimals <> ASections[i].Decimals then
exit;
if Sections[i].FracInt <> ASections[i].FracInt then
exit;
if Sections[i].FracNumerator <> ASections[i].FracNumerator then
exit;
if Sections[i].FracDenominator <> ASections[i].FracDenominator then
exit;
if Sections[i].CurrencySymbol <> ASections[i].CurrencySymbol then
exit;
if Sections[i].Color <> ASections[i].Color then
exit;
case Sections[i].Elements[j].Token of
nftText, nftThSep, nftDecSep, nftDateTimeSep,
nftAMPM, nftSign, nftSignBracket,
nftExpChar, nftExpSign, nftPercent, nftFracSymbol, nftCurrSymbol,
nftCountry, nftSpace, nftEscaped, nftRepeat, nftEmptyCharWidth,
nftTextFormat:
if Sections[i].Elements[j].TextValue <> ASections[i].Elements[j].TextValue
then exit;
nftYear, nftMonth, nftDay,
nftHour, nftMinute, nftSecond, nftMilliseconds,
nftMonthMinute,
nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit, nftIntTh,
nftZeroDecs, nftOptDecs, nftSpaceDecs, nftExpDigits,
nftFracNumOptDigit, nftFracNumSpaceDigit, nftFracNumZeroDigit,
nftFracDenomOptDigit, nftFracDenomSpaceDigit, nftFracDenomZeroDigit,
nftColor:
if Sections[i].Elements[j].IntValue <> ASections[i].Elements[j].IntValue
then exit;
nftCompareOp, nftCompareValue:
if Sections[i].Elements[j].FloatValue <> ASections[i].Elements[j].FloatValue
then exit;
end;
end;
end;
Result := true;
end;
end. end.

View File

@ -113,8 +113,6 @@ function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function AddIntervalBrackets(AFormatString: String): String; function AddIntervalBrackets(AFormatString: String): String;
function DayNamesToString(const ADayNames: TWeekNameArray; function DayNamesToString(const ADayNames: TWeekNameArray;
const AEmptyStr: String): String; const AEmptyStr: String): String;
procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer;
out ANumerator, ADenominator: Integer);
function MakeLongDateFormat(ADateFormat: String): String; function MakeLongDateFormat(ADateFormat: String): String;
function MakeShortDateFormat(ADateFormat: String): String; function MakeShortDateFormat(ADateFormat: String): String;
function MonthNamesToString(const AMonthNames: TMonthNameArray; function MonthNamesToString(const AMonthNames: TMonthNameArray;
@ -126,9 +124,12 @@ procedure SplitFormatString(const AFormatString: String; out APositivePart,
procedure MakeTimeIntervalMask(Src: String; var Dest: String); procedure MakeTimeIntervalMask(Src: String; var Dest: String);
function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams;
AFormatSettings: TFormatSettings): String;
procedure FloatToFraction(AValue, APrecision: Double;
AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: Int64);
function TryStrToFloatAuto(AText: String; out ANumber: Double; function TryStrToFloatAuto(AText: String; out ANumber: Double;
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean; out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
function TryFractionStrToFloat(AText: String; out ANumber: Double; function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AMaxDigits: Integer): Boolean; out AMaxDigits: Integer): Boolean;
@ -172,6 +173,7 @@ procedure Unused(const A1);
procedure Unused(const A1, A2); procedure Unused(const A1, A2);
procedure Unused(const A1, A2, A3); procedure Unused(const A1, A2, A3);
var var
{@@ Default value for the screen pixel density (pixels per inch). Is needed {@@ Default value for the screen pixel density (pixels per inch). Is needed
for conversion of distances to pixels} for conversion of distances to pixels}
@ -952,6 +954,9 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat; function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = '') : string; const AFormatSettings: TFormatSettings; AFormatString: String = '') : string;
var
i, j: Integer;
Unwanted: set of ansichar;
begin begin
case ANumberFormat of case ANumberFormat of
nfShortDateTime: nfShortDateTime:
@ -977,9 +982,34 @@ begin
if pos('a', lowercase(AFormatSettings.LongTimeFormat)) = 0 then if pos('a', lowercase(AFormatSettings.LongTimeFormat)) = 0 then
Result := AddAMPM(Result, AFormatSettings); Result := AddAMPM(Result, AFormatSettings);
end; end;
nfDayMonth, // --> dd/mmm
nfMonthYear: // --> mmm/yy
begin
Result := AFormatSettings.ShortDateFormat;
case ANumberFormat of
nfDayMonth:
unwanted := ['y', 'Y'];
nfMonthYear:
unwanted := ['d', 'D'];
end;
for i:=Length(Result) downto 1 do
if Result[i] in unwanted then Delete(Result, i, 1);
while not (Result[1] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do
Delete(Result, 1, 1);
while not (Result[Length(Result)] in (['m', 'M', 'd', 'D', 'y', 'Y'] - unwanted)) do
Delete(Result, Length(Result), 1);
i := 1;
while not (Result[i] in ['m', 'M']) do inc(i);
j := i;
while (j <= Length(Result)) and (Result[j] in ['m', 'M']) do inc(j);
while (j - i < 3) do begin
Insert(Result[i], Result, j);
inc(j);
end;
end;
nfTimeInterval: // --> [h]:nn:ss nfTimeInterval: // --> [h]:nn:ss
if AFormatString = '' then if AFormatString = '' then
Result := '[h]:mm:ss' Result := '[h]:nn:ss'
else else
Result := AddIntervalBrackets(AFormatString); Result := AddIntervalBrackets(AFormatString);
end; end;
@ -1115,7 +1145,8 @@ begin
if ACurrencySymbol <> '' then begin if ACurrencySymbol <> '' then begin
Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';' Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';'
+ IfThen(negRed and (ADialect = nfdExcel), '[red]', '') + IfThen(negRed, '[red]', '')
// + IfThen(negRed and (ADialect = nfdExcel), '[red]', '')
+ Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';' + Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';'
+ Format(p, ['0'+decs, ACurrencySymbol]); + Format(p, ['0'+decs, ACurrencySymbol]);
end end
@ -1343,88 +1374,75 @@ end;
@param ANumerator (out) Numerator of the best approximating fraction @param ANumerator (out) Numerator of the best approximating fraction
@param ADenominator (out) Denominator of the best approximating fraction @param ADenominator (out) Denominator of the best approximating fraction
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer; procedure FloatToFraction(AValue, APrecision: Double;
out ANumerator, ADenominator: Integer); AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: Int64);
// "Stern-Brocot-Tree" // Uses method of continued fractions, adapted version from a function in
// Original from : http://stackoverflow.com/questions/5124743/algorithm-for-simplifying-decimal-to-fractions // Bart Broersma's fractions.pp unit:
// Procedure adapted by forum user "circular": http://forum.lazarus.freepascal.org/index.php/topic,27805.msg172372.html#msg172372 // http://svn.code.sf.net/p/flyingsheep/code/trunk/ConsoleProjecten/fractions/
const
MaxInt64 = High(Int64);
MinInt64 = Low(Int64);
var var
n: Integer; H1, H2, K1, K2, A, NewA, tmp, prevH1, prevK1: Int64;
lower_n, lower_d, upper_n, upper_d, middle_n, middle_d: Integer; B, diff, test, eps: Double;
isNeg: Boolean; Found, PendingOverflow: Boolean;
backup_num, backup_denom: Integer; i: Integer = 0;
newResult_num, newResult_denom: Integer;
EPS: Double;
begin begin
EPS := 0.01 / AMaxDenominator; Assert((APrecision > 0) and (APrecision < 1));
isNeg := AValue < 0; if (AValue > MaxInt64) or (AValue < MinInt64) then
if isNeg then raise Exception.Create('Range error');
AValue := -AValue;
n := Trunc(AValue); if abs(AValue) < 0.5 / AMaxDenominator then
newResult_num := round(AValue);
newResult_denom := 1;
if isNeg then newResult_num := -newResult_num;
backup_num := newResult_num;
backup_denom := newResult_denom;
AValue := AValue - n;
// Lower fraction is 0/1
lower_n := 0;
lower_d := 1;
// Upper fraction is 1/1
upper_n := 1;
upper_d := 1;
while true do
begin begin
if abs(newResult_num/newResult_denom - n - AValue) < ANumerator := 0;
abs(backup_num/backup_denom - n - AValue) ADenominator := AMaxDenominator;
then begin
backup_num := newResult_num;
backup_denom := newResult_denom;
end;
// middle fraction is (lower_n + upper_n) / (lower_d + upper_d)
middle_n := lower_n + upper_n;
middle_d := lower_d + upper_d;
newResult_num := n * middle_d + middle_n;
newResult_denom := middle_d;
// newResult.Normalize;
if (newResult_num > AMaxNumerator) or (newResult_denom > AMaxDenominator)
then begin
ANumerator := backup_num;
ADenominator := backup_denom;
exit; exit;
end; end;
if isNeg then newResult_num := -newResult_num; H1 := 1;
H2 := 0;
K1 := 0;
K2 := 1;
B := AValue;
NewA := Round(Floor(B));
prevH1 := H1;
prevK1 := K1;
repeat
inc(i);
A := NewA;
tmp := H1;
H1 := A * H1 + H2;
H2 := tmp;
tmp := K1;
K1 := A * K1 + K2;
K2 := tmp;
test := H1/K1;
diff := test - AValue;
if (abs(diff) < APrecision) then
break;
if (abs(H1) > AMaxNumerator) or (abs(K1) > AMaxDenominator) then
begin
H1 := prevH1;
K1 := prevK1;
break;
end;
if (Abs(B - A) < 1E-30) then
B := 1E30 //happens when H1/K1 exactly matches Value
else
B := 1 / (B - A);
PendingOverFlow := (B * H1 + H2 > MaxInt64) or
(B * K1 + K2 > MaxInt64) or
(B > MaxInt64);
if not PendingOverflow then
NewA := Round(Floor(B));
prevH1 := H1;
prevK1 := K1;
until PendingOverflow;
ANumerator := H1;
ADenominator := K1;
end;
// AValue + EPS < middle
if middle_d * (AValue + EPS) < middle_n then
begin
// middle is our new upper
upper_n := middle_n;
upper_d := middle_d;
end else
// middle < AValue - EPS
if middle_n < (AValue - EPS) * middle_d then
begin
// middle is our new lower
lower_n := middle_n;
lower_d := middle_d;
end else
// middle is our best fraction
begin
ANumerator := newResult_num;
ADenominator := newResult_denom;
exit;
end;
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Creates a long date format string out of a short date format string. Creates a long date format string out of a short date format string.
@ -2330,6 +2348,7 @@ begin
FillChar(AValue, SizeOf(AValue), 0); FillChar(AValue, SizeOf(AValue), 0);
AValue.BorderStyles := DEFAULT_BORDERSTYLES; AValue.BorderStyles := DEFAULT_BORDERSTYLES;
AValue.Background := EMPTY_FILL; AValue.Background := EMPTY_FILL;
AValue.NumberFormatIndex := -1; // GENERAL format not contained in NumFormatList
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -2373,6 +2392,725 @@ begin
end; end;
{@@ ----------------------------------------------------------------------------
Converts a floating point number to a string as determined by the specified
number format parameters
-------------------------------------------------------------------------------}
function ConvertFloatToStr(AValue: Double; AParams: TsNumFormatParams;
AFormatSettings: TFormatSettings): String;
var
fs: TFormatSettings absolute AFormatSettings;
sidx: Integer;
section: TsNumFormatSection;
i, p, q, el, numEl: Integer;
isNeg: Boolean;
yr, mon, day, hr, min, sec, ms: Word;
frInt, frNum, frDenom: Int64;
maxNum, maxDenom: Int64;
decsZero, decsOpt, decsSpace: Integer;
digitsZero, digitsOpt, digitsSpace: Integer;
numDigitsZero, numDigitsOpt, numDigitsSpace: Integer;
denomDigitsZero, denomDigitsOpt, denomDigitsSpace: Integer;
expSign: Char;
expDigits: Integer;
numStr, s: String;
terminatingTokens: set of TsNumFormatToken;
intTokens: set of TsNumFormatToken;
decsTokens: set of TsNumFormatToken;
fracNumTokens: set of TsNumFormatToken;
fracDenomTokens: set of TsNumFormatToken;
function FixIntPart(AValue: Double; AddThousandSeparator: Boolean;
AZeroCount, AOptCount, ASpaceCount: Integer): String;
var
j: Integer;
isNeg: Boolean;
begin
isNeg := AValue < 0;
Result := IntToStr(trunc(abs(AValue)));
if (AZeroCount = 0) and (ASpaceCount = 0) then
begin
if Result = '0' then
Result := '';
end else
if (AZeroCount > 0) and (ASpaceCount = 0) then
begin
while Length(Result) < AZeroCount do
Result := '0' + Result;
end else
if (AZeroCount = 0) and (ASpaceCount > 0) then
begin
while Length(Result) < AZeroCount do
Result := ' ' + Result;
end else
begin
while Length(Result) < AZeroCount do
Result := '0' + Result;
while Length(Result) < AZeroCount + ASpaceCount do
Result := ' ' + Result;
end;
if AddThousandSeparator then
begin
j := Length(Result)-2;
while (j > 0) do
begin
Insert(fs.ThousandSeparator, Result, j);
dec(j, 3);
end;
end;
if isNeg then
Result := '-' + Result;
end;
function FixDecimals(AValue: Double;
AZeroCount, AOptCount, ASpaceCount: Integer): String;
var
j, decs: Integer;
begin
if AZeroCount + AOptCount + ASpaceCount = 0 then
begin
Result := ''; // no decimals in this case
exit;
end;
Result := FloatToStrF(abs(frac(AValue)), ffFixed, 20, AZeroCount + AOptCount + ASpaceCount, fs);
Delete(Result, 1, 2); // Delete '0.' to extract the decimals
decs := Length(Result);
while decs < AZeroCount do begin
Result := Result + '0';
inc(decs);
end;
j := Length(Result);
while (Result[j] = '0') and (decs > AZeroCount) and (( decsOpt > 0) or (decsSpace > 0)) do
begin
if decsOpt > 0 then
begin
Delete(Result, j, 1);
dec(decs);
dec(decsOpt);
end else
if decsSpace > 0 then
begin
Result[j] := ' ';
dec(decs);
dec(decsOpt);
end;
dec(j);
end;
if Result <> '' then
Result := fs.DecimalSeparator + Result;
end;
procedure InvalidFormat;
var
fmtStr: String;
begin
fmtStr := AParams.NumFormatStr[nfdExcel];
raise Exception.CreateFmt(rsIsNoValidNumberFormatString, [fmtStr]);
end;
begin
Result := '';
if IsNaN(AValue) then
exit;
if AParams = nil then
begin
Result := FloatToStrF(AValue, ffGeneral, 20, 20, fs);
exit;
end;
sidx := 0;
if (AValue < 0) and (Length(AParams.Sections) > 1) then
sidx := 1;
if (AValue = 0) and (Length(AParams.Sections) > 2) then
sidx := 2;
isNeg := (AValue < 0);
if (sidx > 0) and isNeg then
AValue := -AValue;
section := AParams.Sections[sidx];
numEl := Length(section.Elements);
terminatingTokens := [nftSpace, nftText, nftPercent, nftCurrSymbol, nftSignBracket,
nftEscaped];
intTokens := [nftIntOptDigit, nftIntZeroDigit, nftIntSpaceDigit];
decsTokens := [nftZeroDecs, nftOptDecs, nftSpaceDecs];
fracNumTokens := [nftFracNumOptDigit, nftFracNumZeroDigit, nftFracNumSpaceDigit];
fracDenomTokens := [nftFracDenomOptDigit, nftFracDenomZeroDigit, nftFracDenomSpaceDigit];
if nfkPercent in section.Kind then
AValue := AValue * 100.0;
if nfkTime in section.Kind then
DecodeTime(AValue, hr, min, sec, ms);
if nfkDate in section.Kind then
DecodeDate(AValue, yr, mon, day);
el := 0;
while (el < numEl) do begin
case section.Elements[el].Token of
nftIntOptDigit,
nftIntZeroDigit,
nftIntSpaceDigit:
begin
// Decimals
decsZero := 0;
decsSpace := 0;
decsOpt := 0;
// Integer part of number format
digitsZero := 0;
digitsSpace := 0;
digitsOpt := 0;
i := el;
while (i < numEl) and (section.Elements[i].Token in intTokens) do
begin
case section.Elements[i].Token of
nftIntOptDigit : inc(digitsOpt, section.Elements[i].IntValue);
nftIntZeroDigit : inc(digitsZero, section.Elements[i].IntValue);
nftIntSpaceDigit: inc(digitsSpace, section.Elements[i].IntValue);
end;
inc(i);
end;
{ These are the cases that can occur:
(1) number w/ decimals ---> end of line
(2) number w/ decimals --> space, terminating tokens
(3) number w/ decimals --> exponent
(4) number w/o decimals --> end of line
(5) number w/o decimals --> space, terminating tokens
(6) number w/o decimals --> space --> numerator --> '/' --> denominator
(7) number w/o decimals --> exponent
}
// Integer only, followed by end-of-line (case 4)
if (i = numEl) or (section.Elements[i].Token in (terminatingTokens - [nftSpace])) then
begin
Result := Result + FixIntPart(AValue, false, digitsZero, digitsOpt, digitsSpace);
el := i;
Continue;
end;
if (i < numEl) then
begin
// Check for Exponent (format '0E+00', case 7)
if (section.Elements[i].Token = nftExpChar) then begin
inc(i);
if (i < numEl) and (section.Elements[i].Token = nftExpSign) then begin
expSign := section.Elements[i].TextValue[1];
inc(i);
if (i < numEl) and (section.Elements[i].Token = nftExpDigits) then
expDigits := section.Elements[i].IntValue
else
InvalidFormat;
end else
InvalidFormat;
numStr := FormatFloat('0E'+expSign+DupeString('0', expDigits), AValue, fs);
p := pos('e', Lowercase(numStr));
s := copy(numStr, p, Length(numStr)); // E part of the number string
numStr := copy(numStr, 1, p-1); // Mantissa of the number string
Result := Result
+ FixIntPart(StrToFloat(numStr, fs), false, digitsZero, digitsOpt, digitsSpace) + s;
el := i;
Continue;
end;
// Check for decimal separator
if (section.Elements[i].Token = nftDecSep) then
begin
// Yes, cases (1) or (2) -- get decimal specification
decsZero := 0;
decsSpace := 0;
decsOpt := 0;
inc(i);
while (i < numEl) and (section.Elements[i].Token in decsTokens) do
begin
case section.Elements[i].Token of
nftZeroDecs : inc(decsZero, section.Elements[i].IntValue);
nftOptDecs : inc(decsOpt, section.Elements[i].IntValue);
nftSpaceDecs: inc(decsSpace, section.Elements[i].IntValue);
end;
inc(i);
end;
// Simple decimal number (nfFixed), followed by eol (case 1)
if (i = numEl) then
begin
// Simple decimal number (nfFixed) (case 1)
Result := Result
+ FixIntPart(AValue, false, digitsZero, digitsOpt, digitsSpace)
+ FixDecimals(AValue, decsZero, decsOpt, decsSpace);
el := i;
Continue;
end;
// Check for exponential format (case 3)
if (section.Elements[i].Token = nftExpChar) then
begin
inc(i);
if (i < numEl) and (section.Elements[i].Token = nftExpSign) then begin
expSign := section.Elements[i].TextValue[1];
inc(i);
if (i < numEl) and (section.Elements[i].Token = nftExpDigits) then
expDigits := section.Elements[i].IntValue
else
InvalidFormat;
end else
InvalidFormat;
numStr := FloatToStrF(AValue, ffExponent, decsZero+decsOpt+decsSpace+1, expDigits, fs);
if (abs(AValue) >= 1.0) and (expSign = '-') then
Delete(numStr, pos('+', numStr), 1);
p := pos('e', Lowercase(numStr));
s := copy(numStr, p, Length(numStr)); // E part of the number string
numStr := copy(numStr, 1, p-1); // Mantissa of the number string
q := pos(fs.DecimalSeparator, numStr);
Result := Result
+ FixIntPart(StrToFloat(numStr, fs), false, digitsZero, digitsOpt, digitsSpace);
if q = 0 then
Result := Result + s
else
Result := Result + FixDecimals(StrToFloat(numStr, fs), decsZero, decsOpt, decsSpace) + s;
el := i;
Continue;
end;
end;
// Check for fraction (case 6)
if (section.Elements[i].Token = nftSpace) or
((section.Elements[i].Token = nftText) and (section.Elements[i].TextValue = ' ')) then
begin
inc(i);
if (i < numEl) and (section.Elements[i].Token in fracNumTokens) then
begin
// Process numerator
numDigitsZero := 0;
numDigitsSpace := 0;
numDigitsOpt := 0;
while (i < numEl) and (section.Elements[i].Token in fracNumTokens) do
begin
case section.Elements[i].Token of
nftFracNumOptDigit : inc(numDigitsOpt, section.Elements[i].IntValue);
nftFracNumZeroDigit : inc(numDigitsZero, section.Elements[i].IntValue);
nftFracNumSpaceDigit: inc(numDigitsSpace, section.Elements[i].IntValue);
end;
inc(i);
end;
// Skip spaces before '/' symbol, find '/'
while (i < numEl) and (section.Elements[i].Token <> nftFracSymbol) do
inc(i);
// Skip spaces after '/' symbol, find denominator
while (i < numEl) and not (section.Elements[i].Token in fracDenomTokens) do
inc(i);
// Process denominator
denomDigitsZero := 0;
denomDigitsOpt := 0;
denomDigitsSpace := 0;
while (i < numEl) and (section.Elements[i].Token in fracDenomTokens) do
begin
case section.Elements[i].Token of
nftFracDenomOptDigit : inc(denomDigitsOpt, section.Elements[i].IntValue);
nftFracDenomZeroDigit : inc(denomDigitsZero, section.Elements[i].IntValue);
nftFracDenomSpaceDigit: inc(denomDigitsSpace, section.Elements[i].IntValue);
end;
inc(i);
end;
// Calculate fraction
maxNum := Round(IntPower(10, numDigitsOpt+numDigitsZero+numDigitsSpace));
maxDenom := Round(IntPower(10, denomDigitsOpt+denomDigitsZero+denomDigitsSpace));
if (digitsOpt = 0) and (digitsSpace = 0) and (digitsZero = 0) then
begin
frint := 0;
s := '';
end else begin
frint := trunc(abs(AValue));
AValue := frac(abs(AValue));
s := IntToStr(frInt);
end;
FloatToFraction(abs(AValue), 0.1/maxdenom, maxnum, maxdenom, frnum, frdenom);
if frInt > 0 then
Result := Result +
FixIntPart(frInt, false, digitsZero, digitsOpt, digitsSpace);
Result := Result +
' ' +
FixIntPart(frnum, false, numDigitsZero, numDigitsOpt, numDigitsSpace) +
'/' +
FixIntPart(frdenom, false, denomDigitsZero, denomDigitsOpt, denomDigitsSpace);
if isNeg then
Result := '-' + Result;
el := i;
Continue;
end;
end;
// Simple decimal number (nfFixed), followed by terminating tokens (case 5)
if (i < numEl) and (section.Elements[i].Token in terminatingTokens) then
begin
// Simple decimal number (nfFixed) (case 1)
Result := Result
+ FixIntPart(AValue, false, digitsZero, digitsOpt, digitsSpace)
+ FixDecimals(AValue, decsZero, decsOpt, decsSpace);
el := i;
Continue;
end;
end;
end;
nftIntTh: // Format with thousand separator
begin
terminatingTokens := [nftSpace, nftText, nftPercent, nftCurrSymbol,
nftSignBracket, nftEscaped];
decsTokens := [nftZeroDecs, nftOptDecs, nftSpaceDecs];
decsZero := 0;
decsSpace := 0;
decsOpt := 0;
digitsZero := section.Elements[el].IntValue;
i := el+1;
if (i < numEl) and (section.Elements[i].Token = nftDecSep) then
begin
inc(i);
while (i < numEl) and (section.Elements[i].Token in [nftZeroDecs, nftOptDecs, nftSpaceDecs]) do
begin
case section.Elements[i].Token of
nftZeroDecs : inc(decsZero, section.Elements[i].IntValue);
nftOptDecs : inc(decsOpt, section.Elements[i].IntValue);
nftSpaceDecs: inc(decsSpace, section.Elements[i].IntValue);
end;
inc(i);
end;
end;
Result := Result + FixIntPart(AValue, true, digitsZero, 0, 0)
+ FixDecimals(AValue, decsZero, DecsOpt, decsSpace);
el := i;
Continue;
end;
nftFracNumZeroDigit,
nftFracNumOptDigit,
nftFracNumSpaceDigit:
begin
// Process numerator
numDigitsZero := 0;
numDigitsSpace := 0;
numDigitsOpt := 0;
i := el;
while (i < numEl) and (section.Elements[i].Token in fracNumTokens) do
begin
case section.Elements[i].Token of
nftFracNumOptDigit : inc(numDigitsOpt, section.Elements[i].IntValue);
nftFracNumZeroDigit : inc(numDigitsZero, section.Elements[i].IntValue);
nftFracNumSpaceDigit: inc(numDigitsSpace, section.Elements[i].IntValue);
end;
inc(i);
end;
// Skip spaces before '/' symbol, find '/'
while (i < numEl) and (section.Elements[i].Token <> nftFracSymbol) do
inc(i);
// Skip spaces after '/' symbol, find denominator
while (i < numEl) and not (section.Elements[i].Token in fracDenomTokens) do
inc(i);
// Process denominator
denomDigitsZero := 0;
denomDigitsOpt := 0;
denomDigitsSpace := 0;
while (i < numEl) and (section.Elements[i].Token in fracDenomTokens) do
begin
case section.Elements[i].Token of
nftFracDenomOptDigit : inc(denomDigitsOpt, section.Elements[i].IntValue);
nftFracDenomZeroDigit : inc(denomDigitsZero, section.Elements[i].IntValue);
nftFracDenomSpaceDigit: inc(denomDigitsSpace, section.Elements[i].IntValue);
end;
inc(i);
end;
// Calculate fraction
maxNum := Round(IntPower(10, numDigitsOpt+numDigitsZero+numDigitsSpace));
maxDenom := Round(IntPower(10, denomDigitsOpt+denomDigitsZero+denomDigitsSpace));
FloatToFraction(abs(AValue), 0.1/maxdenom, MaxInt, maxdenom, frnum, frdenom);
if isNeg then
Result := Result + '-';
Result := Result +
FixIntPart(frnum, false, numDigitsZero, numDigitsOpt, numDigitsSpace) +
'/' +
FixIntPart(frdenom, false, denomDigitsZero, denomDigitsOpt, denomDigitsSpace);
el := i-1;
end;
nftSpace:
Result := Result + ' ';
nftText:
Result := Result + section.Elements[el].TextValue;
nftEscaped:
begin
inc(el);
if el < Length(section.Elements) then
Result := Result + section.Elements[el].TextValue;
end;
nftDateTimeSep:
case section.Elements[el].TextValue of
'/': Result := Result + fs.DateSeparator;
':': Result := Result + fs.TimeSeparator;
else Result := Result + section.Elements[el].TextValue;
end;
nftDecSep:
Result := Result + fs.DecimalSeparator;
nftThSep:
Result := Result + fs.ThousandSeparator;
nftSign, nftSignBracket, nftCurrSymbol:
Result := Result + section.Elements[el].TextValue;
nftPercent:
Result := Result + '%';
nftYear:
case section.Elements[el].IntValue of
1,
2: Result := Result + IfThen(yr mod 100 < 10, '0'+IntToStr(yr mod 100), IntToStr(yr mod 100));
4: Result := Result + IntToStr(yr);
end;
nftMonth:
case section.Elements[el].IntValue of
1: Result := Result + IntToStr(mon);
2: Result := Result + IfThen(mon < 10, '0'+IntToStr(mon), IntToStr(mon));
3: Result := Result + fs.ShortMonthNames[mon];
4: Result := Result + fs.LongMonthNames[mon];
end;
nftDay:
case section.Elements[el].IntValue of
1: result := result + IntToStr(day);
2: result := Result + IfThen(day < 10, '0'+IntToStr(day), IntToStr(day));
3: Result := Result + fs.ShortDayNames[day];
4: Result := Result + fs.LongDayNames[day];
end;
nftHour:
begin
if section.Elements[el].IntValue < 0 then // This case is for nfTimeInterval
s := IntToStr(Int64(hr) + trunc(AValue) * 24)
else
if section.Elements[el].TextValue = 'AM' then // This tag is set in case of AM/FM format
begin
hr := hr mod 12;
if hr = 0 then hr := 12;
s := IntToStr(hr)
end else
s := IntToStr(hr);
if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then
s := '0' + s;
Result := Result + s;
end;
nftMinute:
begin
if section.Elements[el].IntValue < 0 then // case for nfTimeInterval
s := IntToStr(int64(min) + trunc(AValue) * 24 * 60)
else
s := IntToStr(min);
if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then
s := '0' + s;
Result := Result + s;
end;
nftSecond:
begin
if section.Elements[el].IntValue < 0 then // case for nfTimeInterval
s := IntToStr(Int64(sec) + trunc(AValue) * 24 * 60 * 60)
else
s := IntToStr(sec);
if (abs(section.Elements[el].IntValue) = 2) and (Length(s) = 1) then
s := '0' + s;
Result := Result + s;
end;
nftMilliseconds:
case section.Elements[el].IntValue of
1: Result := Result + IntToStr(ms div 100);
2: Result := Result + Format('%02d', [ms div 10]);
3: Result := Result + Format('%03d', [ms]);
end;
nftAMPM:
begin
s := section.Elements[el].TextValue;
if lowercase(s) = 'ampm' then
s := IfThen(frac(AValue) < 0.5, fs.TimeAMString, fs.TimePMString)
else
begin
i := pos('/', s);
if i > 0 then
s := IfThen(frac(AValue) < 0.5, copy(s, 1, i-1), copy(s, i+1, Length(s)))
else
s := IfThen(frac(AValue) < 0.5, 'AM', 'PM');
end;
Result := Result + s;
end;
end;
inc(el);
end;
(*
section := AParams.Sections[sidx];
nf := section.NumFormat;
case nf of
nfFixed:
Result := FloatToStrF(AValue, ffFixed, 20, section.Decimals, fs);
nfFixedTh:
Result := FloatToStrF(AValue, ffNumber, 20, section.Decimals, fs);
nfPercentage:
Result := FloatToStrF(AValue*100.0, ffFixed, 20, section.Decimals, fs) + '%';
nfExp:
begin
elem := High(Section.Elements);
expDigits := 2;
if section.Elements[elem].Token = nftExpDigits then
expDigits := section.Elements[elem].IntValue;
Result := FloatToStrF(AValue, ffExponent, section.Decimals+1, expDigits, fs);
if (abs(AValue) >= 1.0) and (
((section.Elements[elem-1].Token <> nftExpSign) or (section.Elements[elem-1].TextValue = '-')) )
then
Delete(Result, pos('+', Result), 1);
end;
nfFraction:
begin
AValue := abs(AValue);
if section.FracInt = 0 then
frint := 0
else begin
frint := trunc(AValue);
AValue := frac(AValue);
end;
maxNum := Round(IntPower(10, section.FracNumerator));
maxDenom := Round(IntPower(10, section.FracDenominator));
FloatToFraction(AValue, maxnum, maxdenom, frnum, frdenom);
Result := IntToStr(frnum) + '/' + IntToStr(frdenom);
if frint <> 0 then
Result := IntToStr(frint) + ' ' + result;
if isNeg then Result := '-' + Result;
end;
nfCurrency,
nfCurrencyRed:
begin
valueDone := false;
for elem := 0 to High(section.Elements) do
case section.Elements[elem].Token of
nftSpace:
Result := Result + ' ';
nftText:
Result := Result + section.Elements[elem].TextValue;
nftCurrSymbol:
Result := Result + section.CurrencySymbol;
nftSign:
Result := Result + '-';
nftSignBracket:
Result := Result + section.Elements[elem].TextValue;
nftDigit, nftOptDigit:
if not ValueDone then
begin
Result := Result + FloatToStrF(AValue, ffNumber, 20, section.Decimals, fs);
valueDone := true;
end;
end;
end;
nfShortDate, nfLongDate, nfShortTime, nfLongTime, nfShortDateTime,
nfShortTimeAM, nfLongTimeAM:
begin
DecodeDate(trunc(AValue), yr, mon, day);
DecodeTime(frac(AValue), hr, min, sec, ms);
elem := 0;
while elem < Length(section.Elements) do
begin
case section.Elements[elem].Token of
nftSpace:
Result := Result + ' ';
nftText:
Result := Result + section.Elements[elem].TextValue;
nftYear:
case section.Elements[elem].IntValue of
1,
2: Result := Result + IfThen(yr < 10, '0'+IntToStr(yr), IntToStr(yr));
4: Result := Result + IntToStr(yr);
end;
nftMonth:
case section.Elements[elem].IntValue of
1: Result := Result + IntToStr(mon);
2: Result := Result + IfThen(mon < 10, '0'+IntToStr(mon), IntToStr(mon));
3: Result := Result + fs.ShortMonthNames[mon];
4: Result := Result + fs.LongMonthNames[mon];
end;
nftDay:
case section.Elements[elem].IntValue of
1: result := result + IntToStr(day);
2: result := Result + IfThen(day < 10, '0'+IntToStr(day), IntToStr(day));
3: Result := Result + fs.ShortDayNames[day];
4: Result := Result + fs.LongDayNames[day];
end;
nftHour:
begin
if section.Elements[elem].IntValue < 0 then
hr := hr + trunc(AValue) * 24;
case abs(section.Elements[elem].IntValue) of
1: Result := Result + IntToStr(hr);
2: Result := Result + IfThen(hr < 10, '0'+IntToStr(hr), IntToStr(hr));
end;
end;
nftMinute:
begin
if section.Elements[elem].IntValue < 0 then
min := min + trunc(AValue) * 24 * 60;
case abs(section.Elements[elem].IntValue) of
1: Result := Result + IntToStr(min);
2: Result := Result + IfThen(min < 10, '0'+IntToStr(min), IntToStr(min));
end;
end;
nftSecond:
begin
if section.Elements[elem].IntValue < 0 then
sec := sec + trunc(AValue) * 24 * 60 * 60;
case abs(section.Elements[elem].IntValue) of
1: Result := Result + IntToStr(sec);
2: Result := Result + IfThen(sec < 10, '0'+IntToStr(sec), IntToStr(sec));
end;
end;
nftDecSep:
Result := Result + fs.DecimalSeparator;
nftMilliseconds:
case section.Elements[elem].IntValue of
1: Result := Result + IntToStr(ms div 100);
2: Result := Result + Format('%02d', [ms div 10]);
3: Result := Result + Format('%03d', [ms]);
end;
nftDateTimeSep:
case section.Elements[elem].TextValue of
'/': Result := Result + fs.DateSeparator;
':': Result := Result + fs.TimeSeparator;
else Result := Result + section.Elements[elem].TextValue;
end;
nftAMPM:
if frac(AValue) <= 0.5 then
Result := Result + fs.TimeAMString
else
Result := Result + fs.TimePMString;
nftEscaped:
begin
inc(elem);
Result := Result + section.Elements[elem].TextValue;
end;
end;
inc(elem);
end;
end;
end;*)
end;
{ Modifying colors } { Modifying colors }
{ Next function are copies of GraphUtils to avoid a dependence on the Graphics unit. } { Next function are copies of GraphUtils to avoid a dependence on the Graphics unit. }

View File

@ -230,8 +230,14 @@ begin
SollNumberStrings[i, 5] := FormatFloat('0.00E+00', SollNumbers[i], fs); SollNumberStrings[i, 5] := FormatFloat('0.00E+00', SollNumbers[i], fs);
SollNumberStrings[i, 6] := FormatFloat('0', SollNumbers[i]*100, fs) + '%'; SollNumberStrings[i, 6] := FormatFloat('0', SollNumbers[i]*100, fs) + '%';
SollNumberStrings[i, 7] := FormatFloat('0.00', SollNumbers[i]*100, fs) + '%'; SollNumberStrings[i, 7] := FormatFloat('0.00', SollNumbers[i]*100, fs) + '%';
{
SollNumberStrings[i, 8] := FormatCurr('"€"#,##0;("€"#,##0)', SollNumbers[i], fs); SollNumberStrings[i, 8] := FormatCurr('"€"#,##0;("€"#,##0)', SollNumbers[i], fs);
SollNumberStrings[i, 9] := FormatCurr('"€"#,##0.00;("€"#,##0.00)', SollNumbers[i], fs); SollNumberStrings[i, 9] := FormatCurr('"€"#,##0.00;("€"#,##0.00)', SollNumbers[i], fs);
}
// Don't use FormatCurr for the next two cases because is reports the sign of
// very small numbers inconsistenly with the spreadsheet applications.
SollNumberStrings[i, 8] := FormatFloat('"€"#,##0;("€"#,##0)', SollNumbers[i], fs);
SollNumberStrings[i, 9] := FormatFloat('"€"#,##0.00;("€"#,##0.00)', SollNumbers[i], fs);
end; end;
// Date/time values // Date/time values

View File

@ -51,6 +51,8 @@ type
// Test buffered stream // Test buffered stream
procedure TestReadBufStream; procedure TestReadBufStream;
procedure TestWriteBufStream; procedure TestWriteBufStream;
// Test fractions
procedure FractionTest;
end; end;
implementation implementation
@ -395,6 +397,26 @@ begin
CheckEquals(s, GetCellString(r, c, flags)); CheckEquals(s, GetCellString(r, c, flags));
end; end;
procedure TSpreadInternalTests.FractionTest;
const
N = 300;
DIGITS = 3;
var
i, j: Integer;
sollNum, sollDenom: Integer;
sollValue: Double;
actualNum, actualDenom: Int64;
begin
sollNum := 1;
for j := 1 to N do
begin
sollDenom := j;
sollValue := StrToFloat(FormatFloat('0.00000', sollNum/sollDenom));
FloatToFraction(sollvalue, 0.1/DIGITS, DIGITS, DIGITS, actualNum, actualDenom);
if actualDenom > sollDenom then
fail(Format('Conversion error: approximated %d/%d turns to %d/%d', [sollNum, sollDenom, actualNum, actualDenom]));
end;
end;
procedure TSpreadInternalTests.SetUp; procedure TSpreadInternalTests.SetUp;
begin begin

View File

@ -53,10 +53,12 @@
<Unit2> <Unit2>
<Filename Value="stringtests.pas"/> <Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="numberstests.pas"/> <Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="numberstests"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="manualtests.pas"/> <Filename Value="manualtests.pas"/>
@ -69,6 +71,7 @@
<Unit6> <Unit6>
<Filename Value="internaltests.pas"/> <Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="formattests.pas"/> <Filename Value="formattests.pas"/>
@ -91,6 +94,7 @@
<Unit11> <Unit11>
<Filename Value="numformatparsertests.pas"/> <Filename Value="numformatparsertests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="numformatparsertests"/>
</Unit11> </Unit11>
<Unit12> <Unit12>
<Filename Value="rpnformulaunit.pas"/> <Filename Value="rpnformulaunit.pas"/>

View File

@ -405,10 +405,15 @@ var
r1, c1, r2, c2: Cardinal; r1, c1, r2, c2: Cardinal;
isHeader: Boolean; isHeader: Boolean;
borders: TsCellBorders; borders: TsCellBorders;
fs: TFormatSettings;
begin begin
FWorksheet := Workbook.GetFirstWorksheet(); FWorksheet := Workbook.GetFirstWorksheet();
FWorksheet.UpdateCaches; FWorksheet.UpdateCaches;
fs := FWorksheet.FormatSettings;
fs.DecimalSeparator := '.';
fs.ThousandSeparator := ',';
AStrings.Add('<!-- generated by fpspreadsheet -->'); AStrings.Add('<!-- generated by fpspreadsheet -->');
// Show/hide grid lines // Show/hide grid lines
@ -442,7 +447,7 @@ begin
for j := 0 to FWorksheet.GetLastColIndex do for j := 0 to FWorksheet.GetLastColIndex do
begin begin
lCell := FWorksheet.FindCell(i, j); lCell := FWorksheet.FindCell(i, j);
lCurStr := FWorksheet.ReadAsUTF8Text(lCell); lCurStr := FWorksheet.ReadAsUTF8Text(lCell, fs);
// if lCurStr = '' then lCurStr := '&nbsp;'; // if lCurStr = '' then lCurStr := '&nbsp;';
// Check for invalid characters // Check for invalid characters
@ -487,9 +492,7 @@ begin
if fssItalic in lFont.Style then lCurStr := '<i>' + lCurStr + '</i>'; if fssItalic in lFont.Style then lCurStr := '<i>' + lCurStr + '</i>';
if fssUnderline in lFont.Style then lCurStr := '<u>' + lCurStr + '</u>'; if fssUnderline in lFont.Style then lCurStr := '<u>' + lCurStr + '</u>';
if fssStrikeout in lFont.Style then lCurStr := '<s>' + lCurStr + '</s>'; if fssStrikeout in lFont.Style then lCurStr := '<s>' + lCurStr + '</s>';
end;{ else end;
if uffBold in lCurUsedFormatting then
lCurStr := '<b>' + lCurStr + '</b>';}
// Background color // Background color
if uffBackground in lCurUsedFormatting then if uffBackground in lCurUsedFormatting then

View File

@ -34,7 +34,7 @@ interface
uses uses
Classes, SysUtils, lconvencoding, Classes, SysUtils, lconvencoding,
fpsTypes, fpsNumFormat, fpspreadsheet, fpsUtils, xlscommon; fpsTypes, fpspreadsheet, fpsUtils, xlscommon;
const const
BIFF2_MAX_PALETTE_SIZE = 8; BIFF2_MAX_PALETTE_SIZE = 8;
@ -42,33 +42,21 @@ const
type type
{ TsBIFF2NumFormatList }
TsBIFF2NumFormatList = class(TsCustomNumFormatList)
protected
procedure AddBuiltinFormats; override;
public
constructor Create(AWorkbook: TsWorkbook);
procedure ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat); override;
function Find(ANumFormat: TsNumberFormat; ANumFormatStr: String): Integer; override;
end;
{ TsSpreadBIFF2Reader } { TsSpreadBIFF2Reader }
TsSpreadBIFF2Reader = class(TsSpreadBIFFReader) TsSpreadBIFF2Reader = class(TsSpreadBIFFReader)
private private
// WorkBookEncoding: TsEncoding;
FFont: TsFont; FFont: TsFont;
FPendingXFIndex: Word; FPendingXFIndex: Word;
protected protected
procedure CreateNumFormatList; override; procedure AddBuiltinNumFormats; override;
procedure ReadBlank(AStream: TStream); override; procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override; procedure ReadBool(AStream: TStream); override;
procedure ReadColWidth(AStream: TStream); procedure ReadColWidth(AStream: TStream);
procedure ReadDefRowHeight(AStream: TStream); procedure ReadDefRowHeight(AStream: TStream);
procedure ReadFont(AStream: TStream); procedure ReadFONT(AStream: TStream);
procedure ReadFontColor(AStream: TStream); procedure ReadFONTCOLOR(AStream: TStream);
procedure ReadFormat(AStream: TStream); override; procedure ReadFORMAT(AStream: TStream); override;
procedure ReadFormula(AStream: TStream); override; procedure ReadFormula(AStream: TStream); override;
procedure ReadInteger(AStream: TStream); procedure ReadInteger(AStream: TStream);
procedure ReadIXFE(AStream: TStream); procedure ReadIXFE(AStream: TStream);
@ -88,6 +76,7 @@ type
procedure ReadFromStream(AStream: TStream); override; procedure ReadFromStream(AStream: TStream); override;
end; end;
{ TsSpreadBIFF2Writer } { TsSpreadBIFF2Writer }
TsSpreadBIFF2Writer = class(TsSpreadBIFFWriter) TsSpreadBIFF2Writer = class(TsSpreadBIFFWriter)
@ -107,13 +96,12 @@ type
procedure WriteFormatCount(AStream: TStream); procedure WriteFormatCount(AStream: TStream);
procedure WriteIXFE(AStream: TStream; XFIndex: Word); procedure WriteIXFE(AStream: TStream; XFIndex: Word);
protected protected
procedure CreateNumFormatList; override; procedure AddBuiltinNumFormats; override;
procedure ListAllNumFormats; override; procedure ListAllNumFormats(ADialect: TsNumFormatDialect); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override; const AValue: Boolean; ACell: PCell); override;
// procedure WriteCodePage(AStream: TStream; AEncoding: TsEncoding); override;
procedure WriteCodePage(AStream: TStream; ACodePage: String); override; procedure WriteCodePage(AStream: TStream; ACodePage: String); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override; const AValue: TsErrorValue; ACell: PCell); override;
@ -121,19 +109,14 @@ type
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override; const AValue: double; ACell: PCell); override;
procedure WriteNumFormat(AStream: TStream; ANumFormatData: TsNumFormatData; procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
AListIndex: Integer); override; AFormatIndex: Integer); override;
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet; procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override; ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override; const AFormula: TsRPNFormula; ACell: PCell); override;
function WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word; override; function WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word; override;
{
procedure WriteRPNSharedFormulaLink(AStream: TStream; ACell: PCell;
var RPNLength: Word); override;
}
procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); override; procedure WriteRPNTokenArraySize(AStream: TStream; ASize: Word); override;
// procedure WriteSharedFormula(AStream: TStream; ACell: PCell); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteWindow1(AStream: TStream); override; procedure WriteWindow1(AStream: TStream); override;
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -176,7 +159,7 @@ var
implementation implementation
uses uses
Math, fpsStrings, fpsReaderWriter, fpsNumFormatParser; Math, fpsStrings, fpsReaderWriter;
const const
{ Excel record IDs } { Excel record IDs }
@ -268,113 +251,44 @@ type
end; end;
{ TsBIFF2NumFormatList } procedure InternalAddBuiltinNumFormats(AList: TStringList;
AFormatSettings: TFormatSettings; ADialect: TsNumFormatDialect);
constructor TsBIFF2NumFormatList.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
end;
{@@ ----------------------------------------------------------------------------
Prepares the list of built-in number formats. They are created in the default
dialect for FPC, they have to be converted to Excel syntax before writing.
Note that Excel2 expects them to be localized. This is something which has to
be taken account of in ConvertBeforeWriting.
-------------------------------------------------------------------------------}
procedure TsBIFF2NumFormatList.AddBuiltinFormats;
var var
fs: TFormatSettings; fs: TFormatSettings absolute AFormatSettings;
cs: string; cs: String;
begin begin
fs := FWorkbook.FormatSettings;
cs := fs.CurrencyString; cs := fs.CurrencyString;
AddFormat( 0, nfGeneral, ''); with AList do
AddFormat( 1, nfFixed, '0');
AddFormat( 2, nfFixed, '0.00');
AddFormat( 3, nfFixedTh, '#,##0');
AddFormat( 4, nfFixedTh, '#,##0.00');
AddFormat( 5, nfCurrency, Format('"%s"#,##0;("%s"#,##0)', [cs, cs]));
AddFormat( 6, nfCurrencyRed, Format('"%s"#,##0;[Red]("%s"#,##0)', [cs, cs]));
AddFormat( 7, nfCurrency, Format('"%s"#,##0.00;("%s"#,##0.00)', [cs, cs]));
AddFormat( 8, nfCurrencyRed, Format('"%s"#,##0.00;[Red]("%s"#,##0.00)', [cs, cs]));
AddFormat( 9, nfPercentage, '0%');
AddFormat(10, nfPercentage, '0.00%');
AddFormat(11, nfExp, '0.00E+00');
AddFormat(12, nfShortDate, fs.ShortDateFormat);
AddFormat(13, nfLongDate, fs.LongDateFormat);
AddFormat(14, nfCustom, 'd/mmm');
AddFormat(15, nfCustom, 'mmm/yy');
AddFormat(16, nfShortTimeAM, AddAMPM(fs.ShortTimeFormat, fs));
AddFormat(17, nfLongTimeAM, AddAMPM(fs.LongTimeFormat, fs));
AddFormat(18, nfShortTime, fs.ShortTimeFormat);
AddFormat(19, nfLongTime, fs.LongTimeFormat);
AddFormat(20, nfShortDateTime, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat);
FFirstNumFormatIndexInFile := 0; // BIFF2 stores built-in formats to file.
FNextNumFormatIndex := 21; // not needed - there are not user-defined formats
end;
procedure TsBIFF2NumFormatList.ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat);
var
parser: TsNumFormatParser;
begin begin
Unused(ANumFormat); Clear;
Add(''); // 0
if AFormatString = '' then Add('0'); // 1
AFormatString := 'General' Add('0.00'); // 2
else begin Add('#,##0'); // 3
parser := TsNumFormatParser.Create(FWorkbook, AFormatString); Add('#,##0.00'); // 4
try Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 5
parser.Localize; Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 6
parser.LimitDecimals; Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 7
AFormatString := parser.FormatString[nfdExcel]; Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 8
finally Add('0%'); // 9
parser.Free; Add('0.00%'); // 10
end; Add('0.00E+00'); // 11
end; Add(BuildDateTimeFormatString(nfShortDate, fs)); // 12
end; Add(BuildDateTimeFormatString(nfLongDate, fs)); // 13
Add(BuildDateTimeFormatString(nfDayMonth, fs)); // 14: 'd/mmm'
function TsBIFF2NumFormatList.Find(ANumFormat: TsNumberFormat; Add(BuildDateTimeFormatString(nfMonthYear, fs)); // 15: 'mmm/yy'
ANumFormatStr: String): Integer; Add(BuildDateTimeFormatString(nfShortTimeAM, fs)); // 16;
var Add(BuildDateTimeFormatString(nfLongTimeAM, fs)); // 17
parser: TsNumFormatParser; Add(BuildDateTimeFormatString(nfShortTime, fs)); // 18
decs: Integer; Add(BuildDateTimeFormatString(nfLongTime, fs)); // 19
dt: string; Add(BuildDateTimeFormatString(nfShortDateTime, fs)); // 20
begin
Result := 0;
parser := TsNumFormatParser.Create(Workbook, ANumFormatStr);
try
decs := parser.Decimals;
dt := parser.GetDateTimeCode(0);
finally
parser.Free;
end;
case ANumFormat of
nfGeneral : exit;
nfFixed : Result := IfThen(decs = 0, 1, 2);
nfFixedTh : Result := IfThen(decs = 0, 3, 4);
nfCurrency : Result := IfThen(decs = 0, 5, 7);
nfCurrencyRed : Result := IfThen(decs = 0, 6, 8);
nfPercentage : Result := IfThen(decs = 0, 9, 10);
nfExp : Result := 11;
nfShortDate : Result := 12;
nfLongDate : Result := 13;
nfShortTimeAM : Result := 16;
nfLongTimeAM : Result := 17;
nfShortTime : Result := 18;
nfLongTime : Result := 19;
nfShortDateTime: Result := 20;
nfCustom : if dt = 'dm' then Result := 14 else
if dt = 'my' then Result := 15;
end; end;
end; end;
{------------------------------------------------------------------------------}
{ TsSpreadBIFF2Reader } { TsSpreadBIFF2Reader }
{------------------------------------------------------------------------------}
constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook); constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook);
begin begin
@ -382,14 +296,10 @@ begin
FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE; FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
end; end;
{@@ ---------------------------------------------------------------------------- procedure TsSpreadBIFF2Reader.AddBuiltInNumFormats;
Creates the correct version of the number format list.
It is for BIFF2 and BIFF3 file formats.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.CreateNumFormatList;
begin begin
FreeAndNil(FNumFormatList); FFirstNumFormatIndexInFile := 0;
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook); InternalAddBuiltInNumFormats(FNumFormatList, Workbook.FormatSettings, nfdDefault);
end; end;
procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream);
@ -478,7 +388,7 @@ begin
FWorksheet.DefaultRowHeight := h - ROW_HEIGHT_CORRECTION; FWorksheet.DefaultRowHeight := h - ROW_HEIGHT_CORRECTION;
end; end;
procedure TsSpreadBIFF2Reader.ReadFont(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadFONT(AStream: TStream);
var var
lHeight: Word; lHeight: Word;
lOptions: Word; lOptions: Word;
@ -509,7 +419,7 @@ begin
FFontList.Add(FFont); FFontList.Add(FFont);
end; end;
procedure TsSpreadBIFF2Reader.ReadFontColor(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadFONTCOLOR(AStream: TStream);
begin begin
FFont.Color := WordLEToN(AStream.ReadWord); FFont.Color := WordLEToN(AStream.ReadWord);
end; end;
@ -517,7 +427,7 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Reads the FORMAT record required for formatting numerical data Reads the FORMAT record required for formatting numerical data
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadFormat(AStream: TStream); procedure TsSpreadBIFF2Reader.ReadFORMAT(AStream: TStream);
begin begin
Unused(AStream); Unused(AStream);
// We ignore the formats in the file, everything is known // We ignore the formats in the file, everything is known
@ -811,7 +721,8 @@ begin
ACol := WordLEToN(AStream.ReadWord); ACol := WordLEToN(AStream.ReadWord);
{ Index to XF record } { Index to XF record }
AXF := AStream.ReadByte and $3F; // to do: if AXF = $3F = 63 then there must be a IXFE record which contains the true XF index! AXF := AStream.ReadByte and $3F;
// If AXF = $3F = 63 then there is an IXFE record containing the true XF index!
if AXF = $3F then if AXF = $3F then
AXF := FPendingXFIndex; AXF := FPendingXFIndex;
@ -964,7 +875,8 @@ var
rec: TBIFF2_XFRecord; rec: TBIFF2_XFRecord;
fmt: TsCellFormat; fmt: TsCellFormat;
b: Byte; b: Byte;
nfdata: TsNumFormatData; nf: TsNumFormatParams;
nfs: String;
i: Integer; i: Integer;
fnt: TsFont; fnt: TsFont;
begin begin
@ -982,22 +894,18 @@ begin
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
{ if fmt.FontIndex > 0 then
if fmt.FontIndex = BOLD_FONTINDEX then
Include(fmt.UsedFormattingFields, uffBold)
else
}
if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
// Number format index // Number format index
b := rec.NumFormatIndex_Flags and $3F; b := rec.NumFormatIndex_Flags and $3F;
i := NumFormatList.FindByIndex(b); nfs := NumFormatList[b];
if i > -1 then begin if nfs <> '' then
nfdata := NumFormatList.Items[i]; begin
fmt.NumberFormat := nfdata.NumFormat; fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
fmt.NumberFormatStr := nfdata.FormatString; nf := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
if nfdata.NumFormat <> nfGeneral then fmt.NumberFormat := nf.NumFormat;
fmt.NumberFormatStr := nf.NumFormatStr[nfdDefault];
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
end; end;
@ -1046,7 +954,9 @@ begin
end; end;
{------------------------------------------------------------------------------}
{ TsSpreadBIFF2Writer } { TsSpreadBIFF2Writer }
{------------------------------------------------------------------------------}
constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook); constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook);
begin begin
@ -1058,13 +968,13 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Creates the correct version of the number format list. Adds the built-in number formats to the NumFormatList.
It is valid for BIFF2 and BIFF3 file formats. Inherited method overridden for BIFF2 specialties.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.CreateNumFormatList; procedure TsSpreadBIFF2Writer.AddBuiltInNumFormats;
begin begin
FreeAndNil(FNumFormatList); FFirstNumFormatIndexInFile := 0;
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook); InternalAddBuiltInNumFormats(FNumFormatList, Workbook.FormatSettings, nfdExcel);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -1118,16 +1028,15 @@ begin
Attrib3 := Attrib3 or $80; Attrib3 := Attrib3 or $80;
end; end;
{ Builds up the list of number formats to be written to the biff2 file. {@@ ----------------------------------------------------------------------------
Builds up the list of number formats to be written to the biff2 file.
Unlike biff5+ no formats are added here because biff2 supports only 21 Unlike biff5+ no formats are added here because biff2 supports only 21
standard formats; these formats have been added by the NumFormatList's standard formats; these formats have been added by AddBuiltInFormats.
AddBuiltInFormats. Nothing to do here.
-------------------------------------------------------------------------------}
NOT CLEAR IF THIS IS TRUE ???? procedure TsSpreadBIFF2Writer.ListAllNumFormats(ADialect: TsNumFormatDialect);
}
// ToDo: check if the BIFF2 format is really restricted to 21 formats.
procedure TsSpreadBIFF2Writer.ListAllNumFormats;
begin begin
Unused(ADialect);
// Nothing to do here. // Nothing to do here.
end; end;
@ -1325,7 +1234,7 @@ begin
WriteFonts(AStream); WriteFonts(AStream);
WriteCodePage(AStream, FCodePage); WriteCodePage(AStream, FCodePage);
WriteFormatCount(AStream); WriteFormatCount(AStream);
WriteNumFormats(AStream); WriteNumFormats(AStream, nfdExcel);
WriteXFRecords(AStream); WriteXFRecords(AStream);
WriteColWidths(AStream); WriteColWidths(AStream);
WriteDimensions(AStream, FWorksheet); WriteDimensions(AStream, FWorksheet);
@ -1425,6 +1334,7 @@ var
rec: TBIFF2_XFRecord; rec: TBIFF2_XFRecord;
b: Byte; b: Byte;
j: Integer; j: Integer;
nfParams: TsNumFormatParams;
begin begin
Unused(XFType_Prot); Unused(XFType_Prot);
@ -1436,11 +1346,6 @@ begin
rec.FontIndex := 0; rec.FontIndex := 0;
if (AFormatRecord <> nil) then if (AFormatRecord <> nil) then
begin begin
{
if (uffBold in AFormatRecord^.UsedFormattingFields) then
rec.FontIndex := BOLD_FONTINDEX
else
}
if (uffFont in AFormatRecord^.UsedFormattingFields) then if (uffFont in AFormatRecord^.UsedFormattingFields) then
begin begin
rec.FontIndex := AFormatRecord^.FontIndex; rec.FontIndex := AFormatRecord^.FontIndex;
@ -1460,19 +1365,57 @@ begin
rec.NumFormatIndex_Flags := 0; rec.NumFormatIndex_Flags := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then
begin begin
// The number formats in the FormatList are still in fpc dialect nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex);
// They will be converted to Excel syntax immediately before writing. if nfParams <> nil then
j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); case nfParams.NumFormat of
if j > -1 then nfGeneral:
rec.NumFormatIndex_Flags := NumFormatList[j].Index; j := 0;
nfFixed:
j := IfThen(nfParams.Sections[0].Decimals = 0, 1, 2);
nfFixedTh:
j := IfThen(nfParams.Sections[0].Decimals = 0, 3, 4);
nfCurrency:
j := IfThen(nfParams.Sections[0].Decimals = 0, 5, 7);
nfCurrencyRed:
j := IfThen(nfParams.Sections[0].Decimals = 0, 6, 8);
nfPercentage:
j := IfThen(nfParams.Sections[0].Decimals = 0, 9, 10);
nfExp:
j := 11;
nfShortDate:
j := 12;
nfLongDate:
j := 13;
nfDayMonth:
j := 14;
nfMonthYear:
j := 15;
nfShortTimeAM:
j := 16;
nfLongTimeAM:
j := 17;
nfShortTime:
j := 18;
nfLongTime:
j := 19;
nfShortDateTime:
j := 20;
// Not available in BIFF2
nfFraction:
j := 0;
nfTimeInterval:
j := 19;
nfCustom:
j := 0;
end;
rec.NumFormatIndex_Flags := j;
// Cell flags not used, so far... // Cell flags not used, so far...
end; end;
{Horizontal alignment, border style, and background {Horizontal alignment, border style, and background
Bit Mask Contents Bit Mask Contents
--- ---- ------------------------------------------------ --- ---- ------------------------------------------------
2-0 $07 XF_HOR_ALIGN – Horizontal alignment (0=General, 1=Left, 2=Centred, 3=Right) 2-0 $07 XF_HOR_ALIGN – Horizontal alignment (0=General, 1=Left, 2=Centered, 3=Right)
3 $08 1 = Cell has left black border 3 $08 1 = Cell has left black border
4 $10 1 = Cell has right black border 4 $10 1 = Cell has right black border
5 $20 1 = Cell has top black border 5 $20 1 = Cell has top black border
@ -1592,7 +1535,7 @@ end;
Writes an Excel 2 FORMAT record which describes formatting of numerical data. Writes an Excel 2 FORMAT record which describes formatting of numerical data.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBiff2Writer.WriteNumFormat(AStream: TStream; procedure TsSpreadBiff2Writer.WriteNumFormat(AStream: TStream;
ANumFormatData: TsNumFormatData; AListIndex: Integer); ANumFormatStr: String; AFormatIndex: Integer);
type type
TNumFormatRecord = packed record TNumFormatRecord = packed record
RecordID: Word; RecordID: Word;
@ -1605,9 +1548,12 @@ var
rec: TNumFormatRecord; rec: TNumFormatRecord;
buf: array of byte; buf: array of byte;
begin begin
Unused(ANumFormatData); Unused(ANumFormatStr);
s := ConvertEncoding(NumFormatList.FormatStringForWriting(AListIndex), encodingUTF8, FCodePage); if (AFormatIndex = 0) then
s := 'General'
else
s := ConvertEncoding(NumFormatList[AFormatIndex], encodingUTF8, FCodePage);
len := Length(s); len := Length(s);
{ BIFF record header } { BIFF record header }

View File

@ -59,7 +59,7 @@ interface
uses uses
Classes, SysUtils, fpcanvas, lconvencoding, Classes, SysUtils, fpcanvas, lconvencoding,
fpsTypes, fpsNumFormat, fpspreadsheet, fpsTypes, fpspreadsheet,
xlscommon, xlscommon,
{$ifdef USE_NEW_OLE} {$ifdef USE_NEW_OLE}
fpolebasic, fpolebasic,
@ -79,9 +79,9 @@ type
protected protected
{ Record writing methods } { Record writing methods }
procedure ReadBoundsheet(AStream: TStream); procedure ReadBoundsheet(AStream: TStream);
procedure ReadFont(const AStream: TStream); procedure ReadFONT(const AStream: TStream);
procedure ReadFormat(AStream: TStream); override; procedure ReadFORMAT(AStream: TStream); override;
procedure ReadLabel(AStream: TStream); override; procedure ReadLABEL(AStream: TStream); override;
procedure ReadWorkbookGlobals(AStream: TStream); procedure ReadWorkbookGlobals(AStream: TStream);
procedure ReadWorksheet(AStream: TStream); procedure ReadWorksheet(AStream: TStream);
procedure ReadRichString(AStream: TStream); procedure ReadRichString(AStream: TStream);
@ -108,8 +108,8 @@ type
procedure WriteIndex(AStream: TStream); procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WriteNumFormat(AStream: TStream; ANumFormatData: TsNumFormatData; procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
AListIndex: Integer); override; ANumFormatIndex: Integer); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteStyle(AStream: TStream); procedure WriteStyle(AStream: TStream);
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -594,9 +594,10 @@ procedure TsSpreadBIFF5Reader.ReadXF(AStream: TStream);
var var
rec: TBIFF5_XFRecord; rec: TBIFF5_XFRecord;
fmt: TsCellFormat; fmt: TsCellFormat;
nfidx: Integer; // nfidx: Integer;
i: Integer; i: Integer;
nfdata: TsNumFormatData; nfparams: TsNumFormatParams;
nfs: String;
b: Byte; b: Byte;
dw: DWord; dw: DWord;
fill: Word; fill: Word;
@ -621,6 +622,30 @@ begin
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
// Number format index // Number format index
if rec.NumFormatIndex <> 0 then begin
nfs := NumFormatList[rec.NumFormatIndex];
// "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList
if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then
begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
nfParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
fmt.NumberFormat := nfParams.NumFormat;
fmt.NumberFormatStr := nfs;
Include(fmt.UsedFormattingFields, uffNumberFormat);
end;
end;
{
// Number format index
nfparams := Workbook.GetNumberFormat(rec.NumFormatIndex);
nfs := nfParams.NumFormatStr[nfdDefault];
if nfs <> '' then begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
fmt.NumberFormat := nfParams.NumFormat;
fmt.NumberFormatStr := nfs;
Include(fmt.UsedFormattingFields, uffNumberFormat);
end;
}
{
nfidx := WordLEToN(rec.NumFormatIndex); nfidx := WordLEToN(rec.NumFormatIndex);
i := NumFormatList.FindByIndex(nfidx); i := NumFormatList.FindByIndex(nfidx);
if i > -1 then begin if i > -1 then begin
@ -630,7 +655,7 @@ begin
if nfdata.NumFormat <> nfGeneral then if nfdata.NumFormat <> nfGeneral then
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
end; end;
}
// Horizontal text alignment // Horizontal text alignment
b := rec.Align_TextBreak AND MASK_XF_HOR_ALIGN; b := rec.Align_TextBreak AND MASK_XF_HOR_ALIGN;
if (b <= ord(High(TsHorAlignment))) then if (b <= ord(High(TsHorAlignment))) then
@ -848,6 +873,7 @@ var
len: byte; len: byte;
fmtIndex: Integer; fmtIndex: Integer;
fmtString: AnsiString; fmtString: AnsiString;
nfs: String;
begin begin
// Record FORMAT, BIFF 8 (5.49): // Record FORMAT, BIFF 8 (5.49):
// Offset Size Contents // Offset Size Contents
@ -863,9 +889,10 @@ begin
SetLength(fmtString, len); SetLength(fmtString, len);
AStream.ReadBuffer(fmtString[1], len); AStream.ReadBuffer(fmtString[1], len);
// Add to the list // Add to the list at the specified index. If necessary insert empty strings
// NumFormatList.AnalyzeAndAdd(fmtIndex, AnsiToUTF8(fmtString)); nfs := ConvertEncoding(fmtString, FCodePage, encodingUTF8);
NumFormatList.AnalyzeAndAdd(fmtIndex, ConvertEncoding(fmtString, FCodePage, encodingUTF8)); while NumFormatList.Count <= fmtIndex do NumFormatList.Add('');
NumFormatList[fmtIndex] := nfs;
end; end;
procedure TsSpreadBIFF5Reader.ReadLabel(AStream: TStream); procedure TsSpreadBIFF5Reader.ReadLabel(AStream: TStream);
@ -977,7 +1004,7 @@ begin
WriteCodepage(AStream, FCodePage); WriteCodepage(AStream, FCodePage);
WriteWindow1(AStream); WriteWindow1(AStream);
WriteFonts(AStream); WriteFonts(AStream);
WriteNumFormats(AStream); WriteNumFormats(AStream, nfdExcel);
WritePalette(AStream); WritePalette(AStream);
WriteXFRecords(AStream); WriteXFRecords(AStream);
WriteStyle(AStream); WriteStyle(AStream);
@ -1218,7 +1245,7 @@ end;
data. data.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBiff5Writer.WriteNumFormat(AStream: TStream; procedure TsSpreadBiff5Writer.WriteNumFormat(AStream: TStream;
ANumFormatData: TsNumFormatData; AListIndex: Integer); ANumFormatStr: String; ANumFormatIndex: Integer);
type type
TNumFormatRecord = packed record TNumFormatRecord = packed record
RecordID: Word; RecordID: Word;
@ -1228,16 +1255,13 @@ type
end; end;
var var
len: Integer; len: Integer;
fmtStr: String; //fmtStr: String;
ansiFmtStr: ansiString; ansiFmtStr: ansiString;
rec: TNumFormatRecord; rec: TNumFormatRecord;
buf: array of byte; buf: array of byte;
begin begin
if (ANumFormatData = nil) or (ANumFormatData.FormatString = '') then //fmtStr := NumFormatList.FormatStringForWriting(AListIndex);
exit; ansiFmtStr := ConvertEncoding(ANumFormatStr, encodingUTF8, FCodePage);
fmtStr := NumFormatList.FormatStringForWriting(AListIndex);
ansiFmtStr := ConvertEncoding(fmtStr, encodingUTF8, FCodePage);
len := Length(ansiFmtStr); len := Length(ansiFmtStr);
{ BIFF record header } { BIFF record header }
@ -1245,7 +1269,7 @@ begin
rec.RecordSize := WordToLE(2 + 1 + len * SizeOf(AnsiChar)); rec.RecordSize := WordToLE(2 + 1 + len * SizeOf(AnsiChar));
{ Format index } { Format index }
rec.FormatIndex := WordToLE(ANumFormatData.Index); rec.FormatIndex := WordToLE(ANumFormatIndex);
{ Format string } { Format string }
{ Length in 1 byte } { Length in 1 byte }
@ -1450,6 +1474,8 @@ var
j: Integer; j: Integer;
b: Byte; b: Byte;
dw1, dw2: DWord; dw1, dw2: DWord;
nfParams: TsNumFormatParams;
nfs: String;
begin begin
{ BIFF record header } { BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_XF); rec.RecordID := WordToLE(INT_EXCEL_ID_XF);
@ -1467,9 +1493,16 @@ begin
rec.FontIndex := WordToLE(rec.FontIndex); rec.FontIndex := WordToLE(rec.FontIndex);
{ Index to number format } { Index to number format }
rec.NumFormatIndex := 0; j := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields)
then begin then begin
nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex);
nfs := nfParams.NumFormatStr[nfdExcel];
j := NumFormatList.IndexOf(nfs);
if j = -1 then j := 0;
end;
rec.NumFormatIndex := WordToLE(j);
{
// The number formats in the FormatList are still in fpc dialect // The number formats in the FormatList are still in fpc dialect
// They will be converted to Excel syntax immediately before writing. // They will be converted to Excel syntax immediately before writing.
j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr);
@ -1477,7 +1510,7 @@ begin
rec.NumFormatIndex := NumFormatList[j].Index; rec.NumFormatIndex := NumFormatList[j].Index;
end; end;
rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); rec.NumFormatIndex := WordToLE(rec.NumFormatIndex);
}
{ XF type, cell protection and parent style XF } { XF type, cell protection and parent style XF }
rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT;
if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then

View File

@ -56,7 +56,7 @@ interface
uses uses
Classes, SysUtils, fpcanvas, DateUtils, contnrs, lazutf8, Classes, SysUtils, fpcanvas, DateUtils, contnrs, lazutf8,
fpstypes, fpsnumformat, fpspreadsheet, xlscommon, fpstypes, fpspreadsheet, xlscommon,
{$ifdef USE_NEW_OLE} {$ifdef USE_NEW_OLE}
fpolebasic, fpolebasic,
{$else} {$else}
@ -143,8 +143,8 @@ type
procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word); procedure WriteMSODrawing2_Data(AStream: TStream; AComment: PsComment; AShapeID: Word);
procedure WriteMSODrawing3(AStream: TStream); procedure WriteMSODrawing3(AStream: TStream);
procedure WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word); procedure WriteNOTE(AStream: TStream; AComment: PsComment; AObjID: Word);
procedure WriteNumFormat(AStream: TStream; AFormatData: TsNumFormatData; procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
AListIndex: Integer); override; ANumFormatIndex: Integer); override;
procedure WriteOBJ(AStream: TStream; AObjID: Word); procedure WriteOBJ(AStream: TStream; AObjID: Word);
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal; function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): word; override; AFlags: TsRelFlags): word; override;
@ -940,9 +940,9 @@ begin
if (c and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow); if (c and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow);
end; end;
{ Read the difference between cell row and column indexed of a cell and a reference { Reads the difference between cell row and column indexed of a cell and
cell. a reference cell.
Overriding the implementation in xlscommon. } Overrides the implementation in xlscommon. }
procedure TsSpreadBIFF8Reader.ReadRPNCellAddressOffset(AStream: TStream; procedure TsSpreadBIFF8Reader.ReadRPNCellAddressOffset(AStream: TStream;
out ARowOffset, AColOffset: Integer; out AFlags: TsRelFlags); out ARowOffset, AColOffset: Integer; out AFlags: TsRelFlags);
var var
@ -1185,8 +1185,8 @@ var
dw: DWord; dw: DWord;
fill: Integer; fill: Integer;
fs: TsFillStyle; fs: TsFillStyle;
nfidx: Integer; nfs: String;
nfdata: TsNumFormatData; nfParams: TsNumFormatParams;
i: Integer; i: Integer;
fnt: TsFont; fnt: TsFont;
begin begin
@ -1208,15 +1208,21 @@ begin
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
// Number format index // Number format index
nfidx := WordLEToN(rec.NumFormatIndex); if rec.NumFormatIndex <> 0 then begin
i := NumFormatList.FindByIndex(nfidx); nfs := NumFormatList[rec.NumFormatIndex];
if i > -1 then begin // "General" (NumFormatIndex = 0) not stored in workbook's NumFormatList
nfdata := NumFormatList.Items[i]; if (rec.NumFormatIndex > 0) and not SameText(nfs, 'General') then
fmt.NumberFormat := nfdata.NumFormat; begin
fmt.NumberFormatStr := nfdata.FormatString; fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
if nfdata.NumFormat <> nfGeneral then nfParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
if nfParams <> nil then
begin
fmt.NumberFormat := nfParams.NumFormat;
fmt.NumberFormatStr := nfs;
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
end; end;
end;
end;
// Horizontal text alignment // Horizontal text alignment
b := rec.Align_TextBreak AND MASK_XF_HOR_ALIGN; b := rec.Align_TextBreak AND MASK_XF_HOR_ALIGN;
@ -1398,7 +1404,11 @@ begin
FFontList.Add(font); FFontList.Add(font);
end; end;
// Read the (number) FORMAT record for formatting numerical data {@@ ----------------------------------------------------------------------------
Reads the (number) FORMAT record for formatting numerical data and stores the
format strings in an internal stringlist. The strings are put at the index
specified by the FORMAT record.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Reader.ReadFORMAT(AStream: TStream); procedure TsSpreadBIFF8Reader.ReadFORMAT(AStream: TStream);
var var
fmtString: String; fmtString: String;
@ -1410,12 +1420,15 @@ begin
// 2 var Number format string (Unicode string, 16-bit string length) // 2 var Number format string (Unicode string, 16-bit string length)
// From BIFF5 on: indexes 0..163 are built in // From BIFF5 on: indexes 0..163 are built in
fmtIndex := WordLEtoN(AStream.ReadWord); fmtIndex := WordLEtoN(AStream.ReadWord);
if fmtIndex = 0 then // "General" already in list
exit;
// 2 var. Number format string (Unicode string, 16-bit string length, ➜2.5.3) // 2 var. Number format string (Unicode string, 16-bit string length, ➜2.5.3)
fmtString := UTF8Encode(ReadWideString(AStream, False)); fmtString := UTF8Encode(ReadWideString(AStream, False));
// Analyze the format string and add format to the list // Add to the list at the specified index. If necessary insert empty strings
NumFormatList.AnalyzeAndAdd(fmtIndex, fmtString); while NumFormatList.Count <= fmtIndex do NumFormatList.Add('');
NumFormatList[fmtIndex] := fmtString;
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -1585,16 +1598,6 @@ begin
{ Add tooltip to hyperlinks } { Add tooltip to hyperlinks }
for hyperlink in FWorksheet.Hyperlinks.GetRangeEnumerator(row1, col1, row2, col2) do for hyperlink in FWorksheet.Hyperlinks.GetRangeEnumerator(row1, col1, row2, col2) do
hyperlink^.ToolTip := txt; hyperlink^.ToolTip := txt;
{
for row := row1 to row2 do
for col := col1 to col2 do
begin
hyperlink := PsHyperlink(FWorksheet.Hyperlinks.Find(row, col));
if hyperlink <> nil then
hyperlink^.ToolTip := txt;
end;
}
end; end;
@ -1646,15 +1649,12 @@ begin
end; end;
end; end;
{******************************************************************* {@@ ----------------------------------------------------------------------------
* TsSpreadBIFF8Writer.WriteToStream () Writes an Excel BIFF8 record structure to a stream
*
* DESCRIPTION: Writes an Excel BIFF8 record structure Be careful as this method doesn't write the OLE part of the document,
* just the BIFF records
* Be careful as this method doesn't write the OLE -------------------------------------------------------------------------------}
* part of the document, just the BIFF records
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream); procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream);
const const
isBIFF8 = true; isBIFF8 = true;
@ -1669,7 +1669,7 @@ begin
WriteCodePage(AStream, 'ucs2le'); // = utf8 WriteCodePage(AStream, 'ucs2le'); // = utf8
WriteWindow1(AStream); WriteWindow1(AStream);
WriteFonts(AStream); WriteFonts(AStream);
WriteNumFormats(AStream); WriteNumFormats(AStream, nfdExcel);
WritePalette(AStream); WritePalette(AStream);
WriteXFRecords(AStream); WriteXFRecords(AStream);
WriteStyle(AStream); WriteStyle(AStream);
@ -1724,15 +1724,11 @@ begin
SetLength(Boundsheets, 0); SetLength(Boundsheets, 0);
end; end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 BOF record
{******************************************************************* This must be the first record on an Excel 8 stream
* TsSpreadBIFF8Writer.WriteBOF () -------------------------------------------------------------------------------}
*
* DESCRIPTION: Writes an Excel 8 BOF record
*
* This must be the first record on an Excel 8 stream
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteBOF(AStream: TStream; ADataType: Word); procedure TsSpreadBIFF8Writer.WriteBOF(AStream: TStream; ADataType: Word);
begin begin
{ BIFF Record header } { BIFF Record header }
@ -1955,13 +1951,9 @@ begin
AStream.WriteBuffer(WideStringToLE(WideFontName)[1], Len * Sizeof(WideChar)); AStream.WriteBuffer(WideStringToLE(WideFontName)[1], Len * Sizeof(WideChar));
end; end;
{******************************************************************* {@@ ----------------------------------------------------------------------------
* TsSpreadBIFF8Writer.WriteFonts () Writes the Excel 8 FONT records needed for the fonts used in the workbook.
* -------------------------------------------------------------------------------}
* DESCRIPTION: Writes the Excel 8 FONT records needed for the
* used fonts in the workbook.
*
*******************************************************************}
procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream); procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream);
var var
i: Integer; i: Integer;
@ -2035,9 +2027,11 @@ begin
end; end;
end; end;
{ Write the MSODRAWING record which occurs before the OBJ record. {@@ ----------------------------------------------------------------------------
Do not use for the very first OBJ record where the record must be Writes the MSODRAWING record which occurs before the OBJ record.
WriteMSODrawing1 + WriteMSODrawing2_Data} Not to be used for the very first OBJ record where the record must be
WriteMSODrawing1 + WriteMSODrawing2_Data
-------------------------------------------------------------------------------}
procedure TsSpreadBiff8Writer.WriteMSODrawing2(AStream: TStream; procedure TsSpreadBiff8Writer.WriteMSODrawing2(AStream: TStream;
AComment: PsComment; AObjID: Word); AComment: PsComment; AObjID: Word);
var var
@ -2107,7 +2101,9 @@ begin
end; end;
end; end;
{ Writes the MSODRAWING record which must occur immediately before a TXO record } {@@ ----------------------------------------------------------------------------
Writes the MSODRAWING record which must occur immediately before a TXO record
-------------------------------------------------------------------------------}
procedure TsSpreadBiff8Writer.WriteMSODRAWING3(AStream: TStream); procedure TsSpreadBiff8Writer.WriteMSODRAWING3(AStream: TStream);
begin begin
{ BIFF Header } { BIFF Header }
@ -2117,7 +2113,9 @@ begin
WriteMSOClientTextBoxRecord(AStream); WriteMSOClientTextBoxRecord(AStream);
end; end;
{ Writes a NOTE record for a comment attached to a cell } {@@ ----------------------------------------------------------------------------
Writes a NOTE record for a comment attached to a cell
-------------------------------------------------------------------------------}
procedure TsSpreadBiff8Writer.WriteNOTE(AStream: TStream; AComment: PsComment; procedure TsSpreadBiff8Writer.WriteNOTE(AStream: TStream; AComment: PsComment;
AObjID: Word); AObjID: Word);
const const
@ -2143,7 +2141,7 @@ begin
end; end;
procedure TsSpreadBiff8Writer.WriteNumFormat(AStream: TStream; procedure TsSpreadBiff8Writer.WriteNumFormat(AStream: TStream;
AFormatData: TsNumFormatData; AListIndex: Integer); ANumFormatStr: String; ANumFormatIndex: Integer);
type type
TNumFormatRecord = packed record TNumFormatRecord = packed record
RecordID: Word; RecordID: Word;
@ -2154,16 +2152,11 @@ type
end; end;
var var
len: Integer; len: Integer;
s: String;
ws: widestring; ws: widestring;
rec: TNumFormatRecord; rec: TNumFormatRecord;
buf: array of byte; buf: array of byte;
begin begin
if (AFormatData = nil) or (AFormatData.FormatString = '') then ws := UTF8Decode(ANumFormatStr);
exit;
s := NumFormatList.FormatStringForWriting(AListIndex);
ws := UTF8Decode(s);
len := Length(ws); len := Length(ws);
{ BIFF record header } { BIFF record header }
@ -2171,7 +2164,7 @@ begin
rec.RecordSize := WordToLE(2 + 2 + 1 + len * SizeOf(WideChar)); rec.RecordSize := WordToLE(2 + 2 + 1 + len * SizeOf(WideChar));
{ Format index } { Format index }
rec.FormatIndex := WordToLE(AFormatData.Index); rec.FormatIndex := WordToLE(ANumFormatIndex);
{ Format string } { Format string }
{ - length of string = 16 bits } { - length of string = 16 bits }
@ -2190,7 +2183,9 @@ begin
SetLength(buf, 0); SetLength(buf, 0);
end; end;
{ Writes an OBJ record - belongs to the record required for cell comments } {@@ ----------------------------------------------------------------------------
Writes an OBJ record - belongs to the records required for cell comments
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteOBJ(AStream: TStream; AObjID: Word); procedure TsSpreadBIFF8Writer.WriteOBJ(AStream: TStream; AObjID: Word);
var var
guid: TGuid; guid: TGuid;
@ -2219,8 +2214,10 @@ begin
AStream.WriteWord(0); // Size of subrecord: 0 bytes AStream.WriteWord(0); // Size of subrecord: 0 bytes
end; end;
{ Writes the address of a cell as used in an RPN formula and returns the {@@ ----------------------------------------------------------------------------
number of bytes written. } Writes the address of a cell as used in an RPN formula and returns the
number of bytes written.
-------------------------------------------------------------------------------}
function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream; function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream;
ARow, ACol: Cardinal; AFlags: TsRelFlags): Word; ARow, ACol: Cardinal; AFlags: TsRelFlags): Word;
var var
@ -2234,8 +2231,10 @@ begin
Result := 4; Result := 4;
end; end;
{ Writes row and column offset (unsigned integers!) {@@ ----------------------------------------------------------------------------
Valid for BIFF2-BIFF5. } Writes row and column offset needed in RPN formulas (unsigned integers!)
Valid for BIFF2-BIFF5.
-------------------------------------------------------------------------------}
function TsSpreadBIFF8Writer.WriteRPNCellOffset(AStream: TStream; function TsSpreadBIFF8Writer.WriteRPNCellOffset(AStream: TStream;
ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word; ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word;
var var
@ -2255,8 +2254,10 @@ begin
Result := 4; Result := 4;
end; end;
{ Writes the address of a cell range as used in an RPN formula and returns the {@@ ----------------------------------------------------------------------------
count of bytes written. } Writes the address of a cell range as used in an RPN formula and returns the
count of bytes written.
-------------------------------------------------------------------------------}
function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream; function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream;
ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): Word; ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): Word;
var var
@ -2278,9 +2279,11 @@ begin
Result := 8; Result := 8;
end; end;
{ Helper function for writing a string with 8-bit length. Overridden version {@@ ----------------------------------------------------------------------------
Helper function for writing a string with 8-bit length. Overridden version
for BIFF8. Called for writing rpn formula string tokens. for BIFF8. Called for writing rpn formula string tokens.
Returns the count of bytes written} Returns the count of bytes written.
-------------------------------------------------------------------------------}
function TsSpreadBIFF8Writer.WriteString_8BitLen(AStream: TStream; function TsSpreadBIFF8Writer.WriteString_8BitLen(AStream: TStream;
AString: String): Integer; AString: String): Integer;
var var
@ -2803,6 +2806,8 @@ var
b: Byte; b: Byte;
dw1, dw2: DWord; dw1, dw2: DWord;
w3: Word; w3: Word;
nfParams: TsNumFormatParams;
nfs: String;
begin begin
{ BIFF record header } { BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_XF); rec.RecordID := WordToLE(INT_EXCEL_ID_XF);
@ -2820,16 +2825,18 @@ begin
rec.FontIndex := WordToLE(rec.FontIndex); rec.FontIndex := WordToLE(rec.FontIndex);
{ Index to number format } { Index to number format }
rec.NumFormatIndex := 0; j := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields)
then begin then begin
// The number formats in the FormatList are still in fpc dialect nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex);
// They will be converted to Excel syntax immediately before writing. if nfParams <> nil then
j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); begin
if j > -1 then nfs := nfParams.NumFormatStr[nfdExcel];
rec.NumFormatIndex := NumFormatList[j].Index; j := NumFormatList.IndexOf(nfs);
if j = -1 then j := 0;
end; end;
rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); end;
rec.NumFormatIndex := WordToLE(j);
{ XF type, cell protection and parent style XF } { XF type, cell protection and parent style XF }
rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT;
@ -2944,16 +2951,12 @@ begin
end; end;
{@@ ----------------------------------------------------------------------------
Initialization section
Registers this reader / writer on fpSpreadsheet
Converts the palette to litte-endian
-------------------------------------------------------------------------------}
initialization initialization
// Registers this reader / writer in fpSpreadsheet
RegisterSpreadFormat(TsSpreadBIFF8Reader, TsSpreadBIFF8Writer, sfExcel8); RegisterSpreadFormat(TsSpreadBIFF8Reader, TsSpreadBIFF8Writer, sfExcel8);
// Converts the palette to litte-endian
MakeLEPalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); MakeLEPalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
end. end.

View File

@ -11,7 +11,8 @@ interface
uses uses
Classes, SysUtils, DateUtils, lconvencoding, Classes, SysUtils, DateUtils, lconvencoding,
fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormat, fpsReaderWriter; fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormatParser,
fpsReaderWriter;
const const
{ RECORD IDs which didn't change across versions 2-8 } { RECORD IDs which didn't change across versions 2-8 }
@ -237,15 +238,6 @@ type
RecordSize: Word; RecordSize: Word;
end; end;
{ TsBIFFNumFormatList }
TsBIFFNumFormatList = class(TsCustomNumFormatList)
protected
procedure AddBuiltinFormats; override;
public
procedure ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat); override;
end;
{ TsSpreadBIFFReader } { TsSpreadBIFFReader }
TsSpreadBIFFReader = class(TsCustomSpreadReader) TsSpreadBIFFReader = class(TsCustomSpreadReader)
protected protected
@ -256,8 +248,9 @@ type
FIncompleteCell: PCell; FIncompleteCell: PCell;
FIncompleteNote: String; FIncompleteNote: String;
FIncompleteNoteLength: Word; FIncompleteNoteLength: Word;
FFirstNumFormatIndexInFile: Integer;
procedure AddBuiltinNumFormats; override;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; //overload; procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; //overload;
procedure CreateNumFormatList; override;
// Extracts a number out of an RK value // Extracts a number out of an RK value
function DecodeRKValue(const ARK: DWORD): Double; function DecodeRKValue(const ARK: DWORD): Double;
// Returns the numberformat for a given XF record // Returns the numberformat for a given XF record
@ -336,14 +329,11 @@ type
protected protected
FDateMode: TDateMode; FDateMode: TDateMode;
FCodePage: String; // in a format prepared for lconvencoding.ConvertEncoding FCodePage: String; // in a format prepared for lconvencoding.ConvertEncoding
// FLastRow: Cardinal; FFirstNumFormatIndexInFile: Integer;
// FLastCol: Cardinal; procedure AddBuiltinNumFormats; override;
procedure CreateNumFormatList; override;
function FindXFIndex(ACell: PCell): Integer; virtual; function FindXFIndex(ACell: PCell): Integer; virtual;
function FixColor(AColor: TsColor): TsColor; override; function FixColor(AColor: TsColor): TsColor; override;
// procedure GetLastRowCallback(ACell: PCell; AStream: TStream);
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer; function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
// procedure GetLastColCallback(ACell: PCell; AStream: TStream);
function GetLastColIndex(AWorksheet: TsWorksheet): Word; function GetLastColIndex(AWorksheet: TsWorksheet): Word;
// Helper function for writing the BIFF header // Helper function for writing the BIFF header
@ -376,10 +366,10 @@ type
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
// Writes out a FORMAT record // Writes out a FORMAT record
procedure WriteNumFormat(AStream: TStream; ANumFormatData: TsNumFormatData; procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
AListIndex: Integer); virtual; ANumFormatIndex: Integer); virtual;
// Writes out all FORMAT records // Writes out all FORMAT records
procedure WriteNumFormats(AStream: TStream); procedure WriteNumFormats(AStream: TStream; ADialect: TsNumFormatDialect);
// Writes out a floating point NUMBER record // Writes out a floating point NUMBER record
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Double; ACell: PCell); override; const AValue: Double; ACell: PCell); override;
@ -438,12 +428,16 @@ type
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsWorkbook); override;
end; end;
procedure AddBuiltinBiffFormats(AList: TStringList;
AFormatSettings: TFormatSettings; ALastIndex: Integer;
ADialect: TsNumFormatDialect);
implementation implementation
uses uses
AVL_Tree, Math, Variants, AVL_Tree, Math, Variants,
{%H-}fpspatches, fpsStrings, xlsConst, fpsNumFormatParser, fpsrpn, fpsExprParser; {%H-}fpspatches, fpsStrings, xlsConst, fpsrpn, fpsExprParser;
const const
{ Helper table for rpn formulas: { Helper table for rpn formulas:
@ -541,7 +535,7 @@ begin
dm1904: dm1904:
result := AExcelDateNum + DATEMODE_1904_BASE; result := AExcelDateNum + DATEMODE_1904_BASE;
else else
raise Exception.CreateFmt('ConvertExcelDateTimeToDateTime: unknown datemode %d. Please correct fpspreadsheet source code. ', [ADateMode]); raise Exception.CreateFmt('[ConvertExcelDateTimeToDateTime] Unknown datemode %d. Please correct fpspreadsheet source code. ', [ADateMode]);
end; end;
end; end;
end; end;
@ -594,82 +588,60 @@ begin
end; end;
{------------------------------------------------------------------------------}
{ TsBIFFNumFormatList }
{------------------------------------------------------------------------------}
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
These are the built-in number formats as expected in the biff spreadsheet file. These are the built-in number formats as expected in the biff spreadsheet file.
In BIFF5+ they are not written to file but they are used for lookup of the In BIFF5+ they are not written to file but they are used for lookup of the
number format that Excel used. They are specified here in fpc dialect. number format that Excel used.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsBIFFNumFormatList.AddBuiltinFormats; procedure AddBuiltinBiffFormats(AList: TStringList;
AFormatSettings: TFormatSettings; ALastIndex: Integer;
ADialect: TsNumFormatDialect);
var var
fs: TFormatSettings; fs: TFormatSettings absolute AFormatSettings;
cs: String; cs: String;
i: Integer;
begin begin
fs := Workbook.FormatSettings; cs := fs.CurrencyString;
cs := Workbook.FormatSettings.CurrencyString; AList.Clear;
AList.Add(''); // 0
AddFormat( 0, nfGeneral, ''); AList.Add('0'); // 1
AddFormat( 1, nfFixed, '0'); AList.Add('0.00'); // 2
AddFormat( 2, nfFixed, '0.00'); AList.Add('#,##0'); // 3
AddFormat( 3, nfFixedTh, '#,##0'); AList.Add('#,##0.00'); // 4
AddFormat( 4, nfFixedTh, '#,##0.00'); AList.Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 5
AddFormat( 5, nfCurrency, '"'+cs+'"#,##0;("'+cs+'"#,##0)'); AList.Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 6
AddFormat( 6, nfCurrencyRed, '"'+cs+'"#,##0;[Red]("'+cs+'"#,##0)'); AList.Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 7
AddFormat( 7, nfCurrency, '"'+cs+'"#,##0.00;("'+cs+'"#,##0.00)'); AList.Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 8
AddFormat( 8, nfCurrencyRed, '"'+cs+'"#,##0.00;[Red]("'+cs+'"#,##0.00)'); AList.Add('0%'); // 9
AddFormat( 9, nfPercentage, '0%'); AList.Add('0.00%'); // 10
AddFormat(10, nfPercentage, '0.00%'); AList.Add('0.00E+00'); // 11
AddFormat(11, nfExp, '0.00E+00'); AList.Add('# ?/?'); // 12
AddFormat(12, nfFraction, '# ?/?'); AList.Add('# ??/??'); // 13
AddFormat(13, nfFraction, '# ??/??'); AList.Add(BuildDateTimeFormatString(nfShortDate, fs)); // 14
AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY' AList.Add(BuildDateTimeFormatString(nfLongdate, fs)); // 15
AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY' AList.Add(BuildDateTimeFormatString(nfDayMonth, fs)); // 16: 'd/mmm'
AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM' AList.Add(BuildDateTimeFormatString(nfMonthYear, fs)); // 17: 'mmm/yy'
AddFormat(17, nfCustom, 'mmm/yy'); // 'MMM-YY' AList.Add(BuildDateTimeFormatString(nfShortTimeAM, fs)); // 18
AddFormat(18, nfShortTimeAM, AddAMPM(fs.ShortTimeFormat, fs)); // 'h:mm AM/PM' AList.Add(BuildDateTimeFormatString(nfLongTimeAM, fs)); // 19
AddFormat(19, nfLongTimeAM, AddAMPM(fs.LongTimeFormat, fs)); // 'h:mm:ss AM/PM' AList.Add(BuildDateTimeFormatString(nfShortTime, fs)); // 20
AddFormat(20, nfShortTime, fs.ShortTimeFormat); // 'h:mm' AList.Add(BuildDateTimeFormatString(nfLongTime, fs)); // 21
AddFormat(21, nfLongTime, fs.LongTimeFormat); // 'h:mm:ss' AList.Add(BuildDateTimeFormatString(nfShortDateTime, fs)); // 22
AddFormat(22, nfShortDateTime, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat); // 'M/D/YY h:mm' (localized) for i:=23 to 36 do
// 23..36 not supported AList.Add(''); // not supported
AddFormat(37, nfCurrency, '_(#,##0_);(#,##0)'); AList.Add('_(#,##0_);(#,##0)'); // 37
AddFormat(38, nfCurrencyRed, '_(#,##0_);[Red](#,##0)'); AList.Add('_(#,##0_);[Red](#,##0)'); // 38
AddFormat(39, nfCurrency, '_(#,##0.00_);(#,##0.00)'); AList.Add('_(#,##0.00_);(#,##0.00)'); // 39
AddFormat(40, nfCurrencyRed, '_(#,##0.00_);[Red](#,##0.00)'); AList.Add('_(#,##0.00_);[Red](#,##0.00)'); // 40
AddFormat(41, nfCustom, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)'); AList.Add('_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)'); // 41
AddFormat(42, nfCustom, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)'); AList.Add('_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)'); // 42
AddFormat(43, nfCustom, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)'); AList.Add('_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)'); // 43
AddFormat(44, nfCustom, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)'); AList.Add('_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)'); // 44
AddFormat(45, nfCustom, 'nn:ss'); AList.Add('nn:ss'); // 45
AddFormat(46, nfTimeInterval, '[h]:nn:ss'); AList.Add('[h]:nn:ss'); // 46
AddFormat(47, nfCustom, 'nn:ss.z'); AList.Add('nn:ss.z'); // 47
AddFormat(48, nfCustom, '##0.0E+00'); AList.Add('##0.0E+00'); // 48
// 49 ("Text") not supported AList.Add(''); // 49: @ ("Text") not supported
for i:=50 to ALastIndex do AList.Add(''); // not supported/used
// All indexes from 0 to 163 are reserved for built-in formats.
// The first user-defined format starts at 164.
FFirstNumFormatIndexInFile := 164;
FNextNumFormatIndex := 164;
end;
procedure TsBIFFNumFormatList.ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat);
var
parser: TsNumFormatParser;
begin
parser := TsNumFormatParser.Create(Workbook, AFormatString, ANumFormat);
try
if parser.Status = psOK then begin
// For writing, we have to convert the fpc format string to Excel dialect
AFormatString := parser.FormatString[nfdExcel];
ANumFormat := parser.NumFormat;
end;
finally
parser.Free;
end;
end; end;
@ -690,6 +662,18 @@ begin
FLimitations.MaxPaletteSize := 64; FLimitations.MaxPaletteSize := 64;
end; end;
{@@ ----------------------------------------------------------------------------
Adds the built-in number formats to the NumFormatList.
Valid for BIFF5...BIFF8. Needs to be overridden for BIFF2.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.AddBuiltinNumFormats;
begin
FFirstNumFormatIndexInFile := 164;
AddBuiltInBiffFormats(
FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdDefault
);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Applies the XF formatting referred to by XFIndex to the specified cell Applies the XF formatting referred to by XFIndex to the specified cell
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
@ -709,16 +693,6 @@ begin
end; end;
end; end;
{@@ ----------------------------------------------------------------------------
Creates the correct version of the number format list. It is for BIFF file
formats.
Valid for BIFF5.BIFF8. Needs to be overridden for BIFF2.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFFNumFormatList.Create(Workbook);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Extracts a number out of an RK value. Extracts a number out of an RK value.
@ -787,7 +761,7 @@ var
begin begin
Result := true; Result := true;
if ANumberFormat in [ if ANumberFormat in [
nfShortDateTime, {nfFmtDateTime, }nfShortDate, nfLongDate, nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM] nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM]
then then
ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode) ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode)
@ -1078,6 +1052,7 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Reads the (number) FORMAT record for formatting numerical data Reads the (number) FORMAT record for formatting numerical data
To be overridden by descendants.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadFormat(AStream: TStream); procedure TsSpreadBIFFReader.ReadFormat(AStream: TStream);
begin begin
@ -1879,14 +1854,15 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Creates the correct version of the number format list. It is for BIFF file Adds the built-in number formats to the NumFormatList.
formats. Valid for BIFF5...BIFF8. Needs to be overridden for BIFF2.
Valid for BIFF5.BIFF8. Needs to be overridden for BIFF2.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.CreateNumFormatList; procedure TsSpreadBIFFWriter.AddBuiltinNumFormats;
begin begin
FreeAndNil(FNumFormatList); FFirstNumFormatIndexInFile := 164;
FNumFormatList := TsBIFFNumFormatList.Create(Workbook); AddBuiltInBiffFormats(
FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdExcel
);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -1908,37 +1884,15 @@ begin
end else end else
Result := AColor; Result := AColor;
end; end;
(*
procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream);
begin
Unused(AStream);
if ACell^.Row > FLastRow then FLastRow := ACell^.Row;
end; *)
function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer; function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
begin begin
Result := AWorksheet.GetLastRowIndex; Result := AWorksheet.GetLastRowIndex;
{
FLastRow := 0;
IterateThroughCells(nil, AWorksheet.Cells, @GetLastRowCallback);
Result := FLastRow;
}
end; end;
(*
procedure TsSpreadBIFFWriter.GetLastColCallback(ACell: PCell; AStream: TStream);
begin
Unused(AStream);
if ACell^.Col > FLastCol then FLastCol := ACell^.Col;
end;
*)
function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word; function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word;
begin begin
Result := AWorksheet.GetLastColIndex; Result := AWorksheet.GetLastColIndex;
{
FLastCol := 0;
IterateThroughCells(nil, AWorksheet.Cells, @GetLastColCallback);
Result := FLastCol;
}
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -2241,15 +2195,15 @@ begin
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes a BIFF number format record defined in AFormatData. Writes a BIFF number format record defined in the specified format string
AListIndex the index of the numformatdata in the numformat list (in Excel dialect).
(not the FormatIndex!). AFormatIndex is equal to the format index used in the Excel file.
Needs to be overridden by descendants. Needs to be overridden by descendants.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteNumFormat(AStream: TStream; procedure TsSpreadBIFFWriter.WriteNumFormat(AStream: TStream;
ANumFormatData: TsNumFormatData; AListIndex: Integer); ANumFormatStr: String; ANumFormatIndex: Integer);
begin begin
Unused(AStream, ANumFormatData, AListIndex); Unused(AStream, ANumFormatStr, ANumFormatIndex);
// needs to be overridden // needs to be overridden
end; end;
@ -2257,13 +2211,28 @@ end;
Writes all number formats to the stream. Saving starts at the item with the Writes all number formats to the stream. Saving starts at the item with the
FirstFormatIndexInFile. FirstFormatIndexInFile.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteNumFormats(AStream: TStream); procedure TsSpreadBIFFWriter.WriteNumFormats(AStream: TStream;
ADialect: TsNumFormatDialect);
var var
i: Integer; i: Integer;
item: TsNumFormatData; parser: TsNumFormatParser;
fmtStr: String;
begin begin
ListAllNumFormats; ListAllNumFormats(ADialect);
i := NumFormatList.FindByIndex(NumFormatList.FirstNumFormatIndexInFile); for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do
begin
fmtStr := NumFormatList[i];
parser := TsNumFormatParser.Create(Workbook, fmtStr);
try
fmtStr := parser.FormatString[ADialect];;
WriteNumFormat(AStream, fmtStr, i);
finally
parser.Free;
end;
end;
{
i := NumFormatList.FindByIndex(FFirstNumFormatIndexInFile);
if i > -1 then if i > -1 then
while i < NumFormatList.Count do while i < NumFormatList.Count do
begin begin
@ -2272,6 +2241,7 @@ begin
WriteNumFormat(AStream, item, i); WriteNumFormat(AStream, item, i);
inc(i); inc(i);
end; end;
}
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------

View File

@ -47,15 +47,6 @@ uses
type type
{ TsOOXMLFormatList }
TsOOXMLNumFormatList = class(TsCustomNumFormatList)
protected
procedure AddBuiltinFormats; override;
public
procedure ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat); override;
end;
{ TsSpreadOOXMLReader } { TsSpreadOOXMLReader }
TsSpreadOOXMLReader = class(TsSpreadXMLReader) TsSpreadOOXMLReader = class(TsSpreadXMLReader)
@ -96,7 +87,8 @@ type
procedure ReadThemeColors(ANode: TDOMNode); procedure ReadThemeColors(ANode: TDOMNode);
procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet); procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
protected protected
procedure CreateNumFormatList; override; FFirstNumFormatIndexInFile: Integer;
procedure AddBuiltinNumFormats; override;
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
@ -109,9 +101,7 @@ type
TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) TsSpreadOOXMLWriter = class(TsCustomSpreadWriter)
private private
FNext_rId: Integer; FNext_rId: Integer;
procedure WriteVmlDrawingsCallback(AComment: PsComment; FFirstNumFormatIndexInFile: Integer;
ACommentIndex: Integer; AStream: TStream);
protected protected
FDateMode: TDateMode; FDateMode: TDateMode;
FPointSeparatorSettings: TFormatSettings; FPointSeparatorSettings: TFormatSettings;
@ -119,8 +109,7 @@ type
FFillList: array of PsCellFormat; FFillList: array of PsCellFormat;
FBorderList: array of PsCellFormat; FBorderList: array of PsCellFormat;
protected protected
{ Helper routines } procedure AddBuiltinNumFormats; override;
procedure CreateNumFormatList; override;
procedure CreateStreams; procedure CreateStreams;
procedure DestroyStreams; procedure DestroyStreams;
function FindBorderInList(AFormat: PsCellFormat): Integer; function FindBorderInList(AFormat: PsCellFormat): Integer;
@ -377,85 +366,9 @@ const
); );
{------------------------------------------------------------------------------}
{ TsOOXMLNumFormatList }
{ These are the built-in number formats as expected in the biff spreadsheet file.
Identical to BIFF8. These formats are not written to file but they are used
for lookup of the number format that Excel used. They are specified here in
fpc dialect. }
procedure TsOOXMLNumFormatList.AddBuiltinFormats;
var
fs: TFormatSettings;
cs: String;
begin
fs := Workbook.FormatSettings;
cs := AnsiToUTF8(Workbook.FormatSettings.CurrencyString);
AddFormat( 0, nfGeneral, '');
AddFormat( 1, nfFixed, '0');
AddFormat( 2, nfFixed, '0.00');
AddFormat( 3, nfFixedTh, '#,##0');
AddFormat( 4, nfFixedTh, '#,##0.00');
AddFormat( 5, nfCurrency, '"'+cs+'"#,##0_);("'+cs+'"#,##0)');
AddFormat( 6, nfCurrencyRed, '"'+cs+'"#,##0_);[Red]("'+cs+'"#,##0)');
AddFormat( 7, nfCurrency, '"'+cs+'"#,##0.00_);("'+cs+'"#,##0.00)');
AddFormat( 8, nfCurrencyRed, '"'+cs+'"#,##0.00_);[Red]("'+cs+'"#,##0.00)');
AddFormat( 9, nfPercentage, '0%');
AddFormat(10, nfPercentage, '0.00%');
AddFormat(11, nfExp, '0.00E+00');
AddFormat(12, nfFraction, '# ?/?');
AddFormat(13, nfFraction, '# ??/??');
AddFormat(14, nfShortDate, fs.ShortDateFormat); // 'M/D/YY'
AddFormat(15, nfLongDate, fs.LongDateFormat); // 'D-MMM-YY'
AddFormat(16, nfCustom, 'd/mmm'); // 'D-MMM'
AddFormat(17, nfCustom, 'mmm/yy'); // 'MMM-YY'
AddFormat(18, nfShortTimeAM, AddAMPM(fs.ShortTimeFormat, fs)); // 'h:mm AM/PM'
AddFormat(19, nfLongTimeAM, AddAMPM(fs.LongTimeFormat, fs)); // 'h:mm:ss AM/PM'
AddFormat(20, nfShortTime, fs.ShortTimeFormat); // 'h:mm'
AddFormat(21, nfLongTime, fs.LongTimeFormat); // 'h:mm:ss'
AddFormat(22, nfShortDateTime, fs.ShortDateFormat + ' ' + fs.ShortTimeFormat); // 'M/D/YY h:mm' (localized)
// 23..36 not supported
AddFormat(37, nfCurrency, '_(#,##0_);(#,##0)');
AddFormat(38, nfCurrencyRed, '_(#,##0_);[Red](#,##0)');
AddFormat(39, nfCurrency, '_(#,##0.00_);(#,##0.00)');
AddFormat(40, nfCurrencyRed, '_(#,##0.00_);[Red](#,##0.00)');
AddFormat(41, nfCustom, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)');
AddFormat(42, nfCustom, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)');
AddFormat(43, nfCustom, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)');
AddFormat(44, nfCustom, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)');
AddFormat(45, nfCustom, 'nn:ss');
AddFormat(46, nfTimeInterval, '[h]:nn:ss');
AddFormat(47, nfCustom, 'nn:ss.z');
AddFormat(48, nfCustom, '##0.0E+00');
// 49 ("Text") not supported
// All indexes from 0 to 163 are reserved for built-in formats.
// The first user-defined format starts at 164.
FFirstNumFormatIndexInFile := 164;
FNextNumFormatIndex := 164;
end;
procedure TsOOXMLNumFormatList.ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat);
var
parser: TsNumFormatParser;
begin
parser := TsNumFormatParser.Create(Workbook, AFormatString, ANumFormat);
try
if parser.Status = psOK then begin
// For writing, we have to convert the fpc format string to Excel dialect
AFormatString := parser.FormatString[nfdExcel];
ANumFormat := parser.NumFormat;
end;
finally
parser.Free;
end;
end;
{ TsSpreadOOXMLReader } { TsSpreadOOXMLReader }
{------------------------------------------------------------------------------}
constructor TsSpreadOOXMLReader.Create(AWorkbook: TsWorkbook); constructor TsSpreadOOXMLReader.Create(AWorkbook: TsWorkbook);
begin begin
@ -492,11 +405,22 @@ begin
FSharedStrings.Free; FSharedStrings.Free;
FSharedFormulaBaseList.Free; // Don't free items, they are worksheet cells FSharedFormulaBaseList.Free; // Don't free items, they are worksheet cells
// FCellFormatList and FFontList are destroyed by ancestor // FCellFormatList, FNumFormatList and FFontList are destroyed by ancestor
inherited Destroy; inherited Destroy;
end; end;
{@@ ----------------------------------------------------------------------------
Adds the built-in number formats to the NumFormatList.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLReader.AddBuiltinNumFormats;
begin
FFirstNumFormatIndexInFile := 164;
AddBuiltInBiffFormats(
FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdDefault
);
end;
procedure TsSpreadOOXMLReader.ApplyCellFormatting(ACell: PCell; XFIndex: Integer); procedure TsSpreadOOXMLReader.ApplyCellFormatting(ACell: PCell; XFIndex: Integer);
var var
i: Integer; i: Integer;
@ -556,15 +480,10 @@ begin
Result := ''; Result := '';
end; end;
procedure TsSpreadOOXMLReader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsOOXMLNumFormatList.Create(Workbook);
end;
procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode); procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode);
function ReadBorderStyle(ANode: TDOMNode; out ABorderStyle: TsCellBorderStyle): Boolean; function ReadBorderStyle(ANode: TDOMNode;
out ABorderStyle: TsCellBorderStyle): Boolean;
var var
s: String; s: String;
colorNode: TDOMNode; colorNode: TDOMNode;
@ -675,8 +594,7 @@ var
sstIndex: Integer; sstIndex: Integer;
number: Double; number: Double;
fmt: TsCellFormat; fmt: TsCellFormat;
rng: TsCellRange; numFmt: TsNumFormatParams = nil;
r,c: Cardinal;
begin begin
if ANode = nil then if ANode = nil then
exit; exit;
@ -701,6 +619,9 @@ begin
end else end else
InitFormatRecord(fmt); InitFormatRecord(fmt);
// get number format parameters
numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
// get data // get data
datanode := ANode.FirstChild; datanode := ANode.FirstChild;
dataStr := ''; dataStr := '';
@ -754,10 +675,11 @@ begin
if (s = '') or (s = 'n') then begin if (s = '') or (s = 'n') then begin
// Number or date/time, depending on format // Number or date/time, depending on format
number := StrToFloat(dataStr, FPointSeparatorSettings); number := StrToFloat(dataStr, FPointSeparatorSettings);
if IsDateTimeFormat(fmt.NumberFormatStr) then begin if IsDateTimeFormat(numFmt) then
if fmt.NumberFormat <> nfTimeInterval then // no correction of time origin for "time interval" format begin
if not IsTimeIntervalFormat(numFmt) then // no correction of time origin for "time interval" format
number := ConvertExcelDateTimeToDateTime(number, FDateMode); number := ConvertExcelDateTimeToDateTime(number, FDateMode);
AWorksheet.WriteDateTime(cell, number, fmt.NumberFormatStr) AWorksheet.WriteDateTime(cell, number);
end end
else else
AWorksheet.WriteNumber(cell, number); AWorksheet.WriteNumber(cell, number);
@ -809,8 +731,9 @@ var
fmt: TsCellFormat; fmt: TsCellFormat;
fs: TsFillStyle; fs: TsFillStyle;
s1, s2: String; s1, s2: String;
i, numFmtIndex, fillIndex, borderIndex: Integer; numFmtIndex, fillIndex, borderIndex: Integer;
numFmtData: TsNumFormatData; numFmtStr: String;
numFmtParams: TsNumFormatParams;
fillData: TFillListData; fillData: TFillListData;
borderData: TBorderListData; borderData: TBorderListData;
fnt: TsFont; fnt: TsFont;
@ -832,14 +755,24 @@ begin
if (s1 <> '') and (s2 <> '0') then if (s1 <> '') and (s2 <> '0') then
begin begin
numFmtIndex := StrToInt(s1); numFmtIndex := StrToInt(s1);
i := NumFormatList.FindByIndex(numFmtIndex); numFmtStr := NumFormatList[numFmtIndex];
if i > -1 then if SameText(numFmtStr, 'General') then
numFmtParams := nil
else
begin begin
numFmtData := NumFormatList.Items[i]; fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr);
fmt.NumberFormat := numFmtData.NumFormat; numFmtParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
fmt.NumberFormatStr := numFmtData.FormatString; end;
if numFmtData.NumFormat <> nfGeneral then if numFmtParams <> nil then
begin
fmt.NumberFormat := numFmtParams.NumFormat;
fmt.NumberFormatStr := numFmtStr;
Include(fmt.UsedFormattingFields, uffNumberFormat); Include(fmt.UsedFormattingFields, uffNumberFormat);
end else
begin
fmt.NumberFormat := nfGeneral;
fmt.NumberFormatStr := '';
Exclude(fmt.UsedFormattingFields, uffNumberFormat);
end; end;
end; end;
@ -851,10 +784,6 @@ begin
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color); fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
{
if fmt.FontIndex = BOLD_FONTINDEX then
Include(fmt.UsedFormattingFields, uffBold)
else }
if fmt.FontIndex > 0 then if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont); Include(fmt.UsedFormattingFields, uffFont);
end; end;
@ -1344,22 +1273,28 @@ begin
end; end;
end; end;
procedure TsSpreadOOXMLReader.ReadNumFormats(ANode: TDOMNode); procedure TsSpreadOOXMLReader.ReadNumFormats(ANode: TDOMNode);
var var
node: TDOMNode; node: TDOMNode;
idStr: String; idStr: String;
fmtStr: String; fmtStr: String;
nodeName: String; nodeName: String;
id: Integer;
begin
if Assigned(ANode) then
begin begin
if Assigned(ANode) then begin
node := ANode.FirstChild; node := ANode.FirstChild;
while Assigned(node) do begin while Assigned(node) do
begin
nodeName := node.NodeName; nodeName := node.NodeName;
if nodeName = 'numFmt' then begin if nodeName = 'numFmt' then
idStr := GetAttrValue(node, 'numFmtId'); begin
fmtStr := GetAttrValue(node, 'formatCode'); fmtStr := GetAttrValue(node, 'formatCode');
NumFormatList.AnalyzeAndAdd(StrToInt(idStr), fmtStr); idStr := GetAttrValue(node, 'numFmtId');
id := StrToInt(idStr);
while id >= NumFormatList.Count do
NumFormatList.Add('');
NumFormatList[id] := fmtStr;
end; end;
node := node.NextSibling; node := node.NextSibling;
end; end;
@ -1787,7 +1722,33 @@ begin
end; end;
{------------------------------------------------------------------------------}
{ TsSpreadOOXMLWriter } { TsSpreadOOXMLWriter }
{------------------------------------------------------------------------------}
{@@ ----------------------------------------------------------------------------
Constructor of the OOXML writer
Defines the date mode and the limitations of the file format.
Initializes the format settings to be used when writing to xml.
-------------------------------------------------------------------------------}
constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
// Initial base date in case it won't be set otherwise.
// Use 1900 to get a bit more range between 1900..1904.
FDateMode := XlsxSettings.DateMode;
// Special version of FormatSettings using a point decimal separator for sure.
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
// http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
FLimitations.MaxColCount := 16384;
FLimitations.MaxRowCount := 1048576;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Looks for the combination of border attributes of the given format record in Looks for the combination of border attributes of the given format record in
@ -2044,8 +2005,6 @@ begin
'<commentList>'); '<commentList>');
// Comments // Comments
//IterateThroughComments(FSComments[FCurSheetNum], AWorksheet.Comments, WriteCommentsCallback);
for comment in AWorksheet.Comments do for comment in AWorksheet.Comments do
begin begin
txt := comment^.Text; txt := comment^.Text;
@ -2068,72 +2027,12 @@ begin
'</comment>'); '</comment>');
end; end;
(*
procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
var
comment: String;
begin
Unused(ACommentIndex);
comment := AComment^.Text;
ValidXMLText(comment);
// Write comment to Comments stream
AppendToStream(AStream, Format(
'<comment ref="%s" authorId="0">', [GetCellString(AComment^.Row, AComment^.Col)]));
AppendToStream(AStream,
'<text>'+
'<r>'+
'<rPr>'+ // this entire node could be omitted, but then Excel uses some default font out of control
'<sz val="9"/>'+
'<color rgb="000000" />'+ // It could be that color index 81 does not exist in fps files --> use rgb instead
'<rFont val="Arial"/>'+ // It is not harmful to Excel if the font does not exist.
'<charset val="1"/>'+
'</rPr>'+
'<t xml:space="preserve">' + comment + '</t>' +
'</r>'+
'</text>');
AppendToStream(AStream,
'</comment>');
end;
*)
// Footer // Footer
AppendToStream(FSComments[FCurSheetNum], AppendToStream(FSComments[FCurSheetNum],
'</commentList>'); '</commentList>');
AppendToStream(FSComments[FCurSheetNum], AppendToStream(FSComments[FCurSheetNum],
'</comments>'); '</comments>');
end; end;
(*
procedure TsSpreadOOXMLWriter.WriteCommentsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
var
comment: String;
begin
Unused(ACommentIndex);
comment := AComment^.Text;
ValidXMLText(comment);
// Write comment to Comments stream
AppendToStream(AStream, Format(
'<comment ref="%s" authorId="0">', [GetCellString(AComment^.Row, AComment^.Col)]));
AppendToStream(AStream,
'<text>'+
'<r>'+
'<rPr>'+ // this entire node could be omitted, but then Excel uses some default font out of control
'<sz val="9"/>'+
'<color rgb="000000" />'+ // It could be that color index 81 does not exist in fps files --> use rgb instead
'<rFont val="Arial"/>'+ // It is not harmful to Excel if the font does not exist.
'<charset val="1"/>'+
'</rPr>'+
'<t xml:space="preserve">' + comment + '</t>' +
'</r>'+
'</text>');
AppendToStream(AStream,
'</comment>');
end; *)
procedure TsSpreadOOXMLWriter.WriteDimension(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteDimension(AStream: TStream;
AWorksheet: TsWorksheet); AWorksheet: TsWorksheet);
@ -2311,32 +2210,34 @@ end;
FirstFormatIndexInFile. } FirstFormatIndexInFile. }
procedure TsSpreadOOXMLWriter.WriteNumFormatList(AStream: TStream); procedure TsSpreadOOXMLWriter.WriteNumFormatList(AStream: TStream);
var var
i: Integer; i, n: Integer;
item: TsNumFormatData; numFmtStr: String;
s: String; xmlStr: String;
n: Integer; parser: TsNumFormatParser;
begin begin
s := ''; xmlStr := '';
n := 0; n := 0;
i := NumFormatList.FindByIndex(NumFormatList.FirstNumFormatIndexInFile); for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do
if i > -1 then begin begin
while i < NumFormatList.Count do begin numFmtStr := NumFormatList[i];
item := NumFormatList[i]; parser := TsNumFormatParser.Create(Workbook, numFmtStr);
if item <> nil then begin try
s := s + Format('<numFmt numFmtId="%d" formatCode="%s" />', numFmtStr := UTF8TextToXMLText(parser.FormatString[nfdExcel]);
[item.Index, UTF8TextToXMLText(NumFormatList.FormatStringForWriting(i))]); xmlStr := xmlStr + Format('<numFmt numFmtId="%d" formatCode="%s" />',
[i, numFmtStr]);
inc(n); inc(n);
finally
parser.Free;
end; end;
inc(i);
end; end;
if n > 0 then if n > 0 then
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<numFmts count="%d">', [n]), '<numFmts count="%d">', [n]),
s, xmlStr,
'</numFmts>' '</numFmts>'
); );
end; end;
end;
{ Writes the workbook's color palette to the file } { Writes the workbook's color palette to the file }
procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream); procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream);
@ -2551,7 +2452,8 @@ var
// styleCell: TCell; // styleCell: TCell;
s, sAlign: String; s, sAlign: String;
fontID: Integer; fontID: Integer;
numFmtId: Integer; numFmtParams: TsNumFormatParams;
numFmtStr: String;
fillId: Integer; fillId: Integer;
borderId: Integer; borderId: Integer;
idx: Integer; idx: Integer;
@ -2570,19 +2472,18 @@ begin
{ Number format } { Number format }
if (uffNumberFormat in fmt^.UsedFormattingFields) then if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin begin
idx := NumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr); numFmtParams := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
if idx > -1 then begin if numFmtParams <> nil then
numFmtID := NumFormatList[idx].Index; begin
s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [numFmtId]); numFmtStr := numFmtParams.NumFormatStr[nfdExcel];
end; idx := NumFormatList.IndexOf(numFmtStr);
end else
idx := 0; // "General" format is at index 0
s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [idx]);
end; end;
{ Font } { Font }
fontId := 0; fontId := 0;
{
if (uffBold in fmt^.UsedFormattingFields) then
fontID := BOLD_FONTINDEX;
}
if (uffFont in fmt^.UsedFormattingFields) then if (uffFont in fmt^.UsedFormattingFields) then
fontID := fmt^.FontIndex; fontID := fmt^.FontIndex;
s := s + Format('fontId="%d" ', [fontId]); s := s + Format('fontId="%d" ', [fontId]);
@ -2715,48 +2616,11 @@ begin
' </v:shape>' + LineEnding); ' </v:shape>' + LineEnding);
end; end;
//IterateThroughComments(FSVmlDrawings[FCurSheetNum], AWorksheet.Comments, WriteVmlDrawingsCallback);
// Footer // Footer
AppendToStream(FSVmlDrawings[FCurSheetNum], AppendToStream(FSVmlDrawings[FCurSheetNum],
'</xml>'); '</xml>');
end; end;
procedure TsSpreadOOXMLWriter.WriteVmlDrawingsCallback(AComment: PsComment;
ACommentIndex: integer; AStream: TStream);
var
id: Integer;
begin
id := 1025 + ACommentIndex; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet
// My xml viewer does not format vml files property --> format in code.
AppendToStream(AStream, LineEnding + Format(
' <v:shape id="_x0000_s%d" type="#_x0000_t202" ', [id]) + LineEnding + Format(
' style="position:absolute; width:108pt; height:52.5pt; z-index:%d; visibility:hidden" ', [ACommentIndex+1]) + LineEnding +
// it is not necessary to specify margin-left and margin-top here!
// 'style=''position:absolute; margin-left:71.25pt; margin-top:1.5pt; ' + Format(
// 'width:108pt; height:52.5pt; z-index:%d; visibility:hidden'' ', [FDrawingCounter+1]) +
// 'width:108pt; height:52.5pt; z-index:1; visibility:hidden'' ' +
' fillcolor="#ffffe1" o:insetmode="auto"> '+ LineEnding +
' <v:fill color2="#ffffe1" />'+LineEnding+
' <v:shadow on="t" color="black" obscured="t" />'+LineEnding+
' <v:path o:connecttype="none" />'+LineEnding+
' <v:textbox style="mso-direction-alt:auto">'+LineEnding+
' <div style="text-align:left"></div>'+LineEnding+
' </v:textbox>' + LineEnding +
' <x:ClientData ObjectType="Note">'+LineEnding+
' <x:MoveWithCells />'+LineEnding+
' <x:SizeWithCells />'+LineEnding+
' <x:Anchor> 1, 15, 0, 2, 2, 79, 4, 4</x:Anchor>'+LineEnding+
' <x:AutoFill>False</x:AutoFill>'+LineEnding + Format(
' <x:Row>%d</x:Row>', [AComment^.Row]) + LineEnding + Format(
' <x:Column>%d</x:Column>', [AComment^.Col]) + LineEnding +
' </x:ClientData>'+ LineEnding+
' </v:shape>' + LineEnding);
end;
procedure TsSpreadOOXMLWriter.WriteWorksheetRels(AWorksheet: TsWorksheet); procedure TsSpreadOOXMLWriter.WriteWorksheetRels(AWorksheet: TsWorksheet);
var var
AVLNode: TAVLTreeNode; AVLNode: TAVLTreeNode;
@ -2973,12 +2837,7 @@ begin
XML_HEADER); XML_HEADER);
AppendToStream(FSContentTypes, AppendToStream(FSContentTypes,
'<Types xmlns="' + SCHEMAS_TYPES + '">'); '<Types xmlns="' + SCHEMAS_TYPES + '">');
(*
AppendToStream(FSContentTypes,
'<Override PartName="/_rels/.rels" ContentType="' + MIME_RELS + '" />');
AppendToStream(FSContentTypes,
'<Override PartName="/xl/_rels/workbook.xml.rels" ContentType="application/vnd.openxmlformats-package.relationships+xml" />');
*)
AppendToStream(FSContentTypes, Format( AppendToStream(FSContentTypes, Format(
'<Default Extension="rels" ContentType="%s" />', [MIME_RELS])); '<Default Extension="rels" ContentType="%s" />', [MIME_RELS]));
AppendToStream(FSContentTypes, Format( AppendToStream(FSContentTypes, Format(
@ -3039,30 +2898,21 @@ begin
'</worksheet>'); '</worksheet>');
end; end;
constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook); {@@ ----------------------------------------------------------------------------
Adds the built-in number formats to the NumFormatList.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.AddBuiltinNumFormats;
begin begin
inherited Create(AWorkbook); FFirstNumFormatIndexInFile := 164;
// Initial base date in case it won't be set otherwise. AddBuiltInBiffFormats(
// Use 1900 to get a bit more range between 1900..1904. FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdExcel
FDateMode := XlsxSettings.DateMode; );
// Special version of FormatSettings using a point decimal separator for sure.
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
// http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
FLimitations.MaxColCount := 16384;
FLimitations.MaxRowCount := 1048576;
end; end;
procedure TsSpreadOOXMLWriter.CreateNumFormatList; {@@ ----------------------------------------------------------------------------
begin Creates the streams for the individual data files. Will be zipped into a
FreeAndNil(FNumFormatList); single xlsx file.
FNumFormatList := TsOOXMLNumFormatList.Create(Workbook); -------------------------------------------------------------------------------}
end;
{ Creates the streams for the individual data files. Will be zipped into a
single xlsx file. }
procedure TsSpreadOOXMLWriter.CreateStreams; procedure TsSpreadOOXMLWriter.CreateStreams;
begin begin
if (boBufStream in Workbook.Options) then begin if (boBufStream in Workbook.Options) then begin
@ -3085,7 +2935,9 @@ begin
// FSSheets will be created when needed. // FSSheets will be created when needed.
end; end;
{ Destroys the streams that were created by the writer } {@@ ----------------------------------------------------------------------------
Destroys the streams that were created by the writer
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.DestroyStreams; procedure TsSpreadOOXMLWriter.DestroyStreams;
procedure DestroyStream(AStream: TStream); procedure DestroyStream(AStream: TStream);
@ -3119,7 +2971,10 @@ begin
SetLength(FSVmlDrawings, 0); SetLength(FSVmlDrawings, 0);
end; end;
{ Prepares a string formula for writing } {@@ ----------------------------------------------------------------------------
Prepares a string formula for writing: Deletes the leading = sign and makes
sure that it is a valid xml string.
-------------------------------------------------------------------------------}
function TsSpreadOOXMLWriter.PrepareFormula(const AFormula: String): String; function TsSpreadOOXMLWriter.PrepareFormula(const AFormula: String): String;
begin begin
Result := AFormula; Result := AFormula;
@ -3127,7 +2982,9 @@ begin
Result := UTF8TextToXMLText(Result) Result := UTF8TextToXMLText(Result)
end; end;
{ Is called before zipping the individual file parts. Rewinds the streams. } {@@ ----------------------------------------------------------------------------
Is called before zipping the individual file parts. Rewinds the streams.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.ResetStreams; procedure TsSpreadOOXMLWriter.ResetStreams;
var var
i: Integer; i: Integer;
@ -3144,23 +3001,26 @@ begin
for i:=0 to High(FSVmlDrawings) do ResetStream(FSVmlDrawings[i]); for i:=0 to High(FSVmlDrawings) do ResetStream(FSVmlDrawings[i]);
end; end;
{ {@@ ----------------------------------------------------------------------------
Writes a string to a file. Helper convenience method. Writes a string to a file. Helper convenience method.
} -------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteStringToFile(AFileName, AString: string); procedure TsSpreadOOXMLWriter.WriteStringToFile(AFileName, AString: string);
var var
TheStream : TFileStream; stream : TFileStream;
S : String; S : String;
begin begin
TheStream := TFileStream.Create(AFileName, fmCreate); stream := TFileStream.Create(AFileName, fmCreate);
try
S := AString; S := AString;
TheStream.WriteBuffer(Pointer(S)^,Length(S)); stream.WriteBuffer(Pointer(S)^, Length(S));
TheStream.Free; finally
stream.Free;
end;
end; end;
{ {@@ ----------------------------------------------------------------------------
Writes an OOXML document to the disc Writes an OOXML document to the file
} -------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteToFile(const AFileName: string; procedure TsSpreadOOXMLWriter.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean); const AOverwriteExisting: Boolean);
var var
@ -3188,7 +3048,7 @@ var
i: Integer; i: Integer;
begin begin
{ Analyze the workbook and collect all information needed } { Analyze the workbook and collect all information needed }
ListAllNumFormats; ListAllNumFormats(nfdExcel);
ListAllFills; ListAllFills;
ListAllBorders; ListAllBorders;
@ -3259,7 +3119,9 @@ begin
'</c>'); '</c>');
end; end;
{ Writes a boolean value to the stream } {@@ ----------------------------------------------------------------------------
Writes a boolean value to the stream
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteBool(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var var
@ -3274,7 +3136,9 @@ begin
'<c r="%s" s="%d" t="b"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText])); '<c r="%s" s="%d" t="b"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end; end;
{ Writes an error value to the specified cell. } {@@ ----------------------------------------------------------------------------
Writes an error value to the specified cell.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
begin begin
@ -3283,7 +3147,9 @@ begin
Unused(AValue, ACell); Unused(AValue, ACell);
end; end;
{ Writes a string formula to the given cell. } {@@ ----------------------------------------------------------------------------
Writes a string formula to the given cell.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell); const ARow, ACol: Cardinal; ACell: PCell);
var var
@ -3386,9 +3252,9 @@ begin
inc(FSharedStringsCount); inc(FSharedStringsCount);
end; end;
{ {@@ ----------------------------------------------------------------------------
Writes a number (64-bit IEE 754 floating point) to the sheet Writes a number (64-bit IEE 754 floating point) to the stream
} -------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteNumber(AStream: TStream; const ARow, procedure TsSpreadOOXMLWriter.WriteNumber(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: double; ACell: PCell); ACol: Cardinal; const AValue: double; ACell: PCell);
var var
@ -3403,12 +3269,11 @@ begin
'<c r="%s" s="%d" t="n"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText])); '<c r="%s" s="%d" t="n"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end; end;
{******************************************************************* {@@ ----------------------------------------------------------------------------
* TsSpreadOOXMLWriter.WriteDateTime () Writes a date/time value as a number
*
* DESCRIPTION: Writes a date/time value as a number Respects DateMode of the file
* Respects DateMode of the file -------------------------------------------------------------------------------}
*******************************************************************}
procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
var var
@ -3418,12 +3283,13 @@ begin
WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell); WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell);
end; end;
{
Registers this reader / writer on fpSpreadsheet
}
initialization initialization
// Registers this reader / writer on fpSpreadsheet
RegisterSpreadFormat(TsSpreadOOXMLReader, TsSpreadOOXMLWriter, sfOOXML); RegisterSpreadFormat(TsSpreadOOXMLReader, TsSpreadOOXMLWriter, sfOOXML);
// Create color palette for OOXML file format
MakeLEPalette(@PALETTE_OOXML, Length(PALETTE_OOXML)); MakeLEPalette(@PALETTE_OOXML, Length(PALETTE_OOXML));
end. end.