paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Fix 3d cell references with a single other sheet (Sheet1!A1:C3), except for ODS. 3d references with several sheets prepared (not tested yet). Some more unit tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6408 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2018-05-13 10:15:13 +00:00
parent 4d4e06ecb9
commit d2351b5559
12 changed files with 1624 additions and 476 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

224
components/fpspreadsheet/source/common/fpsexprparser.pas
View File

@ -86,8 +86,7 @@ type
TsResultTypes = set of TsResultType; TsResultTypes = set of TsResultType;
TsExpressionResult = record TsExpressionResult = record
Worksheet : TsWorksheet; Worksheet : TsWorksheet; // Worksheet containing the calculated cell
Worksheet2 : TsWorksheet;
ResString : String; ResString : String;
case ResultType : TsResultType of case ResultType : TsResultType of
rtEmpty : (); rtEmpty : ();
@ -96,8 +95,9 @@ type
rtInteger : (ResInteger : Int64); rtInteger : (ResInteger : Int64);
rtFloat : (ResFloat : TsExprFloat); rtFloat : (ResFloat : TsExprFloat);
rtDateTime : (ResDateTime : TDatetime); rtDateTime : (ResDateTime : TDatetime);
rtCell : (ResRow, ResCol : Cardinal); rtCell : (ResRow, ResCol : Cardinal;
rtCellRange : (ResCellRange : TsCellRange); ResSheetIndex : Integer);
rtCellRange : (ResCellRange : TsCellRange3D);
rtHyperlink : (); rtHyperlink : ();
rtString : (); rtString : ();
end; end;
@ -564,7 +564,7 @@ type
private private
FCallBack: TsExprFunctionCallBack; FCallBack: TsExprFunctionCallBack;
protected protected
procedure GetNodeValue(out Result: TsExpressionResult); override; procedure GetNodeValue(out AResult: TsExpressionResult); override;
public public
constructor CreateFunction(AParser: TsExpressionParser; constructor CreateFunction(AParser: TsExpressionParser;
AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override; AID: TsExprIdentifierDef; const Args: TsExprArgumentArray); override;
@ -616,30 +616,29 @@ type
TsCellRangeExprNode = class(TsExprNode) TsCellRangeExprNode = class(TsExprNode)
private private
FWorksheet: TsWorksheet; FWorksheet: TsWorksheet;
FWorksheet2: TsWorksheet; // FWorksheet2: TsWorksheet;
FRow: array[TsCellRangeIndex] of Cardinal; FRow: array[TsCellRangeIndex] of Cardinal;
FCol: array[TsCellRangeIndex] of Cardinal; FCol: array[TsCellRangeIndex] of Cardinal;
FSheet: array[TsCellRangeIndex] of Integer;
FFlags: TsRelFlags; FFlags: TsRelFlags;
FonOtherSheet: Boolean; F3dRange: Boolean;
protected protected
function GetCol(AIndex: TsCellRangeIndex): Cardinal; function GetCol(AIndex: TsCellRangeIndex): Cardinal;
function GetRow(AIndex: TsCellRangeIndex): Cardinal; function GetRow(AIndex: TsCellRangeIndex): Cardinal;
procedure GetNodeValue(out Result: TsExpressionResult); override; procedure GetNodeValue(out Result: TsExpressionResult); override;
function GetSheetIndex(AIndex: TscellRangeIndex): Integer; function GetWorkbook: TsWorkbook;
public public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ACellRangeString: String; OnOtherSheet: Boolean); overload; ARangeString: String); overload;
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet; constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ARow1,ACol1, ARow2,ACol2: Cardinal; AFlags: TsRelFlags; OnOtherSheet: Boolean); overload; ASheet1, ASheet2: String; ARow1,ACol1, ARow2, ACol2: Cardinal;
constructor Create(AParser: TsExpressionParser; AWorksheet1, AWorksheet2: TsWorksheet; AFlags: TsRelFlags; Is3DRange: Boolean); overload;
ACellRangeString: String); overload;
constructor Create(AParser: TsExpressionParser; AWorksheet1, AWorksheet2: TsWorksheet;
ARow1,ACol1, ARow2,ACol2: Cardinal; AFlags: TsRelFlags); overload;
function AsRPNItem(ANext: PRPNItem): PRPNItem; override; function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override; function AsString: String; override;
procedure Check; override; procedure Check; override;
function Has3DLink: Boolean; override; function Has3DLink: Boolean; override;
function NodeType: TsResultType; override; function NodeType: TsResultType; override;
property Workbook: TsWorkbook read GetWorkbook;
property Worksheet: TsWorksheet read FWorksheet; property Worksheet: TsWorksheet read FWorksheet;
end; end;
@ -751,7 +750,7 @@ type
procedure Clear; procedure Clear;
function CopyMode: Boolean; function CopyMode: Boolean;
function Evaluate: TsExpressionResult; function Evaluate: TsExpressionResult;
procedure EvaluateExpression(out Result: TsExpressionResult); procedure EvaluateExpression(out AResult: TsExpressionResult);
function Has3DLinks: Boolean; function Has3DLinks: Boolean;
procedure PrepareCopyMode(ASourceCell, ADestCell: PCell); procedure PrepareCopyMode(ASourceCell, ADestCell: PCell);
function ResultType: TsResultType; function ResultType: TsResultType;
@ -1361,13 +1360,13 @@ begin
EvaluateExpression(Result); EvaluateExpression(Result);
end; end;
procedure TsExpressionParser.EvaluateExpression(out Result: TsExpressionResult); procedure TsExpressionParser.EvaluateExpression(out AResult: TsExpressionResult);
begin begin
if (FExpression = '') then if (FExpression = '') then
ParserError(rsExpressionEmpty); ParserError(rsExpressionEmpty);
if not Assigned(FExprNode) then if not Assigned(FExprNode) then
ParserError(rsErrorInExpression); ParserError(rsErrorInExpression);
FExprNode.GetNodeValue(Result); FExprNode.GetNodeValue(AResult);
end; end;
function TsExpressionParser.GetAsBoolean: Boolean; function TsExpressionParser.GetAsBoolean: Boolean;
@ -1672,7 +1671,7 @@ begin
else if (TokenType = ttCell) then else if (TokenType = ttCell) then
Result := TsCellExprNode.Create(self, FWorksheet, CurrentToken, false) Result := TsCellExprNode.Create(self, FWorksheet, CurrentToken, false)
else if (TokenType = ttCellRange) then else if (TokenType = ttCellRange) then
Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken, false) Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken)
else if (TokenType = ttSheetName) then begin else if (TokenType = ttSheetName) then begin
sheetName := CurrentToken; sheetName := CurrentToken;
GetToken; GetToken;
@ -1683,10 +1682,10 @@ begin
Result := TsCellExprNode.Create(self, sheet, CurrentToken, true) Result := TsCellExprNode.Create(self, sheet, CurrentToken, true)
end else end else
if TokenType = ttCellRange then begin if TokenType = ttCellRange then begin
sheet := FWorksheet.WorkBook.GetWorksheetByName(sheetName); if FDialect = fdOpenDocument then
if sheet = nil then Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken)
sheet := FWorksheet.Workbook.AddWorksheet(sheetName, true); else
Result := TsCellRangeExprNode.Create(self, sheet, sheet, CurrentToken); Result := TsCellrangeExprNode.Create(self, FWorksheet, sheetName+'!'+CurrentToken);
end; end;
end end
else if (TokenType = ttError) then else if (TokenType = ttError) then
@ -1877,12 +1876,13 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
operand: TsExprNode = nil; operand: TsExprNode = nil;
fek: TFEKind; fek: TFEKind;
r,c, r2,c2: Cardinal; r,c, r2,c2: Cardinal;
idx: Integer; idx, idx2: Integer;
flags: TsRelFlags; flags: TsRelFlags;
ID: TsExprIdentifierDef; ID: TsExprIdentifierDef;
i, n: Integer; i, n: Integer;
args: TsExprArgumentArray; args: TsExprArgumentArray;
sheet, sheet2: TsWorksheet; sheet: TsWorksheet;
sn, sn2: string;
begin begin
if AIndex < 0 then if AIndex < 0 then
exit; exit;
@ -1918,22 +1918,23 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
end; end;
dec(AIndex); dec(AIndex);
end; end;
fekCellRange: fekCellRange, fekCellRange3D:
begin begin
r := AFormula[AIndex].Row; r := AFormula[AIndex].Row;
c := AFormula[AIndex].Col; c := AFormula[AIndex].Col;
r2 := AFormula[AIndex].Row2; r2 := AFormula[AIndex].Row2;
c2 := AFormula[AIndex].Col2; c2 := AFormula[AIndex].Col2;
flags := AFormula[AIndex].RelFlags; flags := AFormula[AIndex].RelFlags;
idx := AFormula[AIndex].Sheet; if fek = fekCellRange then
if idx = -1 then ANode := TsCellRangeExprNode.Create(self, FWorksheet,
ANode := TsCellRangeExprNode.Create(self, FWorksheet, r, c, r2, c2, flags, false) FWorksheet.Name, FWorksheet.Name, r, c, r2, c2, flags, false)
else begin else begin
sheet := FWorksheet.Workbook.GetWorksheetByIndex(idx); sn := FWorksheet.Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet).Name;
idx := AFormula[AIndex].Sheet2; if AFormula[AIndex].Sheet2 = -1 then
if idx = -1 then sheet2 := sheet sn2 := sn
else sheet2 := FWorksheet.Workbook.GetWorksheetByIndex(idx); else
ANode := TsCellRangeExprNode.Create(self, sheet, sheet2, r,c, r2,c2, flags); sn2 := FWorksheet.Workbook.GetWorksheetByIndex(AFormula[AIndex].Sheet2).Name;
ANode := TsCellRangeExprNode.Create(self, FWorksheet, sn,sn2, r,c, r2,c2, flags, true);
end; end;
dec(AIndex); dec(AIndex);
end; end;
@ -3608,12 +3609,12 @@ begin
FCallBack := AID.OnGetFunctionValueCallBack; FCallBack := AID.OnGetFunctionValueCallBack;
end; end;
procedure TsFunctionCallBackExprNode.GetNodeValue(out Result: TsExpressionResult); procedure TsFunctionCallBackExprNode.GetNodeValue(out AResult: TsExpressionResult);
begin begin
Result.ResultType := NodeType; // was at end! AResult.ResultType := NodeType; // was at end!
if Length(FArgumentParams) > 0 then if Length(FArgumentParams) > 0 then
CalcParams; CalcParams;
FCallBack(Result, FArgumentParams); FCallBack(AResult, FArgumentParams);
end; end;
@ -3863,6 +3864,42 @@ end;
{ TsCellRangeExprNode } { TsCellRangeExprNode }
constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ARangeString: String);
var
r1, c1, r2, c2: Cardinal;
sheet1, sheet2: String;
flags: TsRelFlags;
begin
ParseCellRangeString(ARangeString, sheet1, sheet2, r1, c1, r2, c2, flags);
if (sheet1 = '') then begin
sheet1 := AWorksheet.Name;
sheet2 := sheet1;
end;
Create(AParser, AWorksheet, sheet1, sheet2, r1, c1, r2, c2,
flags, (AWorksheet.Name <> sheet1) );
end;
constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ASheet1, ASheet2: String;
ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: tsRelFlags; Is3DRange: Boolean);
begin
FParser := AParser;
FWorksheet := AWorksheet;
FSheet[1] := GetWorkbook.GetWorksheetIndex(ASheet1);
if ASheet2 = '' then
FSheet[2] := FSheet[1]
else
FSheet[2] := GetWorkbook.GetWorksheetIndex(ASheet2);
FRow[1] := ARow1;
FCol[1] := ACol1;
FRow[2] := ARow2;
FCol[2] := ACol2;
FFlags := AFlags;
F3dRange := Is3dRange;
end;
(*
constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser; constructor TsCellRangeExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ACellRangeString: String; OnOtherSheet: Boolean); AWorksheet: TsWorksheet; ACellRangeString: String; OnOtherSheet: Boolean);
var var
@ -3929,17 +3966,22 @@ begin
FFlags := AFlags; FFlags := AFlags;
FOnOtherSheet := true; FOnOtherSheet := true;
end; end;
*)
function TsCellRangeExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem; function TsCellRangeExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin begin
if FOnOtherSheet then if F3dRange then
Result := RPNCellRange3D( Result := RPNCellRange3D(
GetSheetIndex(1), GetRow(1), GetCol(1), FSheet[1], GetRow(1), GetCol(1),
GetSheetIndex(2), GetRow(2), GetCol(2), FSheet[2], GetRow(2), GetCol(2),
FFlags, ANext FFlags, ANext
) )
else else
Result := RPNCellRange(GetRow(1), GetCol(1), GetRow(2), GetCol(2), FFlags, ANext); Result := RPNCellRange(
GetRow(1), GetCol(1),
GetRow(2), GetCol(2),
FFlags, ANext
);
end; end;
function TsCellRangeExprNode.AsString: string; function TsCellRangeExprNode.AsString: string;
@ -3947,19 +3989,33 @@ var
r1, c1, r2, c2: Cardinal; r1, c1, r2, c2: Cardinal;
s1, s2: String; s1, s2: String;
begin begin
r1 := GetRow(1); r2 := GetRow(2); s1 := Workbook.GetWorksheetByIndex(FSheet[1]).Name;
c1 := GetCol(1); c2 := GetCol(2); s2 := Workbook.GetWorksheetByIndex(FSheet[2]).Name;
s1 := FWorksheet.Name; s2 := FWorksheet2.Name; r1 := GetRow(1);
c1 := GetCol(1);
r2 := GetRow(2);
c2 := GetCol(2);
case FParser.Dialect of if F3dRange then
fdExcelA1: case FParser.Dialect of
Result := GetCellRangeString(s1, s2, r1, c1, r2, c2, FFlags, true); fdExcelA1:
fdExcelR1C1: Result := GetCellRangeString(s1, s2, r1, c1, r2, c2, FFlags, true);
Result := GetCellRangeString_R1C1(s1, s2, r1, c1, r2, c2, FFlags, fdExcelR1C1:
FParser.FSourceCell^.Row, FParser.FSourceCell^.Col); Result := GetCellRangeString_R1C1(s1, s2, r1, c1, r2, c2, FFlags,
fdOpenDocument: FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
Result := GetCellRangeString_ODS(s1, s2, r1, c1, r2, c2, FFlags); fdOpenDocument:
end; Result := GetCellRangeString_ODS(s1, s2, r1, c1, r2, c2, FFlags);
end
else
case FParser.Dialect of
fdExcelA1:
Result := GetCellRangeString(r1, c1, r2, c2, FFlags, true);
fdExcelR1C1:
Result := GetCellRangeString_R1C1(r1, c1, r2, c2, FFlags,
FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
fdOpenDocument:
Result := GetCellRangeString(r1, c1, r2, c2, FFlags, true);
end;
end; end;
procedure TsCellRangeExprNode.Check; procedure TsCellRangeExprNode.Check;
@ -3997,14 +4053,16 @@ begin
begin begin
r[i] := GetRow(i); r[i] := GetRow(i);
c[i] := GetCol(i); c[i] := GetCol(i);
s[i] := GetSheetIndex(i); s[i] := FSheet[i];
end; end;
if not FOnOtherSheet then s[2] := s[1];
book := FWorksheet.Workbook; if not F3dRange then begin
s[1] := Workbook.GetWorksheetIndex(FWorksheet);
s[2] := s[1];
end;
for ss := s[1] to s[2] do begin for ss := s[1] to s[2] do begin
sheet := book.GetWorksheetByIndex(ss); sheet := Workbook.GetWorksheetByIndex(ss);
for rr := r[1] to r[2] do for rr := r[1] to r[2] do
for cc := c[1] to c[2] do for cc := c[1] to c[2] do
begin begin
@ -4024,8 +4082,10 @@ begin
Result.ResCellRange.Col1 := c[1]; Result.ResCellRange.Col1 := c[1];
Result.ResCellRange.Row2 := r[2]; Result.ResCellRange.Row2 := r[2];
Result.ResCellRange.Col2 := c[2]; Result.ResCellRange.Col2 := c[2];
Result.ResCellRange.Sheet1 := s[1];
Result.ResCellRange.Sheet2 := s[2];
Result.Worksheet := FWorksheet; Result.Worksheet := FWorksheet;
Result.Worksheet2 := FWorksheet2; // Result.Worksheet2 := FWorksheet2;
end; end;
function TsCellRangeExprNode.GetRow(AIndex: TsCellRangeIndex): Cardinal; function TsCellRangeExprNode.GetRow(AIndex: TsCellRangeIndex): Cardinal;
@ -4035,22 +4095,14 @@ begin
Result := FRow[AIndex] - FParser.FSourceCell^.Row + FParser.FDestCell^.Row; Result := FRow[AIndex] - FParser.FSourceCell^.Row + FParser.FDestCell^.Row;
end; end;
function TsCellRangeExprNode.GetSheetIndex(AIndex: TsCellRangeIndex): Integer; function TsCellRangeExprNode.GetWorkbook: TsWorkbook;
var
book: TsWorkbook;
sheet: TsWorksheet;
begin begin
case AIndex of Result := FWorksheet.Workbook;
1: sheet := FWorksheet;
2: sheet := FWorksheet2;
end;
book := sheet.Workbook;
Result := book.GetWorksheetIndex(sheet);
end; end;
function TsCellRangeExprNode.Has3DLink: Boolean; function TsCellRangeExprNode.Has3DLink: Boolean;
begin begin
Result := FOnOtherSheet; Result := F3dRange;
end; end;
function TsCellRangeExprNode.NodeType: TsResultType; function TsCellRangeExprNode.NodeType: TsResultType;
@ -4224,29 +4276,37 @@ var
i, n: Integer; i, n: Integer;
r, c: Cardinal; r, c: Cardinal;
cell: PCell; cell: PCell;
sheet: TsWorksheet;
arg: TsExpressionResult; arg: TsExpressionResult;
idx, idx1, idx2: Integer;
begin begin
SetLength(AData, BLOCKSIZE); SetLength(AData, BLOCKSIZE);
n := 0; n := 0;
for i:=0 to High(Args) do for i:=0 to High(Args) do
begin begin
arg := Args[i]; arg := Args[i];
if arg.ResultType = rtCellRange then if arg.ResultType = rtCellRange then begin
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do idx1 := arg.ResCellRange.Sheet1;
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do idx2 := arg.ResCellRange.Sheet2;
begin for idx := idx1 to idx2 do
cell := arg.Worksheet.FindCell(r, c); begin
if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then sheet := arg.Worksheet.Workbook.GetWorksheetByIndex(idx);
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
begin begin
case cell^.ContentType of cell := sheet.FindCell(r, c);
cctNumber : AData[n] := cell^.NumberValue; if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
cctDateTime : AData[n] := cell^.DateTimeValue begin
case cell^.ContentType of
cctNumber : AData[n] := cell^.NumberValue;
cctDateTime : AData[n] := cell^.DateTimeValue
end;
inc(n);
if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
end; end;
inc(n); end
if n = Length(AData) then SetLength(AData, length(AData) + BLOCKSIZE); end;
end; end else
end
else
if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtBoolean]) then if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtBoolean]) then
begin begin
AData[n] := ArgToFloat(arg); AData[n] := ArgToFloat(arg);

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

@ -755,7 +755,7 @@ type
procedure PrepareBeforeReading; procedure PrepareBeforeReading;
procedure PrepareBeforeSaving; procedure PrepareBeforeSaving;
procedure ReCalc; // procedure ReCalc;
public public
{@@ A copy of SysUtil's DefaultFormatSettings (converted to UTF8) to provide {@@ A copy of SysUtil's DefaultFormatSettings (converted to UTF8) to provide
@ -8119,6 +8119,7 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Recalculates rpn formulas in all worksheets Recalculates rpn formulas in all worksheets
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
(*
procedure TsWorkbook.Recalc; procedure TsWorkbook.Recalc;
var var
sheet: pointer; sheet: pointer;
@ -8126,6 +8127,7 @@ begin
for sheet in FWorksheets do for sheet in FWorksheets do
TsWorksheet(sheet).CalcFormulas; TsWorksheet(sheet).CalcFormulas;
end; end;
*)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Conversion of length values between units Conversion of length values between units
@ -8475,7 +8477,8 @@ begin
ok := true; ok := true;
UpdateCaches; UpdateCaches;
if (boAutoCalc in Options) then if (boAutoCalc in Options) then
Recalc; CalcFormulas;
// Recalc;
FFormatID := AFormatID; FFormatID := AFormatID;
finally finally
FReadWriteFlag := rwfNormal; FReadWriteFlag := rwfNormal;
@ -8611,7 +8614,8 @@ begin
ok := true; ok := true;
UpdateCaches; UpdateCaches;
if (boAutoCalc in Options) then if (boAutoCalc in Options) then
Recalc; CalcFormulas;
// Recalc;
FFormatID := AFormatID; FFormatID := AFormatID;
finally finally
FReadWriteFlag := rwfNormal; FReadWriteFlag := rwfNormal;
@ -8977,11 +8981,13 @@ end;
function TsWorkbook.GetWorksheetByName(AName: String): TsWorksheet; function TsWorkbook.GetWorksheetByName(AName: String): TsWorksheet;
var var
i:integer; i:integer;
s: String;
begin begin
Result := nil; Result := nil;
for i:=0 to FWorksheets.Count-1 do for i:=0 to FWorksheets.Count-1 do
begin begin
if UTF8CompareText(TsWorkSheet(FWorkSheets.Items[i]).Name, AName) = 0 then s := TsWorksheet(FWorksheets.Items[i]).Name;
if UTF8CompareText(s, AName) = 0 then
begin begin
Result := TsWorksheet(FWorksheets.Items[i]); Result := TsWorksheet(FWorksheets.Items[i]);
exit; exit;
@ -9012,10 +9018,15 @@ end;
worksheet does not exist. worksheet does not exist.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorkbook.GetWorksheetIndex(const AWorksheetName: String): Integer; function TsWorkbook.GetWorksheetIndex(const AWorksheetName: String): Integer;
var
s: String;
begin begin
for Result := 0 to FWorksheets.Count-1 do for Result := 0 to FWorksheets.Count-1 do
if TsWorksheet(FWorksheets[Result]).Name = AWorksheetName then begin
s := TsWorksheet(FWorksheets[Result]).Name;
if SameText(s, AWorksheetName) then
exit; exit;
end;
Result := -1; Result := -1;
end; end;

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

@ -81,6 +81,9 @@ function ParseSheetCellString(const AStr: String; out ASheetName: String;
function ParseCellRowString(const AStr: string; out ARow: Cardinal): Boolean; function ParseCellRowString(const AStr: string; out ARow: Cardinal): Boolean;
function ParseCellColString(const AStr: string; out ACol: Cardinal): Boolean; function ParseCellColString(const AStr: string; out ACol: Cardinal): Boolean;
function ParseCellRangeString(const AStr: String; out ASheet1, ASheet2: String;
out ARow1, ACol1, ARow2, ACol2: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
function GetCellRangeString(ASheet1, ASheet2: String; ARow1, ACol1, ARow2, ACol2: Cardinal; function GetCellRangeString(ASheet1, ASheet2: String; ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload; AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
@ -914,6 +917,87 @@ begin
Result := Char(AValue + ord('A')); Result := Char(AValue + ord('A'));
end; end;
{@@ ----------------------------------------------------------------------------
Parses a 3D cell and sheet range string in Excel A1 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(const AStr: String; 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 := s1
else begin
ASheet1 := copy(s1, 1, p-1);
ASheet2 := copy(s1, p+1, MaxInt);
end;
end;
Result := ParseCellRangeString(s2, ARow1, ACol1, ARow2, ACol2, AFlags);
end;
{@@ ----------------------------------------------------------------------------
Parses a 3D cell and sheet range string in ODS 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_ODS(const AStr: String; out ASheet1, ASheet2: String;
out ARow1, ACol1, ARow2, ACol2: Cardinal; out AFlags: TsRelFlags): Boolean;
var
s1, s2: String;
p: Integer;
res1, res2: Boolean;
flags1, flags2: TsRelFlags;
begin
p := Pos(':', AStr);
if p = 0 then begin
s1 := AStr;
s2 := '';
end else begin
s1 := copy(AStr, 1, p-1);
s2 := copy(AStr, p+1, MaxInt);
end;
p := pos('.', s1);
if p = 0 then begin
ASheet1 := '';
ASheet2 := '';
Result := ParseCellString(s1, ARow1, ACol1, AFlags);
ARow2 := ARow1;
ACol2 := ACol1;
exit;
end else begin
ASheet1 := Copy(s1, 1, p-1);
s1 := copy(s1, p+1, MaxInt);
res1 := ParseCellString(s1, ARow1, ACol1, flags1);
end;
p := pos('.', s2);
if p = 0 then begin
ASheet2 := '';
res2 := ParseCellString(s2, ARow2, ACol2, flags2);
end else begin
ASheet2 := Copy(s2, 1, p-1);
s2 := copy(s2, p+1, MaxInt);
res2 := ParseCellString(s2, ARow2, ACol2, flags2);
end;
Result := res1 and res2;
AFlags := flags1 + flags2;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Calculates an Excel column name ('A', 'B' etc) from the zero-based column index Calculates an Excel column name ('A', 'B' etc) from the zero-based column index
@ -1113,11 +1197,11 @@ function GetCellRangeString_ODS(ASheet1, ASheet2: String;
var var
s1, s2: String; s1, s2: String;
begin begin
s1 := Format('%s%s%s%s', [ s1 := Format('%s%s%s%d', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol1), RELCHAR[rfRelCol in AFlags], GetColString(ACol1),
RELCHAR[rfRelRow in AFlags], ARow1 + 1 RELCHAR[rfRelRow in AFlags], ARow1 + 1
]); ]);
s2 := Format('%s%s%s%s', [ s2 := Format('%s%s%s%d', [
RELCHAR[rfRelCol2 in AFlags], GetColString(ACol2), RELCHAR[rfRelCol2 in AFlags], GetColString(ACol2),
RELCHAR[rfRelRow2 in AFlags], ARow2 + 1 RELCHAR[rfRelRow2 in AFlags], ARow2 + 1
]); ]);

10
components/fpspreadsheet/source/common/xlsbiff5.pas
View File

@ -532,6 +532,8 @@ begin
INT_EXCEL_ID_COLINFO : ReadColInfo(AStream); INT_EXCEL_ID_COLINFO : ReadColInfo(AStream);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream); INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_EOF : SectionEOF := True; INT_EXCEL_ID_EOF : SectionEOF := True;
INT_EXCEL_ID_EXTERNCOUNT : ReadEXTERNCOUNT(AStream);
INT_EXCEL_ID_EXTERNSHEET : ReadEXTERNSHEET(AStream);
INT_EXCEL_ID_FOOTER : ReadHeaderFooter(AStream, false); INT_EXCEL_ID_FOOTER : ReadHeaderFooter(AStream, false);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream); INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_HEADER : ReadHeaderFooter(AStream, true); INT_EXCEL_ID_HEADER : ReadHeaderFooter(AStream, true);
@ -666,17 +668,17 @@ begin
// Skip 8 unused bytes // Skip 8 unused bytes
AStream.Position := AStream.Position + 8; AStream.Position := AStream.Position + 8;
// Zero-based index to first referenced sheet (-1 = deleted sheet) // one-based index to first referenced sheet (-1 = deleted sheet)
idx := Int16(WordLEToN(AStream.ReadWord)); idx := Int16(WordLEToN(AStream.ReadWord));
if idx <> -1 then begin if idx <> -1 then begin
s := FExternSheets.Strings[idx]; s := FExternSheets.Strings[idx-1];
ASheet1 := FWorkbook.GetWorksheetIndex(s); ASheet1 := FWorkbook.GetWorksheetIndex(s);
end; end;
// Zero-based index to last referenced sheet (-1 = deleted sheet) // one-based index to last referenced sheet (-1 = deleted sheet)
idx := WordLEToN(AStream.ReadWord); idx := WordLEToN(AStream.ReadWord);
if idx <> -1 then begin if idx <> -1 then begin
s := FExternSheets.Strings[idx]; s := FExternSheets.Strings[idx-1];
ASheet2 := FWorkbook.GetWorksheetIndex(s); ASheet2 := FWorkbook.GetWorksheetIndex(s);
end; end;
end end

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

@ -2831,6 +2831,9 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteEXTERNBOOK(AStream: TStream); procedure TsSpreadBIFF8Writer.WriteEXTERNBOOK(AStream: TStream);
begin begin
if (FExternBooks = nil) or (FExternBooks.Count = 0) then
exit;
{ BIFF record header } { BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNBOOK, 4); WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNBOOK, 4);

6
components/fpspreadsheet/source/common/xlscommon.pas
View File

@ -1887,7 +1887,8 @@ begin
inc(len); inc(len);
SetLength(ansistr, len); SetLength(ansistr, len);
AStream.ReadBuffer(ansistr[2], len-1); AStream.ReadBuffer(ansistr[2], len-1);
ansistr[1] := char(b); Delete(ansistr, 1, 1);
// ansistr[1] := char(b);
s := ConvertEncoding(ansistr, FCodePage, encodingUTF8); s := ConvertEncoding(ansistr, FCodePage, encodingUTF8);
FExternSheets.AddObject(s, TObject(PtrInt(b))); FExternSheets.AddObject(s, TObject(PtrInt(b)));
end; end;
@ -4088,6 +4089,9 @@ end;
*) *)
procedure TsSpreadBIFFWriter.WriteEXTERNCOUNT(AStream: TStream; ACount: Word); procedure TsSpreadBIFFWriter.WriteEXTERNCOUNT(AStream: TStream; ACount: Word);
begin begin
if ACount = 0 then
exit;
{ BIFF record header } { BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNCOUNT, 2); WriteBIFFHeader(AStream, INT_EXCEL_ID_EXTERNCOUNT, 2);

5
components/fpspreadsheet/tests/formulatests.pas
View File

@ -10,6 +10,8 @@ unit formulatests;
Note that Excel report a corrupted file when trying to read this file } Note that Excel report a corrupted file when trying to read this file }
{.DEFINE ENABLE_DEFECTIVE_FORMULAS } {.DEFINE ENABLE_DEFECTIVE_FORMULAS }
{ Activate the project define FORMULADEBUG to log the formulas written }
interface interface
@ -87,6 +89,9 @@ type
implementation implementation
uses uses
{$IFDEF FORMULADEBUG}
LazLogger,
{$ENDIF}
math, typinfo, lazUTF8, fpsUtils, fpsRPN, rpnFormulaUnit; math, typinfo, lazUTF8, fpsUtils, fpsRPN, rpnFormulaUnit;
var var

258
components/fpspreadsheet/tests/singleformulatests.pas Normal file
View File

@ -0,0 +1,258 @@
unit SingleFormulaTests;
{$mode objfpc}{$H+}
interface
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry,
fpstypes, fpsallformats, fpspreadsheet, fpsexprparser,
xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
type
TFormulaTestKind = (ftkConstants, ftkCellConstant, ftkCells, ftkCellRange,
ftkCellRangeSheet, ftkCellRangeSheetRange);
{ TSpreadDetailedFormulaFormula }
TSpreadSingleFormulaTests = class(TTestCase)
private
protected
procedure SetUp; override;
procedure TearDown; override;
procedure TestFloatFormula(AFormula: String; AExpected: Double;
ATestKind: TFormulaTestKind; AFormat: TsSpreadsheetFormat);
published
procedure AddConst_BIFF2;
procedure AddConst_BIFF5;
procedure AddConst_BIFF8;
procedure AddConst_OOXML;
procedure AddConst_ODS;
procedure AddCells_BIFF2;
procedure AddCells_BIFF5;
procedure AddCells_BIFF8;
procedure AddCells_OOXML;
procedure AddCells_ODS;
procedure SumRange_BIFF2;
procedure SumRange_BIFF5;
procedure SumRange_BIFF8;
procedure SumRange_OOXML;
procedure SumSheetRange_BIFF5; // no 3d ranges for BIFF2
procedure SumSheetRange_BIFF8;
procedure SumSheetRange_OOXML;
end;
implementation
uses
{$IFDEF FORMULADEBUG}
LazLogger,
{$ENDIF}
math, typinfo, lazUTF8, fpsUtils;
{ TSpreadExtendedFormulaTests }
procedure TSpreadSingleFormulaTests.SetUp;
begin
inherited SetUp;
end;
procedure TSpreadSingleFormulaTests.TearDown;
begin
inherited TearDown;
end;
procedure TSpreadSingleFormulaTests.TestFloatFormula(AFormula: String;
AExpected: Double; ATestKind: TFormulaTestKind; AFormat: TsSpreadsheetFormat);
const
SHEET1 = 'Sheet1';
SHEET2 = 'Sheet2';
SHEET3 = 'Sheet3';
TESTCELL_ROW = 1;
TESTCELL_COL = 2;
var
worksheet: TsWorksheet;
othersheet: TsWorksheet;
workbook: TsWorkbook;
TempFile: string; //write xls/xml to this file and read back from it
cell: PCell;
actualformula: String;
actualValue: Double;
begin
TempFile := GetTempFileName;
// Create test workbook and write test formula and needed cells
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boCalcBeforeSaving, boAutoCalc];
workSheet:= workBook.AddWorksheet(SHEET1);
if ATestKind <> ftkConstants then begin
// Write cells used by the formula
worksheet.WriteNumber(2, 2, 1.0); // C3
worksheet.WriteNumber(3, 2, -2.0); // C4
worksheet.WriteNumber(4, 2, 1.5); // C5
worksheet.WriteNumber(2, 3, 15.0); // D3
end;
if ATestKind in [ftkCellRangeSheet, ftkCellRangeSheetRange] then begin
otherSheet := Workbook.AddWorksheet(SHEET2);
othersheet.WriteNumber(2, 2, 10.0); // Sheet2!C3
othersheet.WriteNumber(3, 2, -20.0); // Sheet2!C4
othersheet.WriteNumber(4, 2, 15.0); // Sheet2!C5
othersheet.WriteNumber(2, 3, 150.0); // Sheet2!D5
end;
if ATestKind = ftkCellRangeSheetRange then begin
otherSheet := Workbook.AddWorksheet(SHEET3);
othersheet.WriteNumber(2, 2, 100.0); // Sheet3C3
othersheet.WriteNumber(3, 2, -200.0); // Sheet3!C4
othersheet.WriteNumber(4, 2, 150.0); // Sheet3!C5
othersheet.WriteNumber(2, 3, 1500.0); // Sheet3!D5
end;
// Write the formula
cell := worksheet.WriteFormula(TESTCELL_ROW, TESTCELL_COL, AFormula);
// Read formula before saving
actualFormula := cell^.Formulavalue;
CheckEquals(AFormula, actualFormula, 'Unsaved formula text mismatch');
// Read calculated value before saving
actualvalue := worksheet.ReadAsNumber(TESTCELL_ROW, TESTCELL_COL);
CheckEquals(AExpected, actualvalue, 'Unsaved calculated value mismatch');
// Save
workbook.WriteToFile(TempFile, AFormat, true);
finally
workbook.Free;
end;
// Read file
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boReadFormulas, boAutoCalc];
workbook.ReadFromFile(TempFile, AFormat);
worksheet := workbook.GetFirstWorksheet;
// Read calculated formula value
actualvalue := worksheet.ReadAsNumber(TESTCELL_ROW, TESTCELL_COL);
CheckEquals(AExpected, actualValue, 'Saved calculated value mismatch');
cell := worksheet.FindCell(TESTCELL_ROW, TESTCELL_COL);
actualformula := cell^.FormulaValue;
CheckEquals(AFormula, actualformula, 'Saved formula text mismatch.');
finally
workbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadSingleFormulaTests.AddConst_BIFF2;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfExcel2);
end;
procedure TSpreadSingleFormulaTests.AddConst_BIFF5;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.AddConst_BIFF8;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.AddConst_OOXML;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfOOXML);
end;
procedure TSpreadSingleFormulaTests.AddConst_ODS;
begin
TestFloatFormula('1+1', 2, ftkConstants, sfOpenDocument);
end;
{---------------}
procedure TSpreadSingleFormulaTests.AddCells_BIFF2;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfExcel2);
end;
procedure TSpreadSingleFormulaTests.AddCells_BIFF5;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.AddCells_BIFF8;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.AddCells_OOXML;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfOOXML);
end;
procedure TSpreadSingleFormulaTests.AddCells_ODS;
begin
TestFloatFormula('C3+C4', -1.0, ftkCells, sfOpenDocument);
end;
{ ------ }
procedure TSpreadSingleFormulaTests.SumRange_BIFF2;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfExcel2);
end;
procedure TSpreadSingleFormulaTests.SumRange_BIFF5;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.SumRange_BIFF8;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.SumRange_OOXML;
begin
TestFloatFormula('SUM(C3:C5)', 0.5, ftkCellRange, sfOOXML);
end;
{ ---- }
procedure TSpreadSingleFormulaTests.SumSheetRange_BIFF5;
begin
TestFloatFormula('SUM(Sheet2!C3:C5)', 5.0, ftkCellRangeSheet, sfExcel5);
end;
procedure TSpreadSingleFormulaTests.SumSheetRange_BIFF8;
begin
TestFloatFormula('SUM(Sheet2!C3:C5)', 5.0, ftkCellRangeSheet, sfExcel8);
end;
procedure TSpreadSingleFormulaTests.SumSheetRange_OOXML;
begin
TestFloatFormula('SUM(Sheet2!C3:C5)', 5.0, ftkCellRangeSheet, sfOOXML);
end;
{ ---- }
initialization
// Register to include these tests in a full run
RegisterTest(TSpreadSingleFormulaTests);
end.

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

@ -38,7 +38,7 @@
<PackageName Value="FCL"/> <PackageName Value="FCL"/>
</Item4> </Item4>
</RequiredPackages> </RequiredPackages>
<Units Count="29"> <Units Count="30">
<Unit0> <Unit0>
<Filename Value="spreadtestgui.lpr"/> <Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -156,6 +156,11 @@
<Filename Value="testcases_calc3dformula.inc"/> <Filename Value="testcases_calc3dformula.inc"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit28> </Unit28>
<Unit29>
<Filename Value="singleformulatests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="SingleFormulaTests"/>
</Unit29>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -174,6 +179,12 @@
<UseExternalDbgSyms Value="True"/> <UseExternalDbgSyms Value="True"/>
</Debugging> </Debugging>
</Linking> </Linking>
<Other>
<CustomOptions Value="-dFormulaDebug"/>
<OtherDefines Count="1">
<Define0 Value="FormulaDebug"/>
</OtherDefines>
</Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="6"> <Exceptions Count="6">

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

@ -9,12 +9,13 @@ uses
//HeapTrc, //HeapTrc,
SysUtils, SysUtils,
{$ENDIF} {$ENDIF}
Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests, Interfaces, Forms, GuiTestRunner, testsutility,
manualtests, testsutility, internaltests, formattests, colortests, fonttests, datetests, stringtests, numberstests, manualtests, internaltests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit, exceltests, formattests, colortests, fonttests, optiontests, numformatparsertests,
emptycelltests, errortests, virtualmodetests, insertdeletetests, ssttests, formulatests, rpnFormulaUnit, singleformulatests,
celltypetests, sortingtests, copytests, enumeratortests, commenttests, exceltests, emptycelltests, errortests, virtualmodetests,
hyperlinktests, pagelayouttests, protectiontests; insertdeletetests, ssttests, celltypetests, sortingtests, copytests,
enumeratortests, commenttests, hyperlinktests, pagelayouttests, protectiontests;
begin begin
{$IFDEF HEAPTRC} {$IFDEF HEAPTRC}

11
components/fpspreadsheet/tests/testcases_calc3dformula.inc
View File

@ -6,7 +6,9 @@
sheet1.WriteNumber(1, 5, 12.0); // F2 = 12.0 sheet1.WriteNumber(1, 5, 12.0); // F2 = 12.0
sheet2.WriteText(2, 1, 'A'); // B3 = 'A' sheet2.WriteText(2, 1, 'A'); // B3 = 'A'
sheet2.WriteNumber(1, 4, 1.0); // E2 = 1.0 sheet2.WriteNumber(1, 4, 1.0); // E2 = 1.0
sheet2.WriteNumber(2, 4, -1.0); // E3 = -1.0
sheet2.WriteNumber(3, 4, 10.0); // E4 = 10.0
sheet3.WriteText(1, 2, 'B'); // C2 = 'B' sheet3.WriteText(1, 2, 'B'); // C2 = 'B'
sheet3.WriteNumber(1, 1, 2.0); // B2 = 2.0 sheet3.WriteNumber(1, 1, 2.0); // B2 = 2.0
@ -69,6 +71,13 @@
SetLength(SollValues, Row+1); SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('AB'); SollValues[Row] := StringResult('AB');
inc(Row);
formula := 'SUM(Sheet2!E2:E4)'; { A9 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := FloatResult(10.0);
{ {
inc(Row); inc(Row);
formula := 'D1&Sheet2!B3%"BC"'; formula := 'D1&Sheet2!B3%"BC"';

1448
components/fpspreadsheet/tests/testcases_calcrpnformula.inc
View File

File diff suppressed because it is too large Load Diff