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

fpspreadsheet: Excel2003/XML reader supports formulas now.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7038 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-07-15 21:00:47 +00:00
parent 8f706c4a8c
commit 18afbfdd84
6 changed files with 113 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr
View File

@ -45,7 +45,7 @@ begin
MyWorkbook.SetDefaultFont('Calibri', 10);
MyWorkbook.FormatSettings.CurrencyFormat := 2;
MyWorkbook.FormatSettings.NegCurrFormat := 14;
MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving];
Myworkbook.Options := Myworkbook.Options + [boCalcBeforeSaving, boAutoCalc];
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines];

16
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -236,9 +236,9 @@ type
procedure WriteErrorValue(ACell: PCell; AValue: TsErrorValue); overload;
function WriteFormula(ARow, ACol: Cardinal; AFormula: String;
ALocalized: Boolean = false): PCell; overload;
ALocalized: Boolean = false; R1C1Mode: Boolean = false): PCell; overload;
procedure WriteFormula(ACell: PCell; AFormula: String;
ALocalized: Boolean = false); overload;
ALocalized: Boolean = false; R1C1Mode: Boolean = false); overload;
function WriteNumber(ARow, ACol: Cardinal; ANumber: double): PCell; overload;
procedure WriteNumber(ACell: PCell; ANumber: Double); overload;
@ -5838,13 +5838,16 @@ end;
@param ALocalized If true, the formula is expected to have decimal and list
separators of the workbook's FormatSettings. Otherwise
uses dot and comma, respectively.
@param R1C1Mode If true, the formula is expected to contain cell references
in Excel's "R1C1" notation; otherwise "A1" references are
expected.
@return Pointer to the cell
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFormula(ARow, ACol: Cardinal; AFormula: String;
ALocalized: Boolean = false): PCell;
ALocalized: Boolean = false; R1C1Mode: Boolean = false): PCell;
begin
Result := GetCell(ARow, ACol);
WriteFormula(Result, AFormula, ALocalized);
WriteFormula(Result, AFormula, ALocalized, R1C1Mode);
end;
{@@ ----------------------------------------------------------------------------
@ -5859,7 +5862,7 @@ end;
uses dot and comma, respectively.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteFormula(ACell: PCell; AFormula: String;
ALocalized: Boolean = false);
ALocalized: Boolean = false; R1C1Mode: Boolean = false);
var
parser: TsExpressionParser = nil;
formula: PsFormula;
@ -5886,6 +5889,9 @@ begin
try
if ALocalized then
parser.LocalizedExpression[Workbook.FormatSettings] := AFormula
else
if R1C1Mode then
parser.R1C1Expression[ACell] := AFormula
else
parser.Expression := AFormula;
AFormula := parser.Expression;

3
components/fpspreadsheet/source/common/fpstypes.pas
View File

@ -592,8 +592,7 @@ type
TsCalcState = (csNotCalculated, csCalculating, csCalculated);
{@@ Cell flag }
TsCellFlag = ({cfCalculating, cfCalculated, }cfHasComment, cfHyperlink, cfMerged,
cfHasFormula, cf3dFormula);
TsCellFlag = (cfHasComment, cfHyperlink, cfMerged, cfHasFormula, cf3dFormula);
{@@ Set of cell flags }
TsCellFlags = set of TsCellFlag;

41
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -102,6 +102,9 @@ function ParseCellString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal;
out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
function ParseCellString_R1C1(const AStr: string; ABaseRow, ABaseCol: Cardinal;
out ACellRow, ACellCol: Cardinal): Boolean; overload;
function ParseCellRangeString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal;
out ASheet1, ASheet2: String; out ARow1, ACol1, ARow2, ACol2: Cardinal;
out AFlags: TsRelFlags): Boolean; overload;
function GetCellString_R1C1(ARow, ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol];
ARefRow: Cardinal = Cardinal(-1); ARefCol: Cardinal = Cardinal(-1)): String; overload;
@ -813,6 +816,44 @@ begin
ACellRow, ACellCol, flags);
end;
{@@ ----------------------------------------------------------------------------
Parses a 3D cell and sheet range string in Excel R1C1 dialect. Returns the
names of the limiting sheets and the indexes of the limiting borders.
The function result is false if the provided string is not valid.
-------------------------------------------------------------------------------}
function ParseCellRangeString_R1C1(const AStr: String; ABaseRow, ABaseCol: Cardinal;
out ASheet1, ASheet2: String; out ARow1, ACol1, ARow2, ACol2: Cardinal;
out AFlags: TsRelFlags): Boolean;
var
s1, s2: string;
p: Integer;
begin
p := pos('!', AStr);
if p = 0 then begin
ASheet1 := '';
ASheet2 := '';
s2 := AStr;
end else begin
s1 := Copy(AStr, 1, p-1);
s2 := Copy(AStr, p+1, MaxInt);
p := pos(':', s1);
if p = 0 then
ASheet1 := UnquoteStr(s1)
else begin
ASheet1 := UnquoteStr(copy(s1, 1, p-1));
ASheet2 := UnquoteStr(copy(s1, p+1, MaxInt));
end;
end;
p := pos(':', s2);
if p = 0 then begin
ARow2 := Cardinal(-1);
ACol2 := Cardinal(-1);
Result := ParseCellString_R1C1(s2, ABAseRow, ABaseCol, ARow1, ACol1, AFlags);
end else
Result := ParseCellRangeString_R1C1(s2, ABAseRow, ABaseCol, ARow1, ACol1, ARow2, ACol2, AFlags);
end;
{@@ ----------------------------------------------------------------------------
Parses a cell string, like 'A1' into zero-based column and row numbers

84
components/fpspreadsheet/source/common/xlsxml.pas
View File

@ -124,7 +124,8 @@ implementation
uses
StrUtils, DateUtils, Math,
fpsStrings, fpsClasses, fpspreadsheet, fpsUtils, fpsNumFormat, fpsHTMLUtils;
fpsStrings, fpsClasses, fpspreadsheet, fpsUtils, fpsNumFormat, fpsHTMLUtils,
fpsExprParser;
const
FMT_OFFSET = 61;
@ -402,6 +403,7 @@ end;
procedure TsSpreadExcelXMLReader.ReadCell(ANode: TDOMNode;
AWorksheet: TsBasicWorksheet; ARow, ACol: Integer);
var
book: TsWorkbook;
sheet: TsWorksheet absolute AWorksheet;
nodeName: string;
s, st, sv: String;
@ -419,13 +421,14 @@ begin
raise Exception.Create('[ReadCell] Only "Cell" nodes expected.');
cell := sheet.GetCell(ARow, ACol);
book := TsWorkbook(FWorkbook);
s := GetAttrValue(ANode, 'ss:StyleID');
if s <> '' then begin
idx := FCellFormatList.FindIndexOfName(s);
if idx <> -1 then begin
fmt := FCellFormatList.Items[idx]^;
cell^.FormatIndex := TsWorkbook(FWorkbook).AddCellFormat(fmt);
cell^.FormatIndex := book.AddCellFormat(fmt);
end;
end;
@ -437,6 +440,23 @@ begin
if (mergedCols > 0) or (mergedRows > 0) then
sheet.MergeCells(ARow, ACol, ARow + mergedRows, ACol + mergedCols);
// Formula
s := GetAttrValue(ANode, 'ss:Formula');
if s <> '' then begin
try
sheet.WriteFormula(cell, s, false, true);
except
on E:EExprParser do begin
FWorkbook.AddErrorMsg(E.Message);
if (boAbortReadOnFormulaError in FWorkbook.Options) then raise;
end;
on E:ECalcEngine do begin
FWorkbook.AddErrorMsg(E.Message);
if (boAbortReadOnFormulaError in FWorkbook.Options) then raise;
end;
end;
end;
// Hyperlink
s := GetAttrValue(ANode, 'ss:HRef');
if s <> '' then begin
@ -448,34 +468,40 @@ begin
node := ANode.FirstChild;
if node = nil then
sheet.WriteBlank(cell)
else
while node <> nil do begin
nodeName := node.NodeName;
if (nodeName = 'Data') or (nodeName = 'ss:Data') then begin
sv := node.TextContent;
st := GetAttrValue(node, 'ss:Type');
case st of
'String':
sheet.WriteText(cell, sv);
'Number':
sheet.WriteNumber(cell, StrToFloat(sv, FPointSeparatorSettings));
'DateTime':
sheet.WriteDateTime(cell, ExtractDateTime(sv));
'Boolean':
if sv = '1' then
sheet.WriteBoolValue(cell, true)
else if sv = '0' then
sheet.WriteBoolValue(cell, false);
'Error':
if TryStrToErrorValue(sv, err) then
sheet.WriteErrorValue(cell, err);
end;
end
else
if (nodeName = 'Comment') then
ReadComment(node, AWorksheet, cell);
node := node.NextSibling;
else begin
book.LockFormulas; // Protect formulas from being deleted by the WriteXXXX calls
try
while node <> nil do begin
nodeName := node.NodeName;
if (nodeName = 'Data') or (nodeName = 'ss:Data') then begin
sv := node.TextContent;
st := GetAttrValue(node, 'ss:Type');
case st of
'String':
sheet.WriteText(cell, sv);
'Number':
sheet.WriteNumber(cell, StrToFloat(sv, FPointSeparatorSettings));
'DateTime':
sheet.WriteDateTime(cell, ExtractDateTime(sv));
'Boolean':
if sv = '1' then
sheet.WriteBoolValue(cell, true)
else if sv = '0' then
sheet.WriteBoolValue(cell, false);
'Error':
if TryStrToErrorValue(sv, err) then
sheet.WriteErrorValue(cell, err);
end;
end
else
if (nodeName = 'Comment') then
ReadComment(node, AWorksheet, cell);
node := node.NextSibling;
end;
finally
book.UnlockFormulas;
end;
end;
end;
{@@ ----------------------------------------------------------------------------

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

@ -1,11 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="spreadtestgui"/>
<ResourceType Value="res"/>
</General>