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

fpspreadsheet: Improved number format parser

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

3
components/fpspreadsheet/examples/other/demo_expression_parser.pas
View File

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

1
components/fpspreadsheet/examples/read_write/csvdemo/csvwrite.lpr
View File

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

89
components/fpspreadsheet/examples/read_write/excel2demo/excel2write.lpr
View File

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

9
components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr
View File

@ -336,6 +336,15 @@ begin
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, '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 := '';

6
components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr
View File

@ -361,6 +361,12 @@ begin
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, '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
MyWorksheet.WriteColWidth(0, 30);

1
components/fpspreadsheet/examples/read_write/ooxmldemo/ooxmlwrite.lpr
View File

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

10
components/fpspreadsheet/examples/read_write/opendocdemo/opendocwrite.lpr
View File

@ -203,6 +203,16 @@ begin
MyWorksheet.WriteCurrency(row, 6, number6, nfCurrencyRed, 2, '$', pcfCSV, ncfBCSVB);
MyWorksheet.WriteCurrency(row, 7, number7, 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);
MyWorksheet.WriteUTF8Text(row, 0, 'Some date/time values in various formats:');

1
components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi
View File

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

1
components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
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'
Hint = 'Save spreadsheet'
ImageIndex = 45
BeforeExecute = AcFileSaveAsBeforeExecute
OnAccept = AcFileSaveAsAccept
end
object AcViewInspector: TAction

9
components/fpspreadsheet/examples/visual/fpsctrls/main.pas
View File

@ -312,6 +312,7 @@ type
procedure AcColDeleteExecute(Sender: TObject);
procedure AcFileOpenAccept(Sender: TObject);
procedure AcFileSaveAsAccept(Sender: TObject);
procedure AcFileSaveAsBeforeExecute(Sender: TObject);
procedure AcRowAddExecute(Sender: TObject);
procedure AcRowDeleteExecute(Sender: TObject);
procedure AcSettingsCSVParamsExecute(Sender: TObject);
@ -405,6 +406,14 @@ begin
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 }
procedure TMainForm.AcRowAddExecute(Sender: TObject);
begin

7
components/fpspreadsheet/examples/visual/spready/spready.lpi
View File

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

5
components/fpspreadsheet/fpsactions.pas
View File

@ -1003,7 +1003,8 @@ var
nfs: String;
begin
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;
@ -1341,8 +1342,6 @@ var
txt: String;
cellStr: String;
hyperlink: TsHyperlink;
displayText: String;
cell: PCell;
begin
Unused(Target);

2
components/fpspreadsheet/fpsclasses.pas
View File

@ -290,7 +290,7 @@ begin
if FCurrentNode <> nil then
begin
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
begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);

2
components/fpspreadsheet/fpscurrency.pas
View File

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

561
components/fpspreadsheet/fpsnumformat.pas
View File

@ -11,132 +11,52 @@ uses
fpstypes, fpspreadsheet;
type
{@@ Contents of a number format record }
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;
{ TsNumFormatList }
{@@ Specialized list for number format items }
TsCustomNumFormatList = class(TFPList)
TsNumFormatList = class(TFPList)
private
function GetItem(AIndex: Integer): TsNumFormatData;
procedure SetItem(AIndex: Integer; AValue: TsNumFormatData);
FOwnsData: Boolean;
function GetItem(AIndex: Integer): TsNumFormatParams;
procedure SetItem(AIndex: Integer; const AValue: TsNumFormatParams);
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;
{@@ Identifies the first number format item that is written to the file. Items
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;
FClass: TsNumFormatParamsClass;
procedure AddBuiltinFormats; virtual;
procedure RemoveFormat(AIndex: Integer);
public
constructor Create(AWorkbook: TsWorkbook);
constructor Create(AWorkbook: TsWorkbook; AOwnsData: Boolean);
destructor Destroy; override;
function AddFormat(AFormatIndex: Integer; AFormatName: String;
ANumFormat: TsNumberFormat; AFormatString: String): 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);
function AddFormat(ASections: TsNumFormatSections): Integer; overload;
function AddFormat(AFormatStr: String; ADialect: TsNumFormatDialect): Integer; overload;
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);
function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; virtual;
function FindByFormatStr(AFormatString: String): Integer;
function FindByIndex(AFormatIndex: Integer): Integer;
function FindByName(AFormatName: String): Integer;
function FormatStringForWriting(AIndex: Integer): String; virtual;
procedure Sort;
function Find(ASections: TsNumFormatSections): Integer;
property Items[AIndex: Integer]: TsNumFormatParams read GetItem write SetItem; default;
{@@ 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. }
mainly needed to get access to the FormatSettings for easy localization of
some formatting strings. }
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;
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(AFormatStr: String): Boolean; overload;
function IsDateTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsTimeFormat(AFormat: TsNumberFormat): Boolean; overload;
function IsTimeFormat(AFormatStr: String): Boolean; overload;
function IsTimeFormat(ANumFormat: TsNumFormatParams): Boolean; overload;
function IsTimeIntervalFormat(ANumFormat: TsNumFormatParams): Boolean;
implementation
uses
Math,
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,
i.e. requires currency symbol.
@ -149,6 +69,19 @@ begin
Result := AFormat in [nfCurrency, nfCurrencyRed];
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.
@ -158,8 +91,9 @@ end;
-------------------------------------------------------------------------------}
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
begin
Result := AFormat in [{nfFmtDateTime, }nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval];
Result := AFormat in [nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM,
nfDayMonth, nfMonthYear, nfTimeInterval];
end;
{@@ ----------------------------------------------------------------------------
@ -181,6 +115,19 @@ begin
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.
@ -211,398 +158,128 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified number format parameters apply to time values.
{*******************************************************************************
* TsCustomNumFormatList *
*******************************************************************************}
@param ANumFormat Number format parameters
@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"
for localization of some formatting strings.
@param ANumFormat Number format parameters
@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
inherited Create;
FClass := TsNumFormatParams;
FWorkbook := AWorkbook;
AddBuiltinFormats;
FOwnsData := AOwnsData;
end;
{@@ ----------------------------------------------------------------------------
Destructor of the number format list: clears the list and destroys the
format items
-------------------------------------------------------------------------------}
destructor TsCustomNumFormatList.Destroy;
destructor TsNumFormatList.Destroy;
begin
Clear;
inherited Destroy;
inherited;
end;
{@@ ----------------------------------------------------------------------------
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;
function TsNumFormatList.AddFormat(ASections: TsNumFormatSections): Integer;
var
item: TsNumFormatData;
item: TsNumFormatParams;
begin
item := TsNumFormatData.Create;
item.Index := AFormatIndex;
item.Name := AFormatName;
item.NumFormat := ANumFormat;
item.FormatString := AFormatString;
Result := Find(ASections);
if Result = -1 then begin
item := FClass.Create;
item.Sections := ASections;
Result := inherited Add(item);
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;
{@@ ----------------------------------------------------------------------------
Adds a number format described by the ODF format name, 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 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);
function TsNumFormatList.AddFormat(AFormatStr: String;
ADialect: TsNumFormatDialect): Integer;
var
parser: TsNumFormatParser;
fmt: String;
lFormatData: TsNumFormatData;
newSections: TsNumFormatSections;
i: Integer;
begin
i := FindByIndex(AFormatIndex);
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);
parser := TsNumFormatParser.Create(FWorkbook, AFormatStr, ADialect);
try
if parser.Status = psOK then
SetLength(newSections, parser.ParsedSectionCount);
for i:=0 to High(newSections) do
begin
ANumFormat := parser.NumFormat;
AFormatString := parser.FormatString[nfdDefault];
end else
begin
// Show an error here?
newSections[i] := parser.ParsedSections[i];
end;
Result := AddFormat(newSections);
finally
parser.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
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);
procedure TsNumFormatList.AddBuiltinFormats;
begin
Unused(AFormatString, ANumFormat);
// nothing to do here. But see, e.g., xlscommon.TsBIFFNumFormatList
end;
{@@ ----------------------------------------------------------------------------
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;
procedure TsNumFormatList.Clear;
var
item: TsNumFormatData;
i: Integer;
begin
for Result := Count-1 downto 0 do
begin
item := Items[Result];
if (item <> nil) and (item.NumFormat = ANumFormat) and (item.FormatString = AFormatString)
then exit;
end;
Result := -1;
for i := Count-1 downto 0 do Delete(i);
inherited;
end;
{@@ ----------------------------------------------------------------------------
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;
procedure TsNumFormatList.Delete(AIndex: Integer);
var
item: TsNumFormatData;
p: TsNumFormatParams;
begin
{ We search backwards to find user-defined items first. They usually are
more appropriate than built-in items. }
for Result := Count-1 downto 0 do
if FOwnsData then
begin
item := Items[Result];
if item.FormatString = AFormatString then
p := GetItem(AIndex);
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;
end;
Result := -1;
end;
{@@ ----------------------------------------------------------------------------
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;
function TsNumFormatList.GetItem(AIndex: Integer): TsNumFormatParams;
begin
for Result := 0 to Count-1 do
begin
item := Items[Result];
if item.Index = AFormatIndex then
exit;
end;
Result := -1;
Result := TsNumFormatParams(inherited Items[AIndex]);
end;
{@@ ----------------------------------------------------------------------------
Finds the item with the given ODS format name and returns its index in
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);
procedure TsNumFormatList.SetItem(AIndex: Integer;
const AValue: TsNumFormatParams);
begin
inherited Items[AIndex] := AValue;
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.

1047
components/fpspreadsheet/fpsnumformatparser.pas
View File

File diff suppressed because it is too large Load Diff

618
components/fpspreadsheet/fpsopendocument.pas
View File

File diff suppressed because it is too large Load Diff

382
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -98,9 +98,6 @@ type
FLeftPaneWidth: Integer;
FTopPaneHeight: Integer;
FOptions: TsSheetOptions;
// FLastFoundCell: PCell;
// FLastFoundRow: Cardinal;
// FLastFoundCol: Cardinal;
FFirstRowIndex: Cardinal;
FFirstColIndex: Cardinal;
FLastRowIndex: Cardinal;
@ -204,10 +201,12 @@ type
procedure WriteCurrency(ACell: PCell; AValue: Double;
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;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''): PCell; overload;
ANumFormat: TsNumberFormat; ANumFormatStr: String = ''): PCell; overload;
procedure WriteDateTime(ACell: PCell; AValue: TDateTime;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''); overload;
ANumFormat: TsNumberFormat; ANumFormatStr: String = ''); overload;
function WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
ANumFormatStr: String): PCell; overload;
procedure WriteDateTime(ACell: PCell; AValue: TDateTime;
@ -358,11 +357,8 @@ type
function FindCell(AddressStr: String): PCell; overload;
function GetCell(ARow, ACol: Cardinal): PCell; overload;
function GetCell(AddressStr: String): PCell; overload;
function GetCellCount: Cardinal;
// function GetFirstCellOfRow(ARow: Cardinal): PCell;
// function GetLastCellOfRow(ARow: Cardinal): PCell;
function GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastColIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex';
@ -439,7 +435,7 @@ type
procedure UnmergeCells(ARow, ACol: Cardinal); overload;
procedure UnmergeCells(ARange: String); overload;
// Notification of changed cells content and format
// Notification of changed cells
procedure ChangedCell(ARow, ACol: Cardinal);
procedure ChangedFont(ARow, ACol: Cardinal);
@ -580,8 +576,9 @@ type
procedure RemoveWorksheetsCallback(data, arg: pointer);
protected
FCellFormatList: TsCellFormatList;
FFontList: TFPList;
FNumFormatList: TFPList;
FCellFormatList: TsCellFormatList;
{ Internal methods }
procedure GetLastRowColIndex(out ALastRow, ALastCol: Cardinal);
@ -664,6 +661,11 @@ type
ASize: Single; AStyle: TsFontStyles; AColor: TsColor);
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 }
function AddColorToPalette(AColorValue: TsColorValue): TsColor;
function FindClosestColor(AColorValue: TsColorValue;
@ -690,12 +692,6 @@ type
{@@ Identifies the "active" worksheet (only for visual controls)}
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 }
property ErrorMsg: String read GetErrorMsg;
{@@ Filename of the saved workbook }
@ -1112,10 +1108,6 @@ begin
FActiveCellRow := Cardinal(-1);
FActiveCellCol := Cardinal(-1);
{ FLastFoundCell := nil;
FLastFoundRow := Cardinal(-1);
FLastFoundCol := Cardinal(-1);}
FOptions := [soShowGridLines, soShowHeaders];
end;
@ -2090,17 +2082,6 @@ end;
function TsWorksheet.FindCell(ARow, ACol: Cardinal): PCell;
begin
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;
{@@ ----------------------------------------------------------------------------
@ -2361,29 +2342,7 @@ begin
for cell in FCells do
Result := Math.Max(Result, cell^.Col);
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.
If no cells have contents, -1 will be returned.
@ -2513,70 +2472,25 @@ begin
Result := ReadAsUTF8Text(ACell, FWorkbook.FormatSettings);
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;
AFormatSettings: TFormatSettings): string; //ansistring;
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;
AFormatSettings: TFormatSettings): string;
var
fmt: PsCellFormat;
hyperlink: PsHyperlink;
numFmt: TsNumFormatParams;
nf: TsNumberFormat;
nfs: String;
begin
Result := '';
@ -2584,16 +2498,36 @@ begin
Exit;
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
with ACell^ do
case ContentType of
cctNumber:
Result := FloatToStrNoNaN(NumberValue, fmt^.NumberFormat, fmt^.NumberFormatStr);
cctUTF8String:
Result := UTF8StringValue;
cctNumber:
Result := ConvertFloatToStr(NumberValue, numFmt, AFormatSettings);
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:
Result := StrUtils.IfThen(BoolValue, rsTRUE, rsFALSE);
cctError:
case TsErrorValue(ErrorValue) of
errEmptyIntersection : Result := rsErrEmptyIntersection;
@ -2605,7 +2539,8 @@ begin
errArgError : Result := rsErrArgError;
errFormulaNotSupported: Result := rsErrFormulaNotSupported;
end;
else
else // blank --> display hyperlink target if available
Result := '';
if HasHyperlink(ACell) then
begin
@ -2773,20 +2708,6 @@ begin
end else
Result := False;
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
@ -2992,11 +2913,6 @@ begin
if ACell <> nil then
begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
{
if (uffBold in fmt^.UsedFormattingFields) then
Result := Workbook.GetFont(BOLD_FONTINDEX)
else
}
Result := Workbook.GetFont(fmt^.FontIndex);
end;
if Result = nil then
@ -3034,6 +2950,7 @@ procedure TsWorksheet.ReadNumFormat(ACell: PCell; out ANumFormat: TsNumberFormat
out ANumFormatStr: String);
var
fmt: PsCellFormat;
numFmt: TsNumFormatParams;
begin
ANumFormat := nfGeneral;
ANumFormatStr := '';
@ -3042,8 +2959,16 @@ begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin
ANumFormat := fmt^.NumberFormat;
ANumFormatStr := fmt^.NumberFormatStr;
numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
if numFmt <> nil then
begin
ANumFormat := numFmt.NumFormat;
ANumFormatStr := numFmt.NumFormatStr[nfdDefault];
end else
begin
ANumFormat := nfGeneral;
ANumFormatStr := '';
end;
end;
end;
end;
@ -3294,7 +3219,6 @@ begin
Result := (ACell <> nil) and (cfMerged in ACell^.Flags);
end;
{@@ ----------------------------------------------------------------------------
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;
var
//r,c: Cardinal;
cell: PCell;
begin
result := false;
for cell in Cells.GetRangeEnumerator(ARowFrom, AColFrom, ARowTo, AColTo) do
if IsMerged(cell) then
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;
begin
@ -3781,7 +3695,7 @@ begin
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 ACol Cell column index
@ -3795,13 +3709,12 @@ begin
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 ACol Cell column index
@param ACell Pointer to the cell
@param ANumber Number to be written
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: double);
procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double);
begin
if ACell <> nil then begin
ACell^.ContentType := cctNumber;
@ -3822,7 +3735,7 @@ end;
@see TsNumberFormat
-------------------------------------------------------------------------------}
function TsWorksheet.WriteNumber(ARow, ACol: Cardinal; ANumber: double;
ANumFormat: TsNumberFormat; ADecimals: Byte = 2): PCell;
ANumFormat: TsNumberFormat = nfGeneral; ADecimals: Byte = 2): PCell;
begin
Result := GetCell(ARow, ACol);
WriteNumber(Result, ANumber, ANumFormat, ADecimals);
@ -3835,12 +3748,15 @@ end;
@param ANumber Number to be written
@param ANumFormat Identifier for a built-in number format, e.g. nfFixed
@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
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double;
ANumFormat: TsNumberFormat; ADecimals: Byte = 2);
var
fmt: TsCellFormat;
nfs: String;
begin
if IsDateTimeFormat(ANumFormat) or IsCurrencyFormat(ANumFormat) then
raise Exception.Create(rsInvalidNumberFormat);
@ -3853,11 +3769,16 @@ begin
fmt.NumberFormat := ANumFormat;
if ANumFormat <> nfGeneral then begin
Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := BuildNumberFormatString(fmt.NumberFormat,
Workbook.FormatSettings, ADecimals);
if ANumFormat = nfFraction then
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
Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := '';
fmt.NumberFormatIndex := -1;
end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -3921,13 +3842,12 @@ begin
ACell^.NumberValue := ANumber;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormat := ANumFormat;
if ANumFormat <> nfGeneral then begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(ANumFormatString);
Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := ANumFormatString;
end else begin
Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := '';
fmt.NumberFormatIndex := -1;
end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -4222,20 +4142,51 @@ procedure TsWorksheet.WriteCurrency(ACell: PCell; AValue: Double;
var
fmt: TsCellFormat;
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
ACell^.ContentType := cctNumber;
ACell^.NumberValue := AValue;
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormatIndex := Workbook.AddNumberFormat(ANumFormatString);
Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormat := ANumFormat;
fmt.NumberFormatStr := ANumFormatString;
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col);
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
@ -4252,7 +4203,7 @@ end;
as a date (either built-in or a custom format).
-------------------------------------------------------------------------------}
function TsWorksheet.WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = ''): PCell;
ANumFormat: TsNumberFormat; ANumFormatStr: String = ''): PCell;
begin
Result := GetCell(ARow, ACol);
WriteDateTime(Result, AValue, ANumFormat, ANumFormatStr);
@ -4272,7 +4223,7 @@ end;
as a date (either built-in or a custom format).
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteDateTime(ACell: PCell; AValue: TDateTime;
ANumFormat: TsNumberFormat = nfShortDateTime; ANumFormatStr: String = '');
ANumFormat: TsNumberFormat; ANumFormatStr: String = '');
var
parser: TsNumFormatParser;
fmt: TsCellFormat;
@ -4320,6 +4271,7 @@ begin
Include(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormat := ANumFormat;
fmt.NumberFormatStr := ANumFormatStr;
fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmt.NumberFormatStr);
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col);
@ -4452,27 +4404,25 @@ procedure TsWorksheet.WriteDecimals(ACell: PCell; ADecimals: Byte);
var
parser: TsNumFormatParser;
fmt: TsCellFormat;
numFmt: TsNumFormatParams;
numFmtStr: String;
begin
if (ACell = nil) then
exit;
fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex);
if (uffNumberFormat in fmt.UsedFormattingFields) or (fmt.NumberFormat = nfGeneral)
then
WriteNumberFormat(ACell, nfFixed, ADecimals)
else
if fmt.NumberFormat <> nfCustom then
begin
parser := TsNumFormatParser.Create(Workbook, fmt.NumberFormatStr);
numFmt := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex);
numFmtStr := numFmt.NumFormatStr[nfdDefault];
parser := TsNumFormatParser.Create(Workbook, numFmtStr);
try
parser.Decimals := ADecimals;
fmt.NumberFormatStr := parser.FormatString[nfdDefault];
finally
parser.Free;
end;
numFmtStr := parser.FormatString[nfdDefault];
fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr);
Include(fmt.UsedFormattingFields, uffNumberFormat);
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col);
finally
parser.Free;
end;
end;
@ -4606,6 +4556,7 @@ procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1);
var
fmt: TsCellFormat;
fmtStr: String;
begin
if ACell = nil then
exit;
@ -4616,16 +4567,17 @@ begin
Include(fmt.UsedFormattingFields, uffNumberFormat);
if ANumFormat in [nfCurrency, nfCurrencyRed] then
begin
fmt.NumberFormatStr := BuildCurrencyFormatString(nfdDefault, ANumFormat,
RegisterCurrency(ACurrencySymbol);
fmtStr := BuildCurrencyFormatString(nfdDefault, ANumFormat,
Workbook.FormatSettings, ADecimals,
APosCurrFormat, ANegCurrFormat, ACurrencySymbol);
RegisterCurrency(ACurrencySymbol);
end else
fmt.NumberFormatStr := BuildNumberFormatString(ANumFormat,
fmtStr := BuildNumberFormatString(ANumFormat,
Workbook.FormatSettings, ADecimals);
fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
end else begin
Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := '';
fmt.NumberFormatIndex := -1;
end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -4667,14 +4619,14 @@ procedure TsWorksheet.WriteFractionFormat(ACell: PCell;
AMixedFraction: Boolean; ANumeratorDigits, ADenominatorDigits: Integer);
var
fmt: TsCellFormat;
nfs: String;
begin
if ACell = nil then
exit;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormat := nfFraction;
fmt.NumberFormatStr := BuildFractionFormatString(AMixedFraction,
ANumeratorDigits, ADenominatorDigits);
nfs := BuildFractionFormatString(AMixedFraction, ANumeratorDigits, ADenominatorDigits);
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
Include(fmt.UsedFormattingFields, uffNumberFormat);
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -4714,21 +4666,22 @@ procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
ANumFormat: TsNumberFormat; const ANumFormatString: String = '');
var
fmt: TsCellFormat;
fmtStr: String;
begin
if ACell = nil then
exit;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.NumberFormat := ANumFormat;
if ANumFormat <> nfGeneral then begin
Include(fmt.UsedFormattingFields, uffNumberFormat);
if (ANumFormatString = '') then
fmt.NumberFormatStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings)
fmtStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings)
else
fmt.NumberFormatStr := ANumFormatString;
fmtStr := ANumFormatString;
fmt.NumberFormatIndex := Workbook.AddNumberFormat(fmtStr);
end else begin
Exclude(fmt.UsedFormattingFields, uffNumberFormat);
fmt.NumberFormatStr := '';
fmt.NumberFormatIndex := -1;
end;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
@ -5112,7 +5065,6 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@ ----------------------------------------------------------------------------
Defines a background pattern for a cell
@ -6334,6 +6286,7 @@ begin
SetDefaultFont(DEFAULT_FONTNAME, DEFAULT_FONTSIZE);
InitFonts;
FNumFormatList := TsNumFormatList.Create(self, true);
FCellFormatList := TsCellFormatList.Create(false);
// Add default cell format
@ -6351,6 +6304,7 @@ begin
FWorksheets.Free;
FCellFormatList.Free;
FNumFormatList.Free;
FFontList.Free;
FLog.Free;
@ -6700,6 +6654,7 @@ begin
AWriter := CreateSpreadWriter(AFormat);
try
FFileName := AFileName;
FFormat := AFormat;
PrepareBeforeSaving;
AWriter.CheckLimitations;
FReadWriteFlag := rwfWrite;
@ -7202,16 +7157,13 @@ var
fmt: PsCellFormat;
cb: TsCellBorder;
s: String;
numFmt: TsNumFormatParams;
begin
Result := '';
fmt := GetPointerToCellFormat(AIndex);
if fmt = nil then
exit;
{
if (uffBold in fmt^.UsedFormattingFields) then
Result := Format('%s; bold', [Result]);
}
if (uffFont in fmt^.UsedFormattingFields) then
Result := Format('%s; Font%d', [Result, fmt^.FontIndex]);
if (uffBackground in fmt^.UsedFormattingFields) then begin
@ -7226,10 +7178,17 @@ begin
if (uffWordwrap in fmt^.UsedFormattingFields) then
Result := Format('%s; Word-wrap', [Result]);
if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin
numFmt := GetNumberFormat(fmt^.NumberFormatIndex);
if numFmt <> nil then
Result := Format('%s; %s (%s)', [Result,
GetEnumName(TypeInfo(TsNumberFormat), ord(fmt^.NumberFormat)),
fmt^.NumberFormatStr
]);
GetEnumName(TypeInfo(TsNumberFormat), ord(numFmt.NumFormat)),
numFmt.NumFormatStr[nfdDefault]
])
else
Result := Format('%s; %s', [Result, 'nfGeneral']);
end else
Result := Format('%s; %s', [Result, 'nfGeneral']);
if (uffBorder in fmt^.UsedFormattingFields) then
begin
s := '';
@ -7505,6 +7464,39 @@ begin
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
color does not already exist - in this case, it returns the index of the

18
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

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

49
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -19,7 +19,11 @@ unit fpspreadsheetgrid;
- When Lazarus 1.4 comes out remove the workaround for the RGB2HLS bug in
FindNearestPaletteIndex.
- 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
@ -585,7 +589,7 @@ procedure Register;
implementation
uses
Types, LCLType, LCLIntf, LCLProc, Math,
Types, LCLType, LCLIntf, LCLProc, Math, StrUtils,
fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils;
const
@ -1334,6 +1338,9 @@ var
style: TFontStyles;
isSelected: Boolean;
fgcolor, bgcolor: TColor;
numFmt: TsNumFormatParams;
sidx: Integer;
clr: Integer;
begin
GetSelectedState(AState, isSelected);
Canvas.Font.Assign(Font);
@ -1367,6 +1374,7 @@ begin
if lCell <> nil then
begin
fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex);
numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
// Background color
if (uffBackground in fmt^.UsedFormattingFields) then
@ -1424,10 +1432,26 @@ begin
if fssStrikeout in fnt.Style then Include(style, fsStrikeout);
Canvas.Font.Style := style;
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
not IsNaN(lCell^.NumberValue) and (lCell^.NumberValue < 0)
then
Canvas.Font.Color := Workbook.GetPaletteColor(scRed);
}
// Wordwrap, text alignment and text rotation are handled by "DrawTextInCell".
end;
end;
@ -3834,8 +3858,10 @@ var
p: Integer;
isRotated: Boolean;
isStacked: Boolean;
tr: TsTextRotation;
fmt: PsCellFormat;
numFmt: TsNumFormatParams;
nfs: String;
isGeneralFmt: Boolean;
begin
Result := Worksheet.ReadAsUTF8Text(ACell);
if (Result = '') or ((ACell <> nil) and (ACell^.ContentType = cctUTF8String))
@ -3843,11 +3869,10 @@ begin
exit;
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
tr := fmt^.TextRotation;
isRotated := (tr <> trHorizontal);
isStacked := (tr = rtStacked);
// isRotated := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation <> trHorizontal);
// isStacked := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation = rtStacked);
isRotated := (fmt^.TextRotation <> trHorizontal);
isStacked := (fmt^.TextRotation = rtStacked);
numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
isGeneralFmt := (numFmt = nil);
// Determine space available in cell
if isRotated then
@ -3865,7 +3890,7 @@ begin
if txtSize <= cellSize then
exit;
if (ACell^.ContentType = cctNumber) and (fmt^.NumberFormat = nfGeneral) then
if (ACell^.ContentType = cctNumber) and isGeneralFmt then
begin
// Determine number of decimal places
p := pos(Workbook.FormatSettings.DecimalSeparator, Result);
@ -3893,7 +3918,9 @@ begin
while decs > 0 do
begin
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
txtSize := Length(Result) * Canvas.TextHeight('A')
else
@ -3966,6 +3993,8 @@ var
lRow: PRow;
h: Integer;
begin
Unused(AStartIndex);
{
BeginUpdate;
if AStartIndex <= 0 then AStartIndex := FHeaderCount;

82
components/fpspreadsheet/fpsreaderwriter.pas
View File

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

6
components/fpspreadsheet/fpsstrings.pas
View File

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

334
components/fpspreadsheet/fpstypes.pas
View File

@ -196,27 +196,6 @@ type
{@@ Describes which formatting fields are active }
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
{ @@ Codes for curreny format according to FormatSettings.CurrencyFormat:
"C" = currency symbol, "V" = currency value, "S" = space character
@ -450,6 +429,112 @@ type
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 }
TsCalcState = (csNotCalculated, csCalculating, csCalculated);
@ -512,6 +597,8 @@ type
Border: TsCellBorders;
BorderStyles: TsCelLBorderStyles;
Background: TsFillPattern;
NumberFormatIndex: Integer;
// next two are deprecated...
NumberFormat: TsNumberFormat;
NumberFormatStr: String;
end;
@ -573,9 +660,15 @@ type
cctError : (ErrorValue: TsErrorValue);
end;
function BuildFormatStringFromSection(const ASection: TsNumFormatSection;
ADialect: TsNumFormatDialect): String;
implementation
uses
StrUtils;
{ TsCellFormatList }
constructor TsCellFormatList.Create(AAllowDuplicates: Boolean);
@ -610,6 +703,7 @@ begin
P^.Border := AItem.Border;
P^.BorderStyles := AItem.BorderStyles;
P^.Background := AItem.Background;
P^.NumberFormatIndex := AItem.NumberFormatIndex;
P^.NumberFormat := AItem.NumberFormat;
P^.NumberFormatStr := AItem.NumberFormatStr;
Result := inherited Add(P);
@ -725,6 +819,7 @@ begin
end;
if (uffNumberFormat in AItem.UsedFormattingFields) then begin
if (P^.NumberFormatIndex <> AItem.NumberFormatIndex) then continue;
if (P^.NumberFormat <> AItem.NumberFormat) then continue;
if (P^.NumberFormatStr <> AItem.NumberFormatStr) then continue;
end;
@ -743,5 +838,202 @@ begin
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.

894
components/fpspreadsheet/fpsutils.pas
View File

@ -113,8 +113,6 @@ function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function AddIntervalBrackets(AFormatString: String): String;
function DayNamesToString(const ADayNames: TWeekNameArray;
const AEmptyStr: String): String;
procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer;
out ANumerator, ADenominator: Integer);
function MakeLongDateFormat(ADateFormat: String): String;
function MakeShortDateFormat(ADateFormat: String): String;
function MonthNamesToString(const AMonthNames: TMonthNameArray;
@ -126,9 +124,12 @@ procedure SplitFormatString(const AFormatString: String; out APositivePart,
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;
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AMaxDigits: Integer): Boolean;
@ -172,6 +173,7 @@ procedure Unused(const A1);
procedure Unused(const A1, A2);
procedure Unused(const A1, A2, A3);
var
{@@ Default value for the screen pixel density (pixels per inch). Is needed
for conversion of distances to pixels}
@ -952,6 +954,9 @@ end;
-------------------------------------------------------------------------------}
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = '') : string;
var
i, j: Integer;
Unwanted: set of ansichar;
begin
case ANumberFormat of
nfShortDateTime:
@ -977,9 +982,34 @@ begin
if pos('a', lowercase(AFormatSettings.LongTimeFormat)) = 0 then
Result := AddAMPM(Result, AFormatSettings);
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
if AFormatString = '' then
Result := '[h]:mm:ss'
Result := '[h]:nn:ss'
else
Result := AddIntervalBrackets(AFormatString);
end;
@ -1115,7 +1145,8 @@ begin
if ACurrencySymbol <> '' then begin
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(p, ['0'+decs, ACurrencySymbol]);
end
@ -1343,88 +1374,75 @@ end;
@param ANumerator (out) Numerator of the best approximating fraction
@param ADenominator (out) Denominator of the best approximating fraction
-------------------------------------------------------------------------------}
procedure FloatToFraction(AValue: Double; AMaxNumerator, AMaxDenominator: Integer;
out ANumerator, ADenominator: Integer);
// "Stern-Brocot-Tree"
// Original from : http://stackoverflow.com/questions/5124743/algorithm-for-simplifying-decimal-to-fractions
// Procedure adapted by forum user "circular": http://forum.lazarus.freepascal.org/index.php/topic,27805.msg172372.html#msg172372
procedure FloatToFraction(AValue, APrecision: Double;
AMaxNumerator, AMaxDenominator: Int64; out ANumerator, ADenominator: Int64);
// Uses method of continued fractions, adapted version from a function in
// Bart Broersma's fractions.pp unit:
// http://svn.code.sf.net/p/flyingsheep/code/trunk/ConsoleProjecten/fractions/
const
MaxInt64 = High(Int64);
MinInt64 = Low(Int64);
var
n: Integer;
lower_n, lower_d, upper_n, upper_d, middle_n, middle_d: Integer;
isNeg: Boolean;
backup_num, backup_denom: Integer;
newResult_num, newResult_denom: Integer;
EPS: Double;
H1, H2, K1, K2, A, NewA, tmp, prevH1, prevK1: Int64;
B, diff, test, eps: Double;
Found, PendingOverflow: Boolean;
i: Integer = 0;
begin
EPS := 0.01 / AMaxDenominator;
Assert((APrecision > 0) and (APrecision < 1));
isNeg := AValue < 0;
if isNeg then
AValue := -AValue;
if (AValue > MaxInt64) or (AValue < MinInt64) then
raise Exception.Create('Range error');
n := Trunc(AValue);
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
if abs(AValue) < 0.5 / AMaxDenominator then
begin
if abs(newResult_num/newResult_denom - n - AValue) <
abs(backup_num/backup_denom - n - AValue)
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;
ANumerator := 0;
ADenominator := AMaxDenominator;
exit;
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.
@ -2330,6 +2348,7 @@ begin
FillChar(AValue, SizeOf(AValue), 0);
AValue.BorderStyles := DEFAULT_BORDERSTYLES;
AValue.Background := EMPTY_FILL;
AValue.NumberFormatIndex := -1; // GENERAL format not contained in NumFormatList
end;
{@@ ----------------------------------------------------------------------------
@ -2373,6 +2392,725 @@ begin
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 }
{ Next function are copies of GraphUtils to avoid a dependence on the Graphics unit. }

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

@ -230,8 +230,14 @@ begin
SollNumberStrings[i, 5] := FormatFloat('0.00E+00', SollNumbers[i], fs);
SollNumberStrings[i, 6] := FormatFloat('0', 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, 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;
// Date/time values

22
components/fpspreadsheet/tests/internaltests.pas
View File

@ -51,6 +51,8 @@ type
// Test buffered stream
procedure TestReadBufStream;
procedure TestWriteBufStream;
// Test fractions
procedure FractionTest;
end;
implementation
@ -395,6 +397,26 @@ begin
CheckEquals(s, GetCellString(r, c, flags));
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;
begin

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

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

11
components/fpspreadsheet/wikitable.pas
View File

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

304
components/fpspreadsheet/xlsbiff2.pas
View File

@ -34,7 +34,7 @@ interface
uses
Classes, SysUtils, lconvencoding,
fpsTypes, fpsNumFormat, fpspreadsheet, fpsUtils, xlscommon;
fpsTypes, fpspreadsheet, fpsUtils, xlscommon;
const
BIFF2_MAX_PALETTE_SIZE = 8;
@ -42,33 +42,21 @@ const
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 = class(TsSpreadBIFFReader)
private
// WorkBookEncoding: TsEncoding;
FFont: TsFont;
FPendingXFIndex: Word;
protected
procedure CreateNumFormatList; override;
procedure AddBuiltinNumFormats; override;
procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override;
procedure ReadColWidth(AStream: TStream);
procedure ReadDefRowHeight(AStream: TStream);
procedure ReadFont(AStream: TStream);
procedure ReadFontColor(AStream: TStream);
procedure ReadFormat(AStream: TStream); override;
procedure ReadFONT(AStream: TStream);
procedure ReadFONTCOLOR(AStream: TStream);
procedure ReadFORMAT(AStream: TStream); override;
procedure ReadFormula(AStream: TStream); override;
procedure ReadInteger(AStream: TStream);
procedure ReadIXFE(AStream: TStream);
@ -88,6 +76,7 @@ type
procedure ReadFromStream(AStream: TStream); override;
end;
{ TsSpreadBIFF2Writer }
TsSpreadBIFF2Writer = class(TsSpreadBIFFWriter)
@ -107,13 +96,12 @@ type
procedure WriteFormatCount(AStream: TStream);
procedure WriteIXFE(AStream: TStream; XFIndex: Word);
protected
procedure CreateNumFormatList; override;
procedure ListAllNumFormats; override;
procedure AddBuiltinNumFormats; override;
procedure ListAllNumFormats(ADialect: TsNumFormatDialect); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
// procedure WriteCodePage(AStream: TStream; AEncoding: TsEncoding); override;
procedure WriteCodePage(AStream: TStream; ACodePage: String); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override;
@ -121,19 +109,14 @@ type
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override;
procedure WriteNumFormat(AStream: TStream; ANumFormatData: TsNumFormatData;
AListIndex: Integer); override;
procedure WriteNumFormat(AStream: TStream; ANumFormatStr: String;
AFormatIndex: Integer); override;
procedure WriteRow(AStream: TStream; ASheet: TsWorksheet;
ARowIndex, AFirstColIndex, ALastColIndex: Cardinal; ARow: PRow); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); 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 WriteSharedFormula(AStream: TStream; ACell: PCell); override;
procedure WriteStringRecord(AStream: TStream; AString: String); override;
procedure WriteWindow1(AStream: TStream); override;
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
@ -176,7 +159,7 @@ var
implementation
uses
Math, fpsStrings, fpsReaderWriter, fpsNumFormatParser;
Math, fpsStrings, fpsReaderWriter;
const
{ Excel record IDs }
@ -268,113 +251,44 @@ type
end;
{ TsBIFF2NumFormatList }
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;
procedure InternalAddBuiltinNumFormats(AList: TStringList;
AFormatSettings: TFormatSettings; ADialect: TsNumFormatDialect);
var
fs: TFormatSettings;
cs: string;
fs: TFormatSettings absolute AFormatSettings;
cs: String;
begin
fs := FWorkbook.FormatSettings;
cs := fs.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, 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;
with AList do
begin
Unused(ANumFormat);
if AFormatString = '' then
AFormatString := 'General'
else begin
parser := TsNumFormatParser.Create(FWorkbook, AFormatString);
try
parser.Localize;
parser.LimitDecimals;
AFormatString := parser.FormatString[nfdExcel];
finally
parser.Free;
end;
end;
end;
function TsBIFF2NumFormatList.Find(ANumFormat: TsNumberFormat;
ANumFormatStr: String): Integer;
var
parser: TsNumFormatParser;
decs: Integer;
dt: string;
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;
Clear;
Add(''); // 0
Add('0'); // 1
Add('0.00'); // 2
Add('#,##0'); // 3
Add('#,##0.00'); // 4
Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 5
Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 0, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 6
Add(BuildCurrencyFormatString(ADialect, nfCurrency, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 7
Add(BuildCurrencyFormatString(ADialect, nfCurrencyRed, fs, 2, fs.CurrencyFormat, fs.NegCurrFormat, cs)); // 8
Add('0%'); // 9
Add('0.00%'); // 10
Add('0.00E+00'); // 11
Add(BuildDateTimeFormatString(nfShortDate, fs)); // 12
Add(BuildDateTimeFormatString(nfLongDate, fs)); // 13
Add(BuildDateTimeFormatString(nfDayMonth, fs)); // 14: 'd/mmm'
Add(BuildDateTimeFormatString(nfMonthYear, fs)); // 15: 'mmm/yy'
Add(BuildDateTimeFormatString(nfShortTimeAM, fs)); // 16;
Add(BuildDateTimeFormatString(nfLongTimeAM, fs)); // 17
Add(BuildDateTimeFormatString(nfShortTime, fs)); // 18
Add(BuildDateTimeFormatString(nfLongTime, fs)); // 19
Add(BuildDateTimeFormatString(nfShortDateTime, fs)); // 20
end;
end;
{------------------------------------------------------------------------------}
{ TsSpreadBIFF2Reader }
{------------------------------------------------------------------------------}
constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook);
begin
@ -382,14 +296,10 @@ begin
FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
end;
{@@ ----------------------------------------------------------------------------
Creates the correct version of the number format list.
It is for BIFF2 and BIFF3 file formats.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.CreateNumFormatList;
procedure TsSpreadBIFF2Reader.AddBuiltInNumFormats;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook);
FFirstNumFormatIndexInFile := 0;
InternalAddBuiltInNumFormats(FNumFormatList, Workbook.FormatSettings, nfdDefault);
end;
procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream);
@ -478,7 +388,7 @@ begin
FWorksheet.DefaultRowHeight := h - ROW_HEIGHT_CORRECTION;
end;
procedure TsSpreadBIFF2Reader.ReadFont(AStream: TStream);
procedure TsSpreadBIFF2Reader.ReadFONT(AStream: TStream);
var
lHeight: Word;
lOptions: Word;
@ -509,7 +419,7 @@ begin
FFontList.Add(FFont);
end;
procedure TsSpreadBIFF2Reader.ReadFontColor(AStream: TStream);
procedure TsSpreadBIFF2Reader.ReadFONTCOLOR(AStream: TStream);
begin
FFont.Color := WordLEToN(AStream.ReadWord);
end;
@ -517,7 +427,7 @@ end;
{@@ ----------------------------------------------------------------------------
Reads the FORMAT record required for formatting numerical data
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadFormat(AStream: TStream);
procedure TsSpreadBIFF2Reader.ReadFORMAT(AStream: TStream);
begin
Unused(AStream);
// We ignore the formats in the file, everything is known
@ -811,7 +721,8 @@ begin
ACol := WordLEToN(AStream.ReadWord);
{ 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
AXF := FPendingXFIndex;
@ -964,7 +875,8 @@ var
rec: TBIFF2_XFRecord;
fmt: TsCellFormat;
b: Byte;
nfdata: TsNumFormatData;
nf: TsNumFormatParams;
nfs: String;
i: Integer;
fnt: TsFont;
begin
@ -982,22 +894,18 @@ begin
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then
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 > 1 then
if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont);
// Number format index
b := rec.NumFormatIndex_Flags and $3F;
i := NumFormatList.FindByIndex(b);
if i > -1 then begin
nfdata := NumFormatList.Items[i];
fmt.NumberFormat := nfdata.NumFormat;
fmt.NumberFormatStr := nfdata.FormatString;
if nfdata.NumFormat <> nfGeneral then
nfs := NumFormatList[b];
if nfs <> '' then
begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
nf := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
fmt.NumberFormat := nf.NumFormat;
fmt.NumberFormatStr := nf.NumFormatStr[nfdDefault];
Include(fmt.UsedFormattingFields, uffNumberFormat);
end;
@ -1046,7 +954,9 @@ begin
end;
{------------------------------------------------------------------------------}
{ TsSpreadBIFF2Writer }
{------------------------------------------------------------------------------}
constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook);
begin
@ -1058,13 +968,13 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Creates the correct version of the number format list.
It is valid for BIFF2 and BIFF3 file formats.
Adds the built-in number formats to the NumFormatList.
Inherited method overridden for BIFF2 specialties.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.CreateNumFormatList;
procedure TsSpreadBIFF2Writer.AddBuiltInNumFormats;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook);
FFirstNumFormatIndexInFile := 0;
InternalAddBuiltInNumFormats(FNumFormatList, Workbook.FormatSettings, nfdExcel);
end;
{@@ ----------------------------------------------------------------------------
@ -1118,16 +1028,15 @@ begin
Attrib3 := Attrib3 or $80;
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
standard formats; these formats have been added by the NumFormatList's
AddBuiltInFormats.
NOT CLEAR IF THIS IS TRUE ????
}
// ToDo: check if the BIFF2 format is really restricted to 21 formats.
procedure TsSpreadBIFF2Writer.ListAllNumFormats;
standard formats; these formats have been added by AddBuiltInFormats.
Nothing to do here.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.ListAllNumFormats(ADialect: TsNumFormatDialect);
begin
Unused(ADialect);
// Nothing to do here.
end;
@ -1325,7 +1234,7 @@ begin
WriteFonts(AStream);
WriteCodePage(AStream, FCodePage);
WriteFormatCount(AStream);
WriteNumFormats(AStream);
WriteNumFormats(AStream, nfdExcel);
WriteXFRecords(AStream);
WriteColWidths(AStream);
WriteDimensions(AStream, FWorksheet);
@ -1425,6 +1334,7 @@ var
rec: TBIFF2_XFRecord;
b: Byte;
j: Integer;
nfParams: TsNumFormatParams;
begin
Unused(XFType_Prot);
@ -1436,11 +1346,6 @@ begin
rec.FontIndex := 0;
if (AFormatRecord <> nil) then
begin
{
if (uffBold in AFormatRecord^.UsedFormattingFields) then
rec.FontIndex := BOLD_FONTINDEX
else
}
if (uffFont in AFormatRecord^.UsedFormattingFields) then
begin
rec.FontIndex := AFormatRecord^.FontIndex;
@ -1460,19 +1365,57 @@ begin
rec.NumFormatIndex_Flags := 0;
if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) then
begin
// The number formats in the FormatList are still in fpc dialect
// They will be converted to Excel syntax immediately before writing.
j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr);
if j > -1 then
rec.NumFormatIndex_Flags := NumFormatList[j].Index;
nfParams := Workbook.GetNumberFormat(AFormatRecord^.NumberFormatIndex);
if nfParams <> nil then
case nfParams.NumFormat of
nfGeneral:
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...
end;
{Horizontal alignment, border style, and background
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
4 $10 1 = Cell has right 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.
-------------------------------------------------------------------------------}
procedure TsSpreadBiff2Writer.WriteNumFormat(AStream: TStream;
ANumFormatData: TsNumFormatData; AListIndex: Integer);
ANumFormatStr: String; AFormatIndex: Integer);
type
TNumFormatRecord = packed record
RecordID: Word;
@ -1605,9 +1548,12 @@ var
rec: TNumFormatRecord;
buf: array of byte;
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);
{ BIFF record header }

79
components/fpspreadsheet/xlsbiff5.pas
View File

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

181
components/fpspreadsheet/xlsbiff8.pas
View File

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

248
components/fpspreadsheet/xlscommon.pas
View File

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

472
components/fpspreadsheet/xlsxooxml.pas
View File

@ -47,15 +47,6 @@ uses
type
{ TsOOXMLFormatList }
TsOOXMLNumFormatList = class(TsCustomNumFormatList)
protected
procedure AddBuiltinFormats; override;
public
procedure ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat); override;
end;
{ TsSpreadOOXMLReader }
TsSpreadOOXMLReader = class(TsSpreadXMLReader)
@ -96,7 +87,8 @@ type
procedure ReadThemeColors(ANode: TDOMNode);
procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
protected
procedure CreateNumFormatList; override;
FFirstNumFormatIndexInFile: Integer;
procedure AddBuiltinNumFormats; override;
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
@ -109,9 +101,7 @@ type
TsSpreadOOXMLWriter = class(TsCustomSpreadWriter)
private
FNext_rId: Integer;
procedure WriteVmlDrawingsCallback(AComment: PsComment;
ACommentIndex: Integer; AStream: TStream);
FFirstNumFormatIndexInFile: Integer;
protected
FDateMode: TDateMode;
FPointSeparatorSettings: TFormatSettings;
@ -119,8 +109,7 @@ type
FFillList: array of PsCellFormat;
FBorderList: array of PsCellFormat;
protected
{ Helper routines }
procedure CreateNumFormatList; override;
procedure AddBuiltinNumFormats; override;
procedure CreateStreams;
procedure DestroyStreams;
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 }
{------------------------------------------------------------------------------}
constructor TsSpreadOOXMLReader.Create(AWorkbook: TsWorkbook);
begin
@ -492,11 +405,22 @@ begin
FSharedStrings.Free;
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;
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);
var
i: Integer;
@ -556,15 +480,10 @@ begin
Result := '';
end;
procedure TsSpreadOOXMLReader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsOOXMLNumFormatList.Create(Workbook);
end;
procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode);
function ReadBorderStyle(ANode: TDOMNode; out ABorderStyle: TsCellBorderStyle): Boolean;
function ReadBorderStyle(ANode: TDOMNode;
out ABorderStyle: TsCellBorderStyle): Boolean;
var
s: String;
colorNode: TDOMNode;
@ -675,8 +594,7 @@ var
sstIndex: Integer;
number: Double;
fmt: TsCellFormat;
rng: TsCellRange;
r,c: Cardinal;
numFmt: TsNumFormatParams = nil;
begin
if ANode = nil then
exit;
@ -701,6 +619,9 @@ begin
end else
InitFormatRecord(fmt);
// get number format parameters
numFmt := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
// get data
datanode := ANode.FirstChild;
dataStr := '';
@ -754,10 +675,11 @@ begin
if (s = '') or (s = 'n') then begin
// Number or date/time, depending on format
number := StrToFloat(dataStr, FPointSeparatorSettings);
if IsDateTimeFormat(fmt.NumberFormatStr) then begin
if fmt.NumberFormat <> nfTimeInterval then // no correction of time origin for "time interval" format
if IsDateTimeFormat(numFmt) then
begin
if not IsTimeIntervalFormat(numFmt) then // no correction of time origin for "time interval" format
number := ConvertExcelDateTimeToDateTime(number, FDateMode);
AWorksheet.WriteDateTime(cell, number, fmt.NumberFormatStr)
AWorksheet.WriteDateTime(cell, number);
end
else
AWorksheet.WriteNumber(cell, number);
@ -809,8 +731,9 @@ var
fmt: TsCellFormat;
fs: TsFillStyle;
s1, s2: String;
i, numFmtIndex, fillIndex, borderIndex: Integer;
numFmtData: TsNumFormatData;
numFmtIndex, fillIndex, borderIndex: Integer;
numFmtStr: String;
numFmtParams: TsNumFormatParams;
fillData: TFillListData;
borderData: TBorderListData;
fnt: TsFont;
@ -832,14 +755,24 @@ begin
if (s1 <> '') and (s2 <> '0') then
begin
numFmtIndex := StrToInt(s1);
i := NumFormatList.FindByIndex(numFmtIndex);
if i > -1 then
numFmtStr := NumFormatList[numFmtIndex];
if SameText(numFmtStr, 'General') then
numFmtParams := nil
else
begin
numFmtData := NumFormatList.Items[i];
fmt.NumberFormat := numFmtData.NumFormat;
fmt.NumberFormatStr := numFmtData.FormatString;
if numFmtData.NumFormat <> nfGeneral then
fmt.NumberFormatIndex := Workbook.AddNumberFormat(numFmtStr);
numFmtParams := Workbook.GetNumberFormat(fmt.NumberFormatIndex);
end;
if numFmtParams <> nil then
begin
fmt.NumberFormat := numFmtParams.NumFormat;
fmt.NumberFormatStr := numFmtStr;
Include(fmt.UsedFormattingFields, uffNumberFormat);
end else
begin
fmt.NumberFormat := nfGeneral;
fmt.NumberFormatStr := '';
Exclude(fmt.UsedFormattingFields, uffNumberFormat);
end;
end;
@ -851,10 +784,6 @@ begin
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then
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
Include(fmt.UsedFormattingFields, uffFont);
end;
@ -1344,22 +1273,28 @@ begin
end;
end;
procedure TsSpreadOOXMLReader.ReadNumFormats(ANode: TDOMNode);
var
node: TDOMNode;
idStr: String;
fmtStr: String;
nodeName: String;
id: Integer;
begin
if Assigned(ANode) then
begin
if Assigned(ANode) then begin
node := ANode.FirstChild;
while Assigned(node) do begin
while Assigned(node) do
begin
nodeName := node.NodeName;
if nodeName = 'numFmt' then begin
idStr := GetAttrValue(node, 'numFmtId');
if nodeName = 'numFmt' then
begin
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;
node := node.NextSibling;
end;
@ -1787,7 +1722,33 @@ begin
end;
{------------------------------------------------------------------------------}
{ 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
@ -2044,8 +2005,6 @@ begin
'<commentList>');
// Comments
//IterateThroughComments(FSComments[FCurSheetNum], AWorksheet.Comments, WriteCommentsCallback);
for comment in AWorksheet.Comments do
begin
txt := comment^.Text;
@ -2068,72 +2027,12 @@ begin
'</comment>');
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
AppendToStream(FSComments[FCurSheetNum],
'</commentList>');
AppendToStream(FSComments[FCurSheetNum],
'</comments>');
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;
AWorksheet: TsWorksheet);
@ -2311,32 +2210,34 @@ end;
FirstFormatIndexInFile. }
procedure TsSpreadOOXMLWriter.WriteNumFormatList(AStream: TStream);
var
i: Integer;
item: TsNumFormatData;
s: String;
n: Integer;
i, n: Integer;
numFmtStr: String;
xmlStr: String;
parser: TsNumFormatParser;
begin
s := '';
xmlStr := '';
n := 0;
i := NumFormatList.FindByIndex(NumFormatList.FirstNumFormatIndexInFile);
if i > -1 then begin
while i < NumFormatList.Count do begin
item := NumFormatList[i];
if item <> nil then begin
s := s + Format('<numFmt numFmtId="%d" formatCode="%s" />',
[item.Index, UTF8TextToXMLText(NumFormatList.FormatStringForWriting(i))]);
for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do
begin
numFmtStr := NumFormatList[i];
parser := TsNumFormatParser.Create(Workbook, numFmtStr);
try
numFmtStr := UTF8TextToXMLText(parser.FormatString[nfdExcel]);
xmlStr := xmlStr + Format('<numFmt numFmtId="%d" formatCode="%s" />',
[i, numFmtStr]);
inc(n);
finally
parser.Free;
end;
inc(i);
end;
if n > 0 then
AppendToStream(AStream, Format(
'<numFmts count="%d">', [n]),
s,
xmlStr,
'</numFmts>'
);
end;
end;
{ Writes the workbook's color palette to the file }
procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream);
@ -2551,7 +2452,8 @@ var
// styleCell: TCell;
s, sAlign: String;
fontID: Integer;
numFmtId: Integer;
numFmtParams: TsNumFormatParams;
numFmtStr: String;
fillId: Integer;
borderId: Integer;
idx: Integer;
@ -2570,19 +2472,18 @@ begin
{ Number format }
if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin
idx := NumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr);
if idx > -1 then begin
numFmtID := NumFormatList[idx].Index;
s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [numFmtId]);
end;
numFmtParams := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
if numFmtParams <> nil then
begin
numFmtStr := numFmtParams.NumFormatStr[nfdExcel];
idx := NumFormatList.IndexOf(numFmtStr);
end else
idx := 0; // "General" format is at index 0
s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [idx]);
end;
{ Font }
fontId := 0;
{
if (uffBold in fmt^.UsedFormattingFields) then
fontID := BOLD_FONTINDEX;
}
if (uffFont in fmt^.UsedFormattingFields) then
fontID := fmt^.FontIndex;
s := s + Format('fontId="%d" ', [fontId]);
@ -2715,48 +2616,11 @@ begin
' </v:shape>' + LineEnding);
end;
//IterateThroughComments(FSVmlDrawings[FCurSheetNum], AWorksheet.Comments, WriteVmlDrawingsCallback);
// Footer
AppendToStream(FSVmlDrawings[FCurSheetNum],
'</xml>');
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);
var
AVLNode: TAVLTreeNode;
@ -2973,12 +2837,7 @@ begin
XML_HEADER);
AppendToStream(FSContentTypes,
'<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(
'<Default Extension="rels" ContentType="%s" />', [MIME_RELS]));
AppendToStream(FSContentTypes, Format(
@ -3039,30 +2898,21 @@ begin
'</worksheet>');
end;
constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook);
{@@ ----------------------------------------------------------------------------
Adds the built-in number formats to the NumFormatList.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.AddBuiltinNumFormats;
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;
FFirstNumFormatIndexInFile := 164;
AddBuiltInBiffFormats(
FNumFormatList, Workbook.FormatSettings, FFirstNumFormatIndexInFile-1, nfdExcel
);
end;
procedure TsSpreadOOXMLWriter.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsOOXMLNumFormatList.Create(Workbook);
end;
{ Creates the streams for the individual data files. Will be zipped into a
single xlsx file. }
{@@ ----------------------------------------------------------------------------
Creates the streams for the individual data files. Will be zipped into a
single xlsx file.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.CreateStreams;
begin
if (boBufStream in Workbook.Options) then begin
@ -3085,7 +2935,9 @@ begin
// FSSheets will be created when needed.
end;
{ Destroys the streams that were created by the writer }
{@@ ----------------------------------------------------------------------------
Destroys the streams that were created by the writer
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.DestroyStreams;
procedure DestroyStream(AStream: TStream);
@ -3119,7 +2971,10 @@ begin
SetLength(FSVmlDrawings, 0);
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;
begin
Result := AFormula;
@ -3127,7 +2982,9 @@ begin
Result := UTF8TextToXMLText(Result)
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;
var
i: Integer;
@ -3144,23 +3001,26 @@ begin
for i:=0 to High(FSVmlDrawings) do ResetStream(FSVmlDrawings[i]);
end;
{
{@@ ----------------------------------------------------------------------------
Writes a string to a file. Helper convenience method.
}
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteStringToFile(AFileName, AString: string);
var
TheStream : TFileStream;
stream : TFileStream;
S : String;
begin
TheStream := TFileStream.Create(AFileName, fmCreate);
stream := TFileStream.Create(AFileName, fmCreate);
try
S := AString;
TheStream.WriteBuffer(Pointer(S)^,Length(S));
TheStream.Free;
stream.WriteBuffer(Pointer(S)^, Length(S));
finally
stream.Free;
end;
end;
{
Writes an OOXML document to the disc
}
{@@ ----------------------------------------------------------------------------
Writes an OOXML document to the file
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean);
var
@ -3188,7 +3048,7 @@ var
i: Integer;
begin
{ Analyze the workbook and collect all information needed }
ListAllNumFormats;
ListAllNumFormats(nfdExcel);
ListAllFills;
ListAllBorders;
@ -3259,7 +3119,9 @@ begin
'</c>');
end;
{ Writes a boolean value to the stream }
{@@ ----------------------------------------------------------------------------
Writes a boolean value to the stream
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
@ -3274,7 +3136,9 @@ begin
'<c r="%s" s="%d" t="b"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end;
{ Writes an error value to the specified cell. }
{@@ ----------------------------------------------------------------------------
Writes an error value to the specified cell.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
begin
@ -3283,7 +3147,9 @@ begin
Unused(AValue, ACell);
end;
{ Writes a string formula to the given cell. }
{@@ ----------------------------------------------------------------------------
Writes a string formula to the given cell.
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
var
@ -3386,9 +3252,9 @@ begin
inc(FSharedStringsCount);
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,
ACol: Cardinal; const AValue: double; ACell: PCell);
var
@ -3403,12 +3269,11 @@ begin
'<c r="%s" s="%d" t="n"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end;
{*******************************************************************
* TsSpreadOOXMLWriter.WriteDateTime ()
*
* DESCRIPTION: Writes a date/time value as a number
* Respects DateMode of the file
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes a date/time value as a number
Respects DateMode of the file
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
var
@ -3418,12 +3283,13 @@ begin
WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell);
end;
{
Registers this reader / writer on fpSpreadsheet
}
initialization
// Registers this reader / writer on fpSpreadsheet
RegisterSpreadFormat(TsSpreadOOXMLReader, TsSpreadOOXMLWriter, sfOOXML);
// Create color palette for OOXML file format
MakeLEPalette(@PALETTE_OOXML, Length(PALETTE_OOXML));
end.