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

fpspreadsheet/formulas with 3d references: sfExcel8 can read them now. Several bug fixes (e.g. '=Sheet1!A1' was not working). Add testcases.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6399 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-09 17:07:59 +00:00
parent e4f6f6e355
commit bfb8cff66e
11 changed files with 576 additions and 99 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -57,7 +57,7 @@ type
{ Tokens }
TsTokenType = (
ttCell, ttSheetCell, ttCellRange, ttSheetName,
ttCell, ttCellRange, ttSheetName,
ttNumber, ttString, ttIdentifier,
ttPlus, ttMinus, ttMul, ttDiv, ttConcat, ttPercent, ttPower, ttLeft, ttRight,
ttLessThan, ttLargerThan, ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual,
@@ -589,35 +589,33 @@ type
property SheetName: String read FSheetName;
end;
{ TsBasicCellExprNode }
TsBasicCellExprNode = class(TsExprNode)
{ TsCellExprNode }
TsCellExprNode = class(TsExprNode)
private
FWorksheet: TsWorksheet;
FRow, FCol: Cardinal;
FFlags: TsRelFlags;
FCell: PCell;
FIsRef: Boolean;
FOtherSheet: Boolean;
protected
procedure Check; override;
function GetCol: Cardinal;
function GetRow: Cardinal;
function GetSheetIndex: Integer;
procedure GetNodeValue(out Result: TsExpressionResult); override;
public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ARow, ACol: Cardinal; AFlags: TsRelFlags); overload;
ARow, ACol: Cardinal; AFlags: TsRelFlags; OtherSheet: Boolean); overload;
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ACellString: String; Othersheet: Boolean); overload;
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override;
function NodeType: TsResultType; override;
property Worksheet: TsWorksheet read FWorksheet;
end;
{ TsCellExprNode }
TsCellExprNode = class(TsBasicCellExprNode)
public
constructor Create(AParser: TsExpressionParser; AWorksheet: TsWorksheet;
ACellString: String); overload;
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override;
end;
(*
{ TsSheetCellExprNode }
TsSheetCellExprNode = class(TsBasicCellExprNode)
protected
@@ -627,7 +625,7 @@ type
ACellString: String); overload;
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: string; override;
end;
end; *)
{ TsCellRangeExprNode }
@@ -1026,6 +1024,7 @@ var
flags: TsRelFlags;
begin
C := CurrentChar;
if C = FSheetNameTerminator then C := NextPos;
sheetName := '';
while (not IsWordDelim(C)) and (C <> cNull) and (C <> FSheetNameTerminator) do
begin
@@ -1662,6 +1661,7 @@ var
token: String;
prevTokenType: TsTokenType;
sheetname: String;
sheet: TsWorksheet;
begin
{$ifdef debugexpr} Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
SetLength(Args, 0);
@@ -1682,17 +1682,17 @@ begin
else if (TokenType = ttString) then
Result := TsConstExprNode.CreateString(self, CurrentToken)
else if (TokenType = ttCell) then
Result := TsCellExprNode.Create(self, FWorksheet, CurrentToken)
Result := TsCellExprNode.Create(self, FWorksheet, CurrentToken, false)
else if (TokenType = ttSheetName) then begin
sheetName := CurrentToken;
GetToken;
if TokenType = ttCell then
Result := TsSheetCellExprNode.Create(self, FWorksheet.Workbook.GetWorksheetByName(sheetName), CurrentToken)
if TokenType = ttCell then begin
sheet := FWorksheet.Workbook.GetWorksheetByName(sheetName);
if sheet = nil then
sheet := FWorksheet.Workbook.AddWorksheet(sheetName, true);
Result := TsCellExprNode.Create(self, sheet, CurrentToken, true)
end;
end
(*
else if (TokenType = ttSheetCell) then
Result := TsSheetCellExprNode.Create(self, FWorksheet.Workbook, CurrentToken)
*)
else if (TokenType = ttCellRange) then
Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken)
else if (TokenType = ttError) then
@@ -1878,10 +1878,12 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
operand: TsExprNode = nil;
fek: TFEKind;
r,c, r2,c2: Cardinal;
idx: Integer;
flags: TsRelFlags;
ID: TsExprIdentifierDef;
i, n: Integer;
args: TsExprArgumentArray;
sheet: TsWorksheet;
begin
if AIndex < 0 then
exit;
@@ -1898,7 +1900,22 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
else
begin
flags := AFormula[AIndex].RelFlags;
ANode := TsCellExprNode.Create(self, FWorksheet, r, c, flags);
ANode := TsCellExprNode.Create(self, FWorksheet, r, c, flags, false);
end;
dec(AIndex);
end;
fekCell3D:
begin
idx := AFormula[AIndex].Sheet;
r := AFormula[AIndex].Row;
c := AFormula[AIndex].Col;
if (LongInt(r) < 0) or (LongInt(c) < 0) then
ANode := TsConstExprNode.CreateError(self, errIllegalRef)
else
begin
flags := AFormula[AIndex].RelFlags;
sheet := FWorksheet.Workbook.GetWorksheetByIndex(idx);
ANode := TsCellExprNode.Create(Self, sheet, r, c, flags, true);
end;
dec(AIndex);
end;
@@ -3610,10 +3627,11 @@ begin
end;
{ TsBasicCellExprNode }
{ TsCellExprNode }
constructor TsBasicCellExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ARow,ACol: Cardinal; AFlags: TsRelFlags);
constructor TsCellExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ARow,ACol: Cardinal; AFlags: TsRelFlags;
OtherSheet: Boolean);
begin
FParser := AParser;
FWorksheet := AWorksheet;
@@ -3621,9 +3639,64 @@ begin
FCol := ACol;
FFlags := AFlags;
FCell := AWorksheet.FindCell(FRow, FCol);
FOtherSheet := OtherSheet;
end;
procedure TsBasicCellExprNode.Check;
constructor TsCellExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ACellString: String; OtherSheet: Boolean);
var
r, c: Cardinal;
flags: TsRelFlags;
begin
ParseCellString(ACellString, r, c, flags);
Create(AParser, AWorksheet, r, c, flags, OtherSheet);
end;
function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
if FIsRef then
begin
if FOtherSheet then
Result := RPNCellRef3D(GetSheetIndex, GetRow, GetCol, FFlags, ANext)
else
Result := RPNCellRef(GetRow, GetCol, FFlags, ANext)
end else
begin
if FOtherSheet then
Result := RPNCellValue3D(GetSheetIndex, GetRow, GetCol, FFlags, ANext)
else
Result := RPNCellValue(GetRow, GetCol, FFlags, ANext);
end;
end;
function TsCellExprNode.AsString: string;
var
r, c: Cardinal;
begin
r := Getrow;
c := GetCol;
if FOtherSheet then
case FParser.Dialect of
fdExcelA1:
Result := Format('%s!%s', [FWorksheet.Name, GetCellString(r, c, FFlags)]);
fdExcelR1C1:
Result := Format('%s!%s', [FWorksheet.Name,
GetCellString_R1C1(r, c, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col)]);
fdOpenDocument:
Result := Format('[%s.%s]', [FWorksheet.Name, GetCellString(r, c, FFlags)]);
end
else
case FParser.Dialect of
fdExcelA1:
Result := GetCellString(GetRow, GetCol, FFlags);
fdExcelR1C1:
Result := GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
fdOpenDocument:
Result := '[.' + GetCellString(GetRow, GetCol, FFlags) + ']';
end;
end;
procedure TsCellExprNode.Check;
begin
// Nothing to check;
end;
@@ -3638,14 +3711,14 @@ end;
address of the SourceCell.
(2) Normal mode:
Returns the "true" row address of the cell assigned to the formula node. }
function TsBasicCellExprNode.GetCol: Cardinal;
function TsCellExprNode.GetCol: Cardinal;
begin
Result := FCol;
if FParser.CopyMode and (rfRelCol in FFlags) then
Result := FCol - FParser.FSourceCell^.Col + FParser.FDestCell^.Col;
end;
procedure TsBasicCellExprNode.GetNodeValue(out Result: TsExpressionResult);
procedure TsCellExprNode.GetNodeValue(out Result: TsExpressionResult);
var
cell: PCell;
begin
@@ -3657,7 +3730,7 @@ begin
if (cell <> nil) and HasFormula(cell) then
case FWorksheet.GetCalcState(cell) of
csNotCalculated:
Worksheet.CalcFormula(cell);
FWorksheet.CalcFormula(cell);
csCalculating:
raise ECalcEngine.CreateFmt(rsCircularReference, [GetCellString(cell^.Row, cell^.Col)]);
end;
@@ -3669,19 +3742,27 @@ begin
end;
{ See: GetCol }
function TsBasicCellExprNode.GetRow: Cardinal;
function TsCellExprNode.GetRow: Cardinal;
begin
Result := FRow;
if Parser.CopyMode and (rfRelRow in FFlags) then
Result := FRow - FParser.FSourceCell^.Row + FParser.FDestCell^.Row;
end;
function TsBasicCellExprNode.NodeType: TsResultType;
function TsCellExprNode.GetSheetIndex: Integer;
var
book: TsWorkbook;
begin
book := FWorksheet.Workbook;
Result := book.GetWorksheetIndex(FWorksheet);
end;
function TsCellExprNode.NodeType: TsResultType;
begin
Result := rtCell;
end;
(*
{ TsSheetCellExprNode }
constructor TsSheetCellExprNode.Create(AParser: TsExpressionParser;
@@ -3743,38 +3824,10 @@ begin
book := FWorksheet.Workbook;
Result := book.GetWorksheetIndex(FWorksheet);
end;
*)
{ TsCellExprNode }
constructor TsCellExprNode.Create(AParser: TsExpressionParser;
AWorksheet: TsWorksheet; ACellString: String);
var
r, c: Cardinal;
flags: TsRelFlags;
begin
ParseCellString(ACellString, r, c, flags);
Create(AParser, AWorksheet, r, c, flags);
end;
function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
if FIsRef then
Result := RPNCellRef(GetRow, GetCol, FFlags, ANext)
else
Result := RPNCellValue(GetRow, GetCol, FFlags, ANext);
end;
function TsCellExprNode.AsString: string;
begin
case FParser.Dialect of
fdExcelA1 : Result := GetCellString(GetRow, GetCol, FFlags);
fdExcelR1C1 : Result := GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col);
fdOpenDocument : Result := '[.' + GetCellString(GetRow, GetCol, FFlags) + ']';
end;
end;
{ TsCellRangeExprNode }

26
components/fpspreadsheet/source/common/fpsopendocument.pas
View File

@@ -17,6 +17,9 @@ Specifications obtained from:
http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf
AUTHORS: Felipe Monteiro de Carvalho / Jose Luis Jurado Rincon / Werner Pamler
NOTICE: Active define FPSpreadDebug in the project options to get a log during
reading/writing.
}
@@ -28,11 +31,12 @@ unit fpsopendocument;
{$I ..\fps.inc}
{.$define FPSPREADDEBUG} //used to be XLSDEBUG
interface
uses
{$IFDEF FPSpreadDebug}
LazLogger,
{$ENDIF}
Classes, SysUtils,
laz2_xmlread, laz2_DOM,
avglvltree, math, dateutils, contnrs,
@@ -2385,6 +2389,10 @@ var
fmt: PsCellFormat;
ns: String;
begin
{$IFDEF FPSpreadDebug}
DebugLn(Format('ReadFormula: ARow=%d, ACol=%d, AStyleIndex=%d', [ARow, ACol, AStyleIndex]));
{$ENDIF}
// Create cell and apply format
if FIsVirtualMode then
begin
@@ -2453,6 +2461,14 @@ begin
// Because fpsspreadsheet supports references to other sheets which might
// not have been loaded at this moment, conversion to ExcelA1 dialect
// (used by fps) is postponed until all sheets are read.
{$IFDEF FPSpreadDebug}
DebugLn(' Formula found: ' + formula);
(*
if SameText(formula, 'IsText({.B1])') then
formula := formula + '';
*)
{$ENDIF}
end;
// Read formula results
@@ -3519,6 +3535,12 @@ var
s: String;
colsSpanned, rowsSpanned: Integer;
begin
{$IFDEF FPSpreadDebug}
DebugLn(Format('ReadCell: ARow=%d, ACol=%d, AFormatIndex=%d',
[ARow, ACol, AFormatIndex])
);
{$ENDIF}
// Workaround for Excel files converted to ods by Calc: These files are
// expanded to fill the entire max worksheet. They also have single empty
// cell in the outermost cells --> don't write anything here to prevent this.

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

@@ -1322,15 +1322,17 @@ begin
end;
rtBoolean : WriteBoolValue(ACell, res.ResBoolean);
rtCell : begin
cell := GetCell(res.ResRow, res.ResCol);
case cell^.ContentType of
cctNumber : WriteNumber(ACell, cell^.NumberValue);
cctDateTime : WriteDateTime(ACell, cell^.DateTimeValue);
cctUTF8String: WriteText(ACell, cell^.UTF8StringValue);
cctBool : WriteBoolValue(ACell, cell^.Boolvalue);
cctError : WriteErrorValue(ACell, cell^.ErrorValue);
cctEmpty : WriteBlank(ACell);
end;
// cell := GetCell(res.ResRow, res.ResCol);
cell := res.Worksheet.FindCell(res.ResRow, res.ResCol);
if cell <> nil then
case cell^.ContentType of
cctNumber : WriteNumber(ACell, cell^.NumberValue);
cctDateTime : WriteDateTime(ACell, cell^.DateTimeValue);
cctUTF8String: WriteText(ACell, cell^.UTF8StringValue);
cctBool : WriteBoolValue(ACell, cell^.Boolvalue);
cctError : WriteErrorValue(ACell, cell^.ErrorValue);
cctEmpty : WriteBlank(ACell);
end;
end;
end;
finally

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

@@ -75,7 +75,7 @@ type
protected
procedure PopulatePalette; override;
{ Record writing methods }
procedure ReadBoundsheet(AStream: TStream);
procedure ReadBOUNDSHEET(AStream: TStream);
procedure ReadDEFINEDNAME(AStream: TStream);
procedure ReadFONT(const AStream: TStream);
procedure ReadFORMAT(AStream: TStream); override;
@@ -364,12 +364,13 @@ end;
{@@ ----------------------------------------------------------------------------
Reads a BOUNDSHEET record containing a worksheet name
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Reader.ReadBoundsheet(AStream: TStream);
procedure TsSpreadBIFF5Reader.ReadBOUNDSHEET(AStream: TStream);
var
len: Byte;
s: AnsiString;
sheetState: Byte;
sheetData: TsSheetData;
sheet: TsWorksheet;
//sheetData: TsSheetData;
begin
{ Absolute stream position of the BOF record of the sheet represented
by this record }
@@ -387,11 +388,16 @@ begin
SetLength(s, len);
AStream.ReadBuffer(s[1], len*SizeOf(AnsiChar));
sheet := FWorkbook.AddWorksheet(ConvertEncoding(s, FCodePage, EncodingUTF8), true);
if sheetState <> 0 then
sheet.Options := sheet.Options + [soHidden];
(*
{ Temporarily store parameters for worksheet in FSheetList }
sheetData := TsSheetData.Create;
sheetData.Name := ConvertEncoding(s, FCodePage, EncodingUTF8);
sheetData.Hidden := sheetState <> 0;
FSheetList.Add(sheetData);
*)
end;
{@@ ----------------------------------------------------------------------------
@@ -503,13 +509,14 @@ var
SectionEOF: Boolean = False;
RecordType: Word;
CurStreamPos: Int64;
sheetData: TsSheetData;
begin
// sheetData: TsSheetData;
begin (*
sheetData := TsSheetData(FSheetList[FCurSheetIndex]);
FWorksheet := FWorkbook.AddWorksheet(sheetData.Name, true);
if sheetData.Hidden then
FWorksheet.Options := FWorksheet.Options + [soHidden];
*)
FWorksheet := FWorkbook.GetWorksheetByIndex(FCurSheetIndex);
while (not SectionEOF) do
begin
{ Read the record header }

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

@@ -65,6 +65,15 @@ uses
fpsutils;
type
TExternBookKind = (ebkExternal, ebkInternal, ebkAddInFunc, ebkDDE_OLE);
TBIFF8ExternBook = class
Kind: TExternBookKind;
DocumentURL: String;
SheetNames: String;
function GetSheetName(AIndex: Integer): String;
end;
TBIFF8ExternSheet = packed record
ExternBookIndex: Word;
FirstSheetIndex: Word;
@@ -80,6 +89,7 @@ type
FCommentPending: Boolean;
FCommentID: Integer;
FCommentLen: Integer;
FBiff8ExternBooks: TFPObjectList;
FBiff8ExternSheets: array of TBiff8ExternSheet;
function ReadString(const AStream: TStream; const ALength: Word;
out ARichTextParams: TsRichTextParams): String;
@@ -94,6 +104,7 @@ type
procedure ReadBOUNDSHEET(AStream: TStream);
procedure ReadCONTINUE(const AStream: TStream);
procedure ReadDEFINEDNAME(const AStream: TStream);
procedure ReadEXTERNBOOK(const AStream: TStream);
procedure ReadEXTERNSHEET(const AStream: TStream);
procedure ReadFONT(const AStream: TStream);
procedure ReadFORMAT(AStream: TStream); override;
@@ -116,14 +127,18 @@ type
procedure ReadRPNCellRangeOffset(AStream: TStream;
out ARow1Offset, ACol1Offset, ARow2Offset, ACol2Offset: Integer;
out AFlags: TsRelFlags); override;
procedure ReadRPNSheetIndex(AStream: TStream; out ASheet1, ASheet2: Integer); override;
procedure ReadRSTRING(AStream: TStream);
procedure ReadSST(const AStream: TStream);
function ReadString_8bitLen(AStream: TStream): String; override;
procedure ReadStringRecord(AStream: TStream); override;
procedure ReadTXO(const AStream: TStream);
procedure ReadXF(const AStream: TStream);
protected
procedure ReadWorkbookGlobals(AStream: TStream); override;
procedure ReadWorksheet(AStream: TStream); override;
procedure ReadXF(const AStream: TStream);
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
@@ -489,6 +504,27 @@ begin
end;
{ TBiff8ExternBook }
function TBiff8ExternBook.GetSheetName(AIndex: Integer): String;
var
L: TStrings;
begin
L := TStringList.Create;
try
L.Delimiter := #1;
L.StrictDelimiter := true;
L.DelimitedText := SheetNames;
if (AIndex >= 0) and (AIndex < L.Count) then
Result := L[AIndex]
else
Result := '';
finally
L.Free;
end;
end;
{ TsSpreadBIFF8Reader }
constructor TsSpreadBIFF8Reader.Create(AWorkbook: TsWorkbook);
@@ -502,6 +538,7 @@ var
j: Integer;
begin
SetLength(FBiff8ExternSheets, 0);
FBiff8ExternBooks.Free;
if Assigned(FSharedStringTable) then
begin
@@ -845,6 +882,7 @@ begin
INT_EXCEL_ID_DATEMODE : ReadDateMode(AStream);
INT_EXCEL_ID_DEFINEDNAME : ReadDEFINEDNAME(AStream);
INT_EXCEL_ID_EOF : SectionEOF := True;
INT_EXCEL_ID_EXTERNBOOK : ReadEXTERNBOOK(AStream);
INT_EXCEL_ID_EXTERNSHEET : ReadEXTERNSHEET(AStream);
INT_EXCEL_ID_FONT : ReadFont(AStream);
INT_EXCEL_ID_FORMAT : ReadFormat(AStream);
@@ -875,13 +913,15 @@ var
SectionEOF: Boolean = False;
RecordType: Word;
CurStreamPos: Int64;
sheetData: TsSheetData;
// sheetData: TsSheetData;
begin
(*
sheetData := TsSheetData(FSheetList[FCurSheetIndex]);
FWorksheet := FWorkbook.AddWorksheet(sheetData.Name, true);
if sheetData.Hidden then
FWorksheet.Options := FWorksheet.Options + [soHidden];
*)
FWorksheet := FWorkbook.GetWorksheetByIndex(FCurSheetIndex);
while (not SectionEOF) do
begin
{ Read the record header }
@@ -970,6 +1010,7 @@ var
len: Byte;
wideName: WideString;
rtParams: TsRichTextParams;
sheet: TsWorksheet;
sheetstate: Byte;
sheetdata: TsSheetData;
begin
@@ -990,10 +1031,15 @@ begin
{ Read string with flags }
wideName := ReadWideString(AStream, len, rtParams);
sheet := FWorkbook.AddWorksheet(UTF8Encode(widename), true);
if sheetState <> 0 then
sheet.Options := sheet.Options + [soHidden];
(*
sheetData := TsSheetData.Create;
sheetData.Name := UTF8Encode(wideName);
sheetData.Hidden := sheetState <> 0;
FSheetList.Add(sheetdata);
*)
end;
function TsSpreadBIFF8Reader.ReadString(const AStream: TStream;
@@ -1263,21 +1309,24 @@ end;
function TsSpreadBIFF8Reader.ReadRPNCellRange3D(AStream: TStream;
var ARPNItem: PRPNItem): Boolean;
var
sheetIndex: Integer;
sheetIndex1, sheetIndex2: Integer;
r1, c1, r2, c2: Cardinal;
flags: TsRelFlags;
begin
Result := true;
sheetIndex := WordLEToN(AStream.ReadWord);
if FBiff8ExternSheets[sheetIndex].ExternBookIndex <> 0 then
exit(false);
ReadRPNSheetIndex(AStream, sheetIndex1, sheetIndex2);
if (sheetIndex1 = -1) or (sheetIndex2 = -1) then
exit(False); // unsupported case
ReadRPNCellRangeAddress(AStream, r1, c1, r2, c2, flags);
if r2 = $FFFF then r2 := Cardinal(-1);
if c2 = $FF then c2 := Cardinal(-1);
ARPNItem := RPNCellRange3D(
FBiff8ExternSheets[sheetIndex].FirstSheetIndex, r1, c1,
FBiff8ExternSheets[sheetIndex].LastSheetIndex, r2, c2,
flags, ARPNItem);
sheetIndex1, r1, c1,
sheetIndex2, r2, c2,
flags, ARPNItem
);
end;
{ Reads the difference between row and column corner indexes of a cell range
@@ -1311,6 +1360,31 @@ begin
if (c2 and MASK_EXCEL_RELATIVE_ROW <> 0) then Include(AFlags, rfRelRow2);
end;
procedure TsSpreadBIFF8Reader.ReadRPNSheetIndex(AStream: TStream;
out ASheet1, ASheet2: Integer);
var
refIndex: Word;
ref: TBiff8ExternSheet;
extbook: TBiff8ExternBook;
begin
// Index to REF entry in EXTERNSHEET record
refIndex := WordLEToN(AStream.ReadWord);
ref := FBiff8ExternSheets[refIndex];
extBook := FBiff8ExternBooks[ref.ExternBookIndex] as TBiff8ExternBook;
// Only links to internal sheets supported so far.
if extBook.Kind <> ebkInternal then
begin
ASheet1 := -1;
ASheet2 := -1;
exit;
end;
ASheet1 := ref.FirstSheetIndex;
ASheet2 := ref.LastSheetIndex;
end;
procedure TsSpreadBIFF8Reader.ReadRSTRING(AStream: TStream);
var
j, L: Word;
@@ -1801,7 +1875,61 @@ begin
// Skip rest...
end;
{ Reads an EXTERNSHEET record. Needed for named cells and print ranges. }
procedure TsSpreadBIFF8Reader.ReadEXTERNBOOK(const AStream: TStream);
var
i, n: Integer;
url: widestring;
sheetnames: widestring;
externbook: TBiff8Externbook;
p: Int64;
t: array[0..1] of byte;
begin
if FBiff8ExternBooks = nil then
FBiff8ExternBooks := TFPObjectList.Create(true);
externBook := TBiff8ExternBook.Create;
// Count of sheets in book
n := WordLEToN(AStream.ReadWord);
// Determine type of book
p := AStream.Position;
AStream.ReadBuffer(t[0], 2);
if (t[0] = 1) and (t[1] = 4) then
externbook.Kind := ebkInternal
else
if (t[0] = 1) and (t[1] = $3A) then
externbook.Kind := ebkAddInFunc
else
if n = 0 then
externbook.Kind := ebkDDE_OLE
else
externbook.Kind := ebkExternal;
if (externbook.Kind = ebkExternal) then
begin
AStream.Position := p;
// Encoded URL without sheet name (Unicode string, 16bit string length)
url := ReadWideString(AStream, false);
externbook.DocumentURL := UTF8Encode(url);
if n = 0 then
sheetnames := ''
else begin
// Sheet names (Unicode strings with 16bit string length)
sheetnames := UTF8Encode(ReadWideString(AStream, false));
for i := 2 to n do
sheetnames := sheetnames + #1 + UTF8Encode(ReadWideString(AStream, false));
end;
externbook.SheetNames := sheetNames;
end;
FBiff8ExternBooks.Add(externbook);
end;
{ Reads an EXTERNSHEET record. Needed for 3d-references, named cells and
print ranges. }
procedure TsSpreadBIFF8Reader.ReadEXTERNSHEET(const AStream: TStream);
var
numItems: Word;

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

@@ -395,7 +395,7 @@ type
FCurSheetIndex: Integer;
FActivePane: Integer;
FExternSheets: TStrings;
FSheetList: TFPList;
// FSheetList: TFPList;
procedure AddBuiltinNumFormats; override;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual;
@@ -485,6 +485,7 @@ type
out AFlags: TsRelFlags); virtual;
function ReadRPNFunc(AStream: TStream): Word; virtual;
procedure ReadRPNSharedFormulaBase(AStream: TStream; out ARow, ACol: Cardinal); virtual;
procedure ReadRPNSheetIndex(AStream: TStream; out ASheet1, ASheet2: Integer); virtual;
function ReadRPNTokenArray(AStream: TStream; ACell: PCell;
ASharedFormulaBase: PCell = nil): Boolean; overload;
function ReadRPNTokenArray(AStream: TStream; ARpnTokenArraySize: Word;
@@ -505,11 +506,12 @@ type
procedure ReadWindow2(AStream: TStream); virtual;
// Read WINDOWPROTECT record
procedure ReadWindowProtect(AStream: TStream);
protected
procedure InternalReadFromStream(AStream: TStream);
procedure ReadWorkbookGlobals(AStream: TStream); virtual;
procedure ReadWorksheet(AStream: TStream); virtual;
procedure InternalReadFromStream(AStream: TStream);
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
@@ -976,7 +978,7 @@ constructor TsSpreadBIFFReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FSheetList := TFPList.Create;
// FSheetList := TFPList.Create;
FPalette := TsPalette.Create;
PopulatePalette;
@@ -1006,9 +1008,9 @@ var
begin
for j:=0 to FDefinedNames.Count-1 do TObject(FDefinedNames[j]).Free;
FDefinedNames.Free;
{
for j:= 0 to FSheetList.Count-1 do TObject(FSheetList[j]).Free;
FSheetList.Free;
FSheetList.Free; }
FExternSheets.Free;
FPalette.Free;
@@ -2471,6 +2473,17 @@ begin
ACol := WordLEToN(AStream.ReadWord);
end;
{@@ ----------------------------------------------------------------------------
Reads the indexes of the first and last worksheet of a cell reference used
in a formula from the current stream position.
Place holder - must be overridden! }
procedure TsSpreadBIFFReader.ReadRPNSheetIndex(AStream: TStream;
out ASheet1, ASheet2: Integer);
begin
ASheet1 := -1;
ASheet2 := -1;
end;
{@@ ----------------------------------------------------------------------------
Reads the array of rpn tokens from the current stream position, creates an
rpn formula, converts it to a string formula and stores it in the cell.
@@ -2666,6 +2679,7 @@ var
funcCode: Word;
b: Byte;
found: Boolean;
sheet1, sheet2: Integer;
begin
rpnItem := nil;
p0 := AStream.Position;
@@ -2716,6 +2730,21 @@ begin
INT_EXCEL_TOKEN_TREFN_R: rpnItem := RPNCellRef(r, c, flags, rpnItem);
end;
end;
INT_EXCEL_TOKEN_TREF3D_R, INT_EXCEL_TOKEN_TREF3d_V:
begin
ReadRPNSheetIndex(AStream, sheet1, sheet2);
ReadRPNCellAddressOffset(AStream, dr, dc, flags);
if (rfRelRow in flags)
then r := LongInt(ACell^.Row) + dr
else r := dr;
if (rfRelCol in flags)
then c := LongInt(ACell^.Col) + dc
else c := dc;
case token of
INT_EXCEL_TOKEN_TREF3D_V: rpnItem := RpnCellValue3D(sheet1, r, c, flags, rpnItem);
INT_EXCEL_TOKEN_TREF3D_R: rpnItem := RpnCellRef3D(sheet1, r, c, flags, rpnItem);
end;
end;
INT_EXCEL_TOKEN_TAREA3D_R:
begin
if not ReadRPNCellRange3D(AStream, rpnItem) then supported := false;
@@ -3046,6 +3075,7 @@ var
BIFFEOF: Boolean;
i: Integer;
sheet: TsWorksheet;
numsheets: Integer;
begin
// Check if the operation succeeded
if AStream.Size = 0 then
@@ -3060,6 +3090,7 @@ begin
{ Read workbook globals }
ReadWorkbookGlobals(AStream);
numSheets := FWorkbook.GetWorksheetCount;
{ Check for the end of the file }
if AStream.Position >= AStream.Size then
@@ -3078,12 +3109,12 @@ begin
inc(FCurSheetIndex);
// It can happen in files written by Office97 that the OLE directory is
// at the end of the file.
if FCurSheetIndex = FSheetList.Count then
if FCurSheetIndex = numSheets then
BIFFEOF := true;
end;
{ Extract print ranges, repeated rows/cols }
for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
for i := 0 to numSheets - 1 do begin
sheet := FWorkbook.GetWorksheetByIndex(i);
FixDefinedNames(sheet);
ExtractPrintRanges(sheet);

4
components/fpspreadsheet/source/laz_fpspreadsheet.lpk
View File

@@ -23,6 +23,10 @@
</CompilerMessages>
<CustomOptions Value="$(IDEBuildOptions)
-dDisableWrapperFunctions"/>
<OtherDefines Count="2">
<Define0 Value="DisableWrapperFunctions"/>
<Define1 Value="FPSDebug"/>
</OtherDefines>
</Other>
</CompilerOptions>
<Description Value="laz_fpspreadsheet is a non-visual component that allows you to use the fpspreadsheet package to read/write spreadsheet files in .xls (BIFF/Excel), .ods OpenDocument (LibreOffice/OpenOffice) and .xlsx Open XML (Excel) formats.

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

@@ -35,6 +35,7 @@ type
UseRPNFormula: Boolean);
procedure Test_Write_Read_CalcFormulas(AFormat: TsSpreadsheetformat;
UseRPNFormula: Boolean);
procedure Test_Write_Read_Calc3DFormulas(AFormat: TsSpreadsheetFormat);
published
// Writes out formulas & reads them back.
@@ -74,6 +75,12 @@ type
{ ODS Tests }
procedure Test_Write_Read_CalcStringFormula_ODS;
{ Formulas with 3D references to other sheets }
procedure Test_Write_Read_Calc3DFormula_BIFF8;
procedure Test_Write_Read_Calc3DFormula_OOXML;
procedure Test_Write_Read_Calc3DFormula_ODS;
end;
implementation
@@ -681,6 +688,143 @@ begin
end;
*)
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_Calc3DFormulas(
AFormat: TsSpreadsheetFormat);
{ If UseRPNFormula is TRUE, the test formulas are generated from RPN syntax,
otherwise string formulas are used. }
var
sheet1, sheet2, sheet3: TsWorksheet;
workbook: TsWorkbook;
row: Integer;
tempFile: string; //write xls/xml to this file and read back from it
actual: TsExpressionResult;
expected: TsExpressionResult;
cell: PCell;
sollValues: array of TsExpressionResult;
formula: String;
ErrorMargin: Double;
begin
ErrorMargin:=0; //1.44E-7;
//1.44E-7 for SUMSQ formula
//6.0E-8 for SUM formula
//4.8E-8 for MAX formula
//2.4E-8 for now formula
//about 1E-15 is needed for some trig functions
// Create test workbook
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boCalcBeforeSaving];
sheet1 := workBook.AddWorksheet('Sheet1');
sheet2 := workbook.AddWorksheet('Sheet2');
sheet3 := workbook.AddWorksheet('Sheet3');
{ Write out test formulas.
This include file creates various formulas in column A and stores
the expected results in the array SollValues. }
Row := 0;
TempFile := GetTempFileName;
{$I testcases_calc3dformula.inc}
workbook.WriteToFile(TempFile, AFormat, true);
finally
workbook.Free;
end;
// Open the workbook
workbook := TsWorkbook.Create;
try
workbook.Options := workbook.Options + [boReadFormulas];
workbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
Fail('This test should not be executed')
else
sheet1 := workbook.GetWorksheetByName('Sheet1');
if sheet1=nil then
Fail('Error in test code. Failed to get named worksheet');
for row := 0 to sheet1.GetLastRowIndex do
begin
cell := sheet1.FindCell(Row, 1);
if (cell = nil) then
fail('Error in test code: Failed to get cell ' + CellNotation(sheet1, Row, 1));
case cell^.ContentType of
cctBool : actual := BooleanResult(cell^.BoolValue);
cctNumber : actual := FloatResult(cell^.NumberValue);
cctDateTime : actual := DateTimeResult(cell^.DateTimeValue);
cctUTF8String : actual := StringResult(cell^.UTF8StringValue);
cctError : actual := ErrorResult(cell^.ErrorValue);
cctEmpty : actual := EmptyResult;
else fail('ContentType not supported');
end;
expected := SollValues[row];
// Cell does not store integers!
if expected.ResultType = rtInteger then expected := FloatResult(expected.ResInteger);
(*
// The now function result is volatile, i.e. changes continuously. The
// time for the soll value was created such that we can expect to have
// the file value in the same second. Therefore we neglect the milliseconds.
if formula = '=NOW()' then begin
// Round soll value to seconds
DecodeTime(expected.ResDateTime, hr,min,sec,msec);
expected.ResDateTime := EncodeTime(hr, min, sec, 0);
// Round formula value to seconds
DecodeTime(actual.ResDateTime, hr,min,sec,msec);
actual.ResDateTime := EncodeTime(hr,min,sec,0);
end; *)
case actual.ResultType of
rtBoolean:
CheckEquals(BoolToStr(expected.ResBoolean), BoolToStr(actual.ResBoolean),
'Test read calculated formula result mismatch, cell '+CellNotation(sheet1, Row, 1));
rtFloat:
{$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)}
// FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64
CheckEquals(expected.ResFloat, actual.ResFloat, ErrorMargin,
'Test read calculated formula result mismatch, cell '+CellNotation(sheet1, Row, 1));
{$else}
// Non-Windows: test without error margin
CheckEquals(expected.ResFloat, actual.ResFloat,
'Test read calculated formula result mismatch, cell '+CellNotation(sheet1, Row, 1));
{$endif}
rtString:
CheckEquals(expected.ResString, actual.ResString,
'Test read calculated formula result mismatch, cell '+CellNotation(sheet1, Row, 1));
rtError:
CheckEquals(
GetEnumName(TypeInfo(TsErrorValue), ord(expected.ResError)),
GetEnumname(TypeInfo(TsErrorValue), ord(actual.ResError)),
'Test read calculated formula error value mismatch, cell '+CellNotation(sheet1, Row, 1));
end;
end;
finally
workbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_Calc3DFormula_BIFF8;
begin
Test_Write_Read_Calc3DFormulas(sfExcel8);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_Calc3DFormula_OOXML;
begin
Test_Write_Read_Calc3DFormulas(sfOOXML);
end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_Calc3DFormula_ODS;
begin
Test_Write_Read_Calc3DFormulas(sfOpenDocument);
end;
initialization
// Register so these tests are included in a full run
RegisterTest(TSpreadWriteReadFormulaTests);

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

@@ -38,7 +38,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="28">
<Units Count="29">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@@ -152,6 +152,10 @@
<Filename Value="ssttests.pas"/>
<IsPartOfProject Value="True"/>
</Unit27>
<Unit28>
<Filename Value="testcases_calc3dformula.inc"/>
<IsPartOfProject Value="True"/>
</Unit28>
</Units>
</ProjectOptions>
<CompilerOptions>

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

@@ -6,7 +6,8 @@ program spreadtestgui;
uses
{$IFDEF HEAPTRC}
HeapTrc, SysUtils,
//HeapTrc,
SysUtils,
{$ENDIF}
Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests,
manualtests, testsutility, internaltests, formattests, colortests, fonttests,

81
components/fpspreadsheet/tests/testcases_calc3dformula.inc Normal file
View File

@@ -0,0 +1,81 @@
{ include file for "formulatests.pas", containing the test cases for the
calc3dformula test. }
// Setting up some test numbers
sheet1.WriteText(0, 4, 'abc'); // E1 = 'abc'
sheet1.WriteNumber(1, 5, 12.0); // F2 = 12.0
sheet2.WriteText(2, 1, 'A'); // B3 = 'A'
sheet2.WriteNumber(1, 4, 1.0); // E2 = 1.0
sheet3.WriteText(1, 2, 'B'); // C2 = 'B'
sheet3.WriteNumber(1, 1, 2.0); // B2 = 2.0
//------------------------------------------------------------------------------
Row := 0;
formula := 'Sheet2!B3'; { A1 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('A');
inc(Row);
formula := 'Sheet2!B3&Sheet3!C2'; { A2 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('AB');
inc(Row);
formula := 'Sheet2!E2'; { A3 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := FloatResult(1.0);
inc(Row);
formula := 'Sheet2!E2+Sheet3!B2'; { A4 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := FloatResult(3.0);
inc(Row);
formula := 'E1&Sheet2!B3'; { A5 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, 'E1&Sheet2!B3');
SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('abcA');
inc(Row); { A6 }
formula := 'F2-Sheet2!E2-11';
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := FloatResult(0.0);
inc(Row);
formula := 'Sheet2!$B$3'; { A7 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('A');
inc(Row);
formula := 'Sheet2!B$3&Sheet3!$C2'; { A8 }
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, formula);
SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('AB');
{
inc(Row);
formula := 'D1&Sheet2!B3%"BC"';
sheet1.WriteText(Row, 0, formula);
sheet1.WriteFormula(Row, 1, 'D1&Sheet2!B3%"BC"');
SetLength(SollValues, Row+1);
SollValues[Row] := StringResult('abcABC');
}