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

fpspreadsheet: Move rpn stuff from fpspreadsheet.pas to a new unit fpsRPN.pas. Move translatable strings from fpspreadsheet.pas to a new unit fpsStrings.pas. Make sure that all demos still run in the new environment.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3572 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-17 08:38:31 +00:00
parent 10ad6b7a1a
commit b22ab8deba
13 changed files with 74 additions and 686 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

@ -10,7 +10,7 @@ program excel8write;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpspreadsheet, xlsbiff8;
Classes, SysUtils, fpspreadsheet, fpsRPN, xlsbiff8;
const
Str_First = 'First';

35
components/fpspreadsheet/examples/fpschart/mainform.lfm
View File

@ -1,7 +1,7 @@
object FPSChartForm: TFPSChartForm
Left = 239
Left = 259
Height = 382
Top = 154
Top = 146
Width = 700
Caption = 'FPSpreadsheet Chart Example'
ClientHeight = 382
@ -43,13 +43,14 @@ object FPSChartForm: TFPSChartForm
FrozenCols = 0
FrozenRows = 0
ReadFormulas = False
AutoAdvance = aaDown
ColCount = 27
ExtendedSelect = False
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll]
RowCount = 101
TabOrder = 1
ColWidths = (
42
56
64
64
64
@ -88,9 +89,9 @@ object FPSChartForm: TFPSChartForm
TabOrder = 2
end
object Label1: TLabel
Left = 16
Height = 34
Top = 8
Left = 14
Height = 42
Top = 4
Width = 676
AutoSize = False
Caption = 'Please add data to the grid or load it from a file, then choose the location of the data for the X and Y axises and click on the button "Create Graphic" to generate a chart.'
@ -99,7 +100,7 @@ object FPSChartForm: TFPSChartForm
end
object editSourceFile: TFileNameEdit
Left = 152
Height = 23
Height = 28
Top = 48
Width = 136
DialogOptions = []
@ -112,9 +113,9 @@ object FPSChartForm: TFPSChartForm
end
object Label2: TLabel
Left = 14
Height = 15
Height = 20
Top = 51
Width = 106
Width = 134
Caption = 'Source Spreadsheet:'
ParentColor = False
end
@ -129,7 +130,7 @@ object FPSChartForm: TFPSChartForm
end
object editXAxis: TLabeledEdit
Left = 64
Height = 23
Height = 28
Top = 80
Width = 80
EditLabel.AnchorSideTop.Control = editXAxis
@ -137,10 +138,10 @@ object FPSChartForm: TFPSChartForm
EditLabel.AnchorSideRight.Control = editXAxis
EditLabel.AnchorSideBottom.Control = editXAxis
EditLabel.AnchorSideBottom.Side = asrBottom
EditLabel.Left = 25
EditLabel.Height = 15
EditLabel.Left = 16
EditLabel.Height = 20
EditLabel.Top = 84
EditLabel.Width = 36
EditLabel.Width = 45
EditLabel.Caption = 'X-Axis:'
EditLabel.ParentColor = False
LabelPosition = lpLeft
@ -149,7 +150,7 @@ object FPSChartForm: TFPSChartForm
end
object EditYAxis: TLabeledEdit
Left = 208
Height = 23
Height = 28
Top = 80
Width = 80
EditLabel.AnchorSideTop.Control = EditYAxis
@ -157,10 +158,10 @@ object FPSChartForm: TFPSChartForm
EditLabel.AnchorSideRight.Control = EditYAxis
EditLabel.AnchorSideBottom.Control = EditYAxis
EditLabel.AnchorSideBottom.Side = asrBottom
EditLabel.Left = 169
EditLabel.Height = 15
EditLabel.Left = 161
EditLabel.Height = 20
EditLabel.Top = 84
EditLabel.Width = 36
EditLabel.Width = 44
EditLabel.Caption = 'Y-Axis:'
EditLabel.ParentColor = False
LabelPosition = lpLeft

2
components/fpspreadsheet/examples/other/demo_write_formula.pas
View File

@ -11,7 +11,7 @@ program demo_write_formula;
uses
Classes, SysUtils,
fpspreadsheet, xlsbiff5, xlsbiff8, fpsopendocument;
fpspreadsheet, xlsbiff5, xlsbiff8, fpsopendocument, fpsRPN;
var
MyWorkbook: TsWorkbook;

2
components/fpspreadsheet/fpsexprparser.pas
View File

@ -52,7 +52,7 @@ unit fpsExprParser;
interface
uses
Classes, SysUtils, contnrs, fpspreadsheet;
Classes, SysUtils, contnrs, fpspreadsheet, fpsrpn;
type
{ Tokens }

566
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1138,46 +1138,6 @@ type
Format: TsSpreadsheetFormat;
end;
{ Simple creation an RPNFormula array to be used in fpspreadsheet. }
{@@ Helper record for simplification of RPN formula creation }
PRPNItem = ^TRPNItem;
TRPNItem = record
FE: TsFormulaElement;
Next: PRPNItem;
end;
function CreateRPNFormula(AItem: PRPNItem; AReverse: Boolean = false): TsRPNFormula;
procedure DestroyRPNFormula(AItem: PRPNItem);
function RPNBool(AValue: Boolean;
ANext: PRPNItem): PRPNItem;
function RPNCellValue(ACellAddress: String;
ANext: PRPNItem): PRPNItem; overload;
function RPNCellValue(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem; overload;
function RPNCellRef(ACellAddress: String;
ANext: PRPNItem): PRPNItem; overload;
function RPNCellRef(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem; overload;
function RPNCellRange(ACellRangeAddress: String;
ANext: PRPNItem): PRPNItem; overload;
function RPNCellRange(ARow, ACol, ARow2, ACol2: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem; overload;
function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
function RPNErr(AErrCode: Byte; ANext: PRPNItem): PRPNItem;
function RPNInteger(AValue: Word; ANext: PRPNItem): PRPNItem;
function RPNMissingArg(ANext: PRPNItem): PRPNItem;
function RPNNumber(AValue: Double; ANext: PRPNItem): PRPNItem;
function RPNParenthesis(ANext: PRPNItem): PRPNItem;
function RPNString(AValue: String; ANext: PRPNItem): PRPNItem;
function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem; overload;
function RPNFunc(AFuncName: String; ANext: PRPNItem): PRPNItem; overload;
function RPNFunc(AFuncName: String; ANumParams: Byte; ANext: PRPNItem): PRPNItem; overload;
// function FixedParamCount(AElementKind: TFEKind): Boolean;
var
GsSpreadFormats: array of TsSpreadFormatData;
@ -1201,47 +1161,7 @@ implementation
uses
Math, StrUtils, TypInfo, lazutf8,
fpsStreams, fpsUtils, fpsNumFormatParser, fpsExprParser;
{ Translatable strings }
resourcestring
lpUnsupportedReadFormat = 'Tried to read a spreadsheet using an unsupported format';
lpUnsupportedWriteFormat = 'Tried to write a spreadsheet using an unsupported format';
lpNoValidSpreadsheetFile = '"%s" is not a valid spreadsheet file';
lpInvalidWorksheetName = '"%s" is not a valid worksheet name.';
lpUnknownSpreadsheetFormat = 'unknown format';
lpMaxRowsExceeded = 'This workbook contains %d rows, but the selected ' +
'file format does not support more than %d rows.';
lpMaxColsExceeded = 'This workbook contains %d columns, but the selected ' +
'file format does not support more than %d columns.';
lpTooManyPaletteColors = 'This workbook contains more colors (%d) than ' +
'supported by the file format (%d). The additional colors are replaced by '+
'the best-matching palette colors.';
lpInvalidFontIndex = 'Invalid font index';
lpInvalidNumberFormat = 'Trying to use an incompatible number format.';
lpInvalidDateTimeFormat = 'Trying to use an incompatible date/time format.';
lpNoValidNumberFormatString = 'No valid number format string.';
lpNoValidCellAddress = '"%s" is not a valid cell address.';
lpNoValidCellRangeAddress = '"%s" is not a valid cell range address.';
lpNoValidCellRangeOrCellAddress = '"%s" is not a valid cell or cell range address.';
lpSpecifyNumberOfParams = 'Specify number of parameters for function %s';
lpIncorrectParamCount = 'Funtion %s requires at least %d and at most %d parameters.';
lpCircularReference = 'Circular reference found when calculating worksheet formulas';
lpTRUE = 'TRUE';
lpFALSE = 'FALSE';
lpErrEmptyIntersection = '#NULL!';
lpErrDivideByZero = '#DIV/0!';
lpErrWrongType = '#VALUE!';
lpErrIllegalRef = '#REF!';
lpErrWrongName = '#NAME?';
lpErrOverflow = '#NUM!';
lpErrArgError = '#N/A';
lpErrFormulaNotSupported = '<FORMULA?>';
lpFileNotFound = 'File "%s" not found.';
{%H-}lpNoValidDateTimeFormatString = 'No valid date/time format string.';
{%H-}lpIllegalNumberFormat = 'Illegal number format.';
fpsStrings, fpsStreams, fpsUtils, fpsNumFormatParser, fpsExprParser;
const
{ These are reserved system colors by Microsoft
@ -1545,7 +1465,7 @@ begin
sfCSV : Result := 'CSV';
sfWikiTable_Pipes : Result := 'WikiTable Pipes';
sfWikiTable_WikiMedia : Result := 'WikiTable WikiMedia';
else Result := lpUnknownSpreadsheetFormat;
else Result := rsUnknownSpreadsheetFormat;
end;
end;
@ -2243,7 +2163,7 @@ begin
if ParseCellString(AddressStr, r, c) then
Result := GetCell(r, c)
else
raise Exception.CreateFmt(lpNoValidCellAddress, [AddressStr]);
raise Exception.CreateFmt(rsNoValidCellAddress, [AddressStr]);
end;
{@@
@ -2714,17 +2634,17 @@ begin
cctDateTime:
Result := DateTimeToStrNoNaN(DateTimeValue, NumberFormat, NumberFormatStr);
cctBool:
Result := StrUtils.IfThen(BoolValue, lpTRUE, lpFALSE);
Result := StrUtils.IfThen(BoolValue, rsTRUE, rsFALSE);
cctError:
case TsErrorValue(ErrorValue) of
errEmptyIntersection : Result := lpErrEmptyIntersection;
errDivideByZero : Result := lpErrDivideByZero;
errWrongType : Result := lpErrWrongType;
errIllegalRef : Result := lpErrIllegalRef;
errWrongName : Result := lpErrWrongName;
errOverflow : Result := lpErrOverflow;
errArgError : Result := lpErrArgError;
errFormulaNotSupported: Result := lpErrFormulaNotSupported;
errEmptyIntersection : Result := rsErrEmptyIntersection;
errDivideByZero : Result := rsErrDivideByZero;
errWrongType : Result := rsErrWrongType;
errIllegalRef : Result := rsErrIllegalRef;
errWrongName : Result := rsErrWrongName;
errOverflow : Result := rsErrOverflow;
errArgError : Result := rsErrArgError;
errFormulaNotSupported: Result := rsErrFormulaNotSupported;
end;
else
Result := '';
@ -3396,7 +3316,7 @@ procedure TsWorksheet.WriteNumber(ACell: PCell; ANumber: Double;
AFormat: TsNumberFormat; ADecimals: Byte = 2);
begin
if IsDateTimeFormat(AFormat) or IsCurrencyFormat(AFormat) then
raise Exception.Create(lpInvalidNumberFormat);
raise Exception.Create(rsInvalidNumberFormat);
if ACell <> nil then begin
ACell^.ContentType := cctNumber;
@ -3457,10 +3377,10 @@ begin
try
// Format string ok?
if parser.Status <> psOK then
raise Exception.Create(lpNoValidNumberFormatString);
raise Exception.Create(rsNoValidNumberFormatString);
// Make sure that we do not write a date/time value here
if parser.IsDateTimeFormat
then raise Exception.Create(lpInvalidNumberFormat);
then raise Exception.Create(rsInvalidNumberFormat);
// If format string matches a built-in format use its format identifier,
// All this is considered when calling Builtin_NumFormat of the parser.
finally
@ -3809,10 +3729,10 @@ begin
try
// Format string ok?
if parser.Status <> psOK then
raise Exception.Create(lpNoValidNumberFormatString);
raise Exception.Create(rsNoValidNumberFormatString);
// Make sure that we do not use a number format for date/times values.
if not parser.IsDateTimeFormat
then raise Exception.Create(lpInvalidDateTimeFormat);
then raise Exception.Create(rsInvalidDateTimeFormat);
// Avoid possible duplication of standard formats
if AFormat = nfCustom then
AFormat := parser.NumFormat;
@ -4328,7 +4248,7 @@ begin
if (AFontIndex < 0) or (AFontIndex >= Workbook.GetFontCount) or (AFontIndex = 4) then
// note: Font index 4 is not defined in BIFF
raise Exception.Create(lpInvalidFontIndex);
raise Exception.Create(rsInvalidFontIndex);
Include(ACell^.UsedFormattingFields, uffFont);
ACell^.FontIndex := AFontIndex;
@ -5668,7 +5588,7 @@ end;
a different format.
@return An instance of a TsCustomSpreadReader descendent which is able to
read thi given file format.
read the given file format.
}
function TsWorkbook.CreateSpreadReader(AFormat: TsSpreadsheetFormat): TsCustomSpreadReader;
var
@ -5683,7 +5603,7 @@ begin
Break;
end;
if Result = nil then raise Exception.Create(lpUnsupportedReadFormat);
if Result = nil then raise Exception.Create(rsUnsupportedReadFormat);
end;
{@@
@ -5708,7 +5628,7 @@ begin
Break;
end;
if Result = nil then raise Exception.Create(lpUnsupportedWriteFormat);
if Result = nil then raise Exception.Create(rsUnsupportedWriteFormat);
end;
{@@
@ -5746,7 +5666,7 @@ var
AReader: TsCustomSpreadReader;
begin
if not FileExists(AFileName) then
raise Exception.CreateFmt(lpFileNotFound, [AFileName]);
raise Exception.CreateFmt(rsFileNotFound, [AFileName]);
AReader := CreateSpreadReader(AFormat);
try
@ -5774,7 +5694,7 @@ var
lException: Exception = nil;
begin
if not FileExists(AFileName) then
raise Exception.CreateFmt(lpFileNotFound, [AFileName]);
raise Exception.CreateFmt(rsFileNotFound, [AFileName]);
valid := GetFormatFromFileName(AFileName, SheetType);
if valid then
@ -5805,7 +5725,7 @@ begin
else
ReadFromFile(AFileName, SheetType);
end else
raise Exception.CreateFmt(lpNoValidSpreadsheetFile, [AFileName]);
raise Exception.CreateFmt(rsNoValidSpreadsheetFile, [AFileName]);
end;
{@@
@ -5950,7 +5870,7 @@ function TsWorkbook.AddWorksheet(AName: string;
AcceptEmptyName: Boolean = false): TsWorksheet;
begin
if not ValidWorksheetName(AName, AcceptEmptyName) then
raise Exception.CreateFmt(lpInvalidWorksheetName, [AName]);
raise Exception.CreateFmt(rsInvalidWorksheetName, [AName]);
Result := TsWorksheet.Create;
@ -7309,7 +7229,7 @@ procedure TsCustomSpreadReader.ReadFromStrings(AStrings: TStrings;
AData: TsWorkbook);
begin
Unused(AStrings, AData);
raise Exception.Create(lpUnsupportedReadFormat);
raise Exception.Create(rsUnsupportedReadFormat);
end;
{ TsCustomSpreadWriter }
@ -7500,11 +7420,11 @@ begin
// Check row count
if lastRow >= FLimitations.MaxRowCount then
Workbook.AddErrorMsg(lpMaxRowsExceeded, [lastRow+1, FLimitations.MaxRowCount]);
Workbook.AddErrorMsg(rsMaxRowsExceeded, [lastRow+1, FLimitations.MaxRowCount]);
// Check column count
if lastCol >= FLimitations.MaxColCount then
Workbook.AddErrorMsg(lpMaxColsExceeded, [lastCol+1, FLimitations.MaxColCount]);
Workbook.AddErrorMsg(rsMaxColsExceeded, [lastCol+1, FLimitations.MaxColCount]);
// Check color count.
n := Workbook.GetPaletteSize;
@ -7512,7 +7432,7 @@ begin
for i:= FLimitations.MaxPaletteSize to n-1 do
if Workbook.UsesColor(i) then
begin
Workbook.AddErrorMsg(lpTooManyPaletteColors, [n, FLimitations.MaxPaletteSize]);
Workbook.AddErrorMsg(rsTooManyPaletteColors, [n, FLimitations.MaxPaletteSize]);
break;
end;
end;
@ -7731,7 +7651,7 @@ end;
procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings);
begin
Unused(AStrings);
raise Exception.Create(lpUnsupportedWriteFormat);
raise Exception.Create(rsUnsupportedWriteFormat);
end;
{@@
@ -7775,432 +7695,6 @@ end;
*)
{******************************************************************************}
{ Simplified creation of RPN formulas }
{******************************************************************************}
{@@
Creates a pointer to a new RPN item. This represents an element in the array
of token of an RPN formula.
@return Pointer to the RPN item
}
function NewRPNItem: PRPNItem;
begin
New(Result);
FillChar(Result^.FE, SizeOf(Result^.FE), 0);
Result^.FE.StringValue := '';
end;
{@@
Destroys an RPN item
}
procedure DisposeRPNItem(AItem: PRPNItem);
begin
if AItem <> nil then
Dispose(AItem);
end;
{@@
Creates a boolean value entry in the RPN array.
@param AValue Boolean value to be stored in the RPN item
@next ANext Pointer to the next RPN item in the list
}
function RPNBool(AValue: Boolean; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekBool;
if AValue then Result^.FE.DoubleValue := 1.0 else Result^.FE.DoubleValue := 0.0;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a cell value, specifed by its
address, e.g. 'A1'. Takes care of absolute and relative cell addresses.
@param ACellAddress Adress of the cell given in Excel A1 notation
@param ANext Pointer to the next RPN item in the list
}
function RPNCellValue(ACellAddress: String; ANext: PRPNItem): PRPNItem;
var
r,c: Cardinal;
flags: TsRelFlags;
begin
if not ParseCellString(ACellAddress, r, c, flags) then
raise Exception.CreateFmt('"%s" is not a valid cell address.', [ACellAddress]);
Result := RPNCellValue(r,c, flags, ANext);
end;
{@@
Creates an entry in the RPN array for a cell value, specifed by its
row and column index and a flag containing information on relative addresses.
@param ARow Row index of the cell
@param ACol Column index of the cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
function RPNCellValue(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekCell;
Result^.FE.Row := ARow;
Result^.FE.Col := ACol;
Result^.FE.RelFlags := AFlags;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a cell reference, specifed by its
address, e.g. 'A1'. Takes care of absolute and relative cell addresses.
"Cell reference" means that all properties of the cell can be handled.
Note that most Excel formulas with cells require the cell value only
(--> RPNCellValue)
@param ACellAddress Adress of the cell given in Excel A1 notation
@param ANext Pointer to the next RPN item in the list
}
function RPNCellRef(ACellAddress: String; ANext: PRPNItem): PRPNItem;
var
r,c: Cardinal;
flags: TsRelFlags;
begin
if not ParseCellString(ACellAddress, r, c, flags) then
raise Exception.CreateFmt(lpNoValidCellAddress, [ACellAddress]);
Result := RPNCellRef(r,c, flags, ANext);
end;
{@@
Creates an entry in the RPN array for a cell reference, specifed by its
row and column index and flags containing information on relative addresses.
"Cell reference" means that all properties of the cell can be handled.
Note that most Excel formulas with cells require the cell value only
(--> RPNCellValue)
@param ARow Row index of the cell
@param ACol Column index of the cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
function RPNCellRef(ARow, ACol: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekCellRef;
Result^.FE.Row := ARow;
Result^.FE.Col := ACol;
Result^.FE.RelFlags := AFlags;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a range of cells, specified by an
Excel-style address, e.g. A1:G5. As in Excel, use a $ sign to indicate
absolute addresses.
@param ACellRangeAddress Adress of the cell range given in Excel notation, such as A1:G5
@param ANext Pointer to the next RPN item in the list
}
function RPNCellRange(ACellRangeAddress: String; ANext: PRPNItem): PRPNItem;
var
r1,c1, r2,c2: Cardinal;
flags: TsRelFlags;
begin
if not ParseCellRangeString(ACellRangeAddress, r1,c1, r2,c2, flags) then
raise Exception.CreateFmt(lpNoValidCellRangeAddress, [ACellRangeAddress]);
Result := RPNCellRange(r1,c1, r2,c2, flags, ANext);
end;
{@@
Creates an entry in the RPN array for a range of cells, specified by the
row/column indexes of the top/left and bottom/right corners of the block.
The flags indicate relative indexes.
@param ARow Row index of the top/left cell
@param ACol Column index of the top/left cell
@param ARow2 Row index of the bottom/right cell
@param ACol2 Column index of the bottom/right cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
function RPNCellRange(ARow, ACol, ARow2, ACol2: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekCellRange;
Result^.FE.Row := ARow;
Result^.FE.Col := ACol;
Result^.FE.Row2 := ARow2;
Result^.FE.Col2 := ACol2;
Result^.FE.RelFlags := AFlags;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a relative cell reference as used in
shared formulas. The given parameters indicate the relativ offset between
the current cell coordinates and a reference rell.
@param ARowOffset Offset between current row and the row of a reference cell
@param AColOffset Offset between current column and the column of a reference cell
@param AFlags Flags specifying absolute or relative cell addresses
@param ANext Pointer to the next RPN item in the list
}
function RPNCellOffset(ARowOffset, AColOffset: Integer; AFlags: TsRelFlags;
ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekCellOffset;
Result^.FE.Row := Cardinal(ARowOffset);
Result^.FE.Col := Cardinal(AColOffset);
Result^.FE.RelFlags := AFlags;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array with an error value.
@param AErrCode Error code to be inserted (see TsErrorValue
@param ANext Pointer to the next RPN item in the list
@see TsErrorValue
}
function RPNErr(AErrCode: Byte; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekErr;
Result^.FE.IntValue := AErrCode;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a 2-byte unsigned integer
@param AValue Integer value to be inserted into the formula
@param ANext Pointer to the next RPN item in the list
}
function RPNInteger(AValue: Word; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekInteger;
Result^.FE.IntValue := AValue;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a missing argument in of function call.
Use this in a formula to indicate a missing argument
@param ANext Pointer to the next RPN item in the list.
}
function RPNMissingArg(ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekMissingArg;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a floating point number.
@param AValue Number value to be inserted into the formula
@param ANext Pointer to the next RPN item in the list
}
function RPNNumber(AValue: Double; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekNum;
Result^.FE.DoubleValue := AValue;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array which puts the current operator in parenthesis.
For display purposes only, does not affect calculation.
@param ANext Pointer to the next RPN item in the list
}
function RPNParenthesis(ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekParen;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for a string.
@param AValue String to be inserted into the formula
@param ANext Pointer to the next RPN item in the list
}
function RPNString(AValue: String; ANext: PRPNItem): PRPNItem;
begin
Result := NewRPNItem;
Result^.FE.ElementKind := fekString;
Result^.FE.StringValue := AValue;
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for an Excel function or operation
specified by its TokenID (--> TFEKind). Note that array elements for all
needed parameters must have been created before.
@param AToken Formula element indicating the function to be executed,
see the TFEKind enumeration for possible values.
@param ANext Pointer to the next RPN item in the list
@see TFEKind
}
function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem;
begin
{
if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then
raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]);
}
Result := NewRPNItem;
Result^.FE.ElementKind := AToken;
Result^.Fe.FuncName := '';
Result^.Next := ANext;
end;
{@@
Creates an entry in the RPN array for an Excel function or operation
specified by its TokenID (--> TFEKind). Note that array elements for all
needed parameters must have been created before.
@param AToken Formula element indicating the function to be executed,
see the TFEKind enumeration for possible values.
@param ANext Pointer to the next RPN item in the list
@see TFEKind
}
function RPNFunc(AFuncName: String; ANext: PRPNItem): PRPNItem;
begin
{
if FEProps[AToken].MinParams <> FEProps[AToken].MaxParams then
raise Exception.CreateFmt(lpSpecifyNumberOfParams, [FEProps[AToken].Symbol]);
}
Result := RPNFunc(AFuncName, 255, ANext); //FEProps[AToken].MinParams, ANext);
end;
{@@
Creates an entry in the RPN array for an Excel function or operation
specified by its TokenID (--> TFEKind). Specify the number of parameters used.
They must have been created before.
@param AToken Formula element indicating the function to be executed,
see the TFEKind enumeration for possible values.
@param ANumParams Number of arguments used in the formula. If -1 then the
fixed number of arguments known from the function definiton
is used.
@param ANext Pointer to the next RPN item in the list
@see TFEKind
}
function RPNFunc(AFuncName: String; ANumParams: Byte; ANext: PRPNItem): PRPNItem;
begin
{
if (ANumParams > -1) then
if (ANumParams < FEProps[AToken].MinParams) or (ANumParams > FEProps[AToken].MaxParams) then
raise Exception.CreateFmt(lpIncorrectParamCount, [
FEProps[AToken].Symbol, FEProps[AToken].MinParams, FEProps[AToken].MaxParams
]);
}
Result := NewRPNItem;
Result^.FE.ElementKind := fekFunc;
Result^.Fe.FuncName := AFuncName;
Result^.FE.ParamsNum := ANumParams;
Result^.Next := ANext;
end;
(*
{@@
Returns if the function defined by the token requires a fixed number of parameter.
@param AElementKind Identifier of the formula function considered
}
function FixedParamCount(AElementKind: TFEKind): Boolean;
begin
Result := (FEProps[AElementKind].MinParams = FEProps[AElementKind].MaxParams)
and (FEProps[AElementKind].MinParams >= 0);
end;
*)
{@@
Creates an RPN formula by a single call using nested RPN items.
For each formula element, use one of the RPNxxxx functions implemented here.
They are designed to be nested into each other. Terminate the chain by using nil.
@param AItem Pointer to the first RPN item representing the formula.
Each item contains a pointer to the next item in the list.
The list is terminated by nil.
@param AReverse If true the first rpn item in the chained list becomes the
last item in the token array. This feature is needed for
reading an xls file.
@example
The RPN formula for the string expression "$A1+2" can be created as follows:
<pre>
var
f: TsRPNFormula;
begin
f := CreateRPNFormula(
RPNCellValue('$A1',
RPNNumber(2,
RPNFunc(fekAdd,
nil))));
</pre>
}
function CreateRPNFormula(AItem: PRPNItem; AReverse: Boolean = false): TsRPNFormula;
var
item: PRPNItem;
nextitem: PRPNItem;
n: Integer;
begin
// Determine count of RPN elements
n := 0;
item := AItem;
while item <> nil do begin
inc(n);
item := item^.Next;
end;
// Set array length of TsRPNFormula result
SetLength(Result, n);
// Copy FormulaElements to result and free temporary RPNItems
item := AItem;
if AReverse then n := Length(Result)-1 else n := 0;
while item <> nil do begin
nextitem := item^.Next;
Result[n] := item^.FE;
if AReverse then dec(n) else inc(n);
DisposeRPNItem(item);
item := nextitem;
end;
end;
{@@
Destroys the RPN formula starting with the given RPN item.
@param AItem Pointer to the first RPN items representing the formula.
Each item contains a pointer to the next item in the list.
The list is terminated by nil.
}
procedure DestroyRPNFormula(AItem: PRPNItem);
var
nextitem: PRPNItem;
begin
while AItem <> nil do begin
nextitem := AItem^.Next;
DisposeRPNItem(AItem);
AItem := nextitem;
end;
end;
initialization
MakeLEPalette(@DEFAULT_PALETTE, Length(DEFAULT_PALETTE));

3
components/fpspreadsheet/fpsutils.pas
View File

@ -499,6 +499,9 @@ function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
end;
if AStartPos = 1 then Include(AFlags, rfRelCol);
if i > Length(AStr) then
exit;
isAbs := (AStr[i] = '$');
if isAbs then inc(i);

3
components/fpspreadsheet/fpsxmlcommon.pas
View File

@ -1,3 +1,6 @@
{ fpsxmlcommon.pas
Unit shared by all xml-type reader/writer classes }
unit fpsxmlcommon;
{$mode objfpc}

10
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -25,7 +25,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="2"/>
<Files Count="23">
<Files Count="25">
<Item1>
<Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
@ -118,6 +118,14 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpsfunc.pas"/>
<UnitName Value="fpsfunc"/>
</Item23>
<Item24>
<Filename Value="fpsrpn.pas"/>
<UnitName Value="fpsrpn"/>
</Item24>
<Item25>
<Filename Value="fpsstrings.pas"/>
<UnitName Value="fpsStrings"/>
</Item25>
</Files>
<RequiredPkgs Count="2">
<Item1>

2
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -11,7 +11,7 @@ uses
fpsxmlcommon, xlsbiff2, xlsbiff5, xlsbiff8, xlsxooxml, fpsopendocument,
fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole,
uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream,
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc;
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsrpn, fpsStrings;
implementation

2
components/fpspreadsheet/tests/errortests.pas
View File

@ -35,7 +35,7 @@ type
implementation
uses
StrUtils, xlsbiff5;
StrUtils, fpsRPN, xlsbiff5;
const
ERROR_SHEET = 'ErrorTest'; //worksheet name

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

@ -107,7 +107,7 @@ type
implementation
uses
math, typinfo, lazUTF8, fpsUtils, rpnFormulaUnit;
math, typinfo, lazUTF8, fpsUtils, fpsRPN, rpnFormulaUnit;
var
// Array containing the "true" results of the formulas, for comparison

2
components/fpspreadsheet/tests/rpnformulaunit.pas
View File

@ -15,7 +15,7 @@ procedure WriteRPNFormulaSamples(Worksheet: TsWorksheet;
implementation
uses
Math, StrUtils;
Math, StrUtils, fpsRPN;
const
FALSE_TRUE: array[Boolean] of String = ('FALSE', 'TRUE');

129
components/fpspreadsheet/xlscommon.pas
View File

@ -394,7 +394,8 @@ type
implementation
uses
AVL_Tree, Math, Variants, xlsConst, fpsNumFormatParser, fpsExprParser;
AVL_Tree, Math, Variants,
xlsConst, fpsNumFormatParser, fpsrpn, fpsExprParser;
const
{ Helper table for rpn formulas:
@ -431,129 +432,7 @@ const
INT_EXCEL_TOKEN_TPAREN, {Operator in parenthesis}
Word(-1) {fekFunc}
);
(*
// Math functions
INT_EXCEL_SHEET_FUNC_ABS, {fekABS}
INT_EXCEL_SHEET_FUNC_ACOS, {fekACOS}
INT_EXCEL_SHEET_FUNC_ACOSH, {fekACOSH}
INT_EXCEL_SHEET_FUNC_ASIN, {fekASIN}
INT_EXCEL_SHEET_FUNC_ASINH, {fekASINH}
INT_EXCEL_SHEET_FUNC_ATAN, {fekATAN}
INT_EXCEL_SHEET_FUNC_ATANH, {fekATANH}
INT_EXCEL_SHEET_FUNC_COS, {fekCOS}
INT_EXCEL_SHEET_FUNC_COSH, {fekCOSH}
INT_EXCEL_SHEET_FUNC_DEGREES, {fekDEGREES}
INT_EXCEL_SHEET_FUNC_EXP, {fekEXP}
INT_EXCEL_SHEET_FUNC_INT, {fekINT}
INT_EXCEL_SHEET_FUNC_LN, {fekLN}
INT_EXCEL_SHEET_FUNC_LOG, {fekLOG}
INT_EXCEL_SHEET_FUNC_LOG10, {fekLOG10}
INT_EXCEL_SHEET_FUNC_PI, {fekPI}
INT_EXCEL_SHEET_FUNC_RADIANS, {fekRADIANS}
INT_EXCEL_SHEET_FUNC_RAND, {fekRAND}
INT_EXCEL_SHEET_FUNC_ROUND, {fekROUND}
INT_EXCEL_SHEET_FUNC_SIGN, {fekSIGN}
INT_EXCEL_SHEET_FUNC_SIN, {fekSIN}
INT_EXCEL_SHEET_FUNC_SINH, {fekSINH}
INT_EXCEL_SHEET_FUNC_SQRT, {fekSQRT}
INT_EXCEL_SHEET_FUNC_TAN, {fekTAN}
INT_EXCEL_SHEET_FUNC_TANH, {fekTANH}
// Date/time functions
INT_EXCEL_SHEET_FUNC_DATE, {fekDATE}
INT_EXCEL_SHEET_FUNC_DATEDIF, {fekDATEDIF}
INT_EXCEL_SHEET_FUNC_DATEVALUE, {fekDATEVALUE}
INT_EXCEL_SHEET_FUNC_DAY, {fekDAY}
INT_EXCEL_SHEET_FUNC_HOUR, {fekHOUR}
INT_EXCEL_SHEET_FUNC_MINUTE, {fekMINUTE}
INT_EXCEL_SHEET_FUNC_MONTH, {fekMONTH}
INT_EXCEL_SHEET_FUNC_NOW, {fekNOW}
INT_EXCEL_SHEET_FUNC_SECOND, {fekSECOND}
INT_EXCEL_SHEET_FUNC_TIME, {fekTIME}
INT_EXCEL_SHEET_FUNC_TIMEVALUE, {fekTIMEVALUE}
INT_EXCEL_SHEET_FUNC_TODAY, {fekTODAY}
INT_EXCEL_SHEET_FUNC_WEEKDAY, {fekWEEKDAY}
INT_EXCEL_SHEET_FUNC_YEAR, {fekYEAR}
// Statistical functions
INT_EXCEL_SHEET_FUNC_AVEDEV, {fekAVEDEV}
INT_EXCEL_SHEET_FUNC_AVERAGE, {fekAVERAGE}
INT_EXCEL_SHEET_FUNC_BETADIST, {fekBETADIST}
INT_EXCEL_SHEET_FUNC_BETAINV, {fekBETAINV}
INT_EXCEL_SHEET_FUNC_BINOMDIST, {fekBINOMDIST}
INT_EXCEL_SHEET_FUNC_CHIDIST, {fekCHIDIST}
INT_EXCEL_SHEET_FUNC_CHIINV, {fekCHIINV}
INT_EXCEL_SHEET_FUNC_COUNT, {fekCOUNT}
INT_EXCEL_SHEET_FUNC_COUNTA, {fekCOUNTA}
INT_EXCEL_SHEET_FUNC_COUNTBLANK,{fekCOUNTBLANK}
INT_EXCEL_SHEET_FUNC_COUNTIF, {fekCOUNTIF}
INT_EXCEL_SHEET_FUNC_MAX, {fekMAX}
INT_EXCEL_SHEET_FUNC_MEDIAN, {fekMEDIAN}
INT_EXCEL_SHEET_FUNC_MIN, {fekMIN}
INT_EXCEL_SHEET_FUNC_PERMUT, {fekPERMUT}
INT_EXCEL_SHEET_FUNC_POISSON, {fekPOISSON}
INT_EXCEL_SHEET_FUNC_PRODUCT, {fekPRODUCT}
INT_EXCEL_SHEET_FUNC_STDEV, {fekSTDEV}
INT_EXCEL_SHEET_FUNC_STDEVP, {fekSTDEVP}
INT_EXCEL_SHEET_FUNC_SUM, {fekSUM}
INT_EXCEL_SHEET_FUNC_SUMIF, {fekSUMIF}
INT_EXCEL_SHEET_FUNC_SUMSQ, {fekSUMSQ}
INT_EXCEL_SHEET_FUNC_VAR, {fekVAR}
INT_EXCEL_SHEET_FUNC_VARP, {fekVARP}
// Financial functions
INT_EXCEL_SHEET_FUNC_FV, {fekFV}
INT_EXCEL_SHEET_FUNC_NPER, {fekNPER}
INT_EXCEL_SHEET_FUNC_PMT, {fekPMT}
INT_EXCEL_SHEET_FUNC_PV, {fekPV}
INT_EXCEL_SHEET_FUNC_RATE, {fekRATE}
// Logical functions
INT_EXCEL_SHEET_FUNC_AND, {fekAND}
INT_EXCEL_SHEET_FUNC_FALSE, {fekFALSE}
INT_EXCEL_SHEET_FUNC_IF, {fekIF}
INT_EXCEL_SHEET_FUNC_NOT, {fekNOT}
INT_EXCEL_SHEET_FUNC_OR, {fekOR}
INT_EXCEL_SHEET_FUNC_TRUE, {fekTRUE}
// String functions
INT_EXCEL_SHEET_FUNC_CHAR, {fekCHAR}
INT_EXCEL_SHEET_FUNC_CODE, {fekCODE}
INT_EXCEL_SHEET_FUNC_LEFT, {fekLEFT}
INT_EXCEL_SHEET_FUNC_LOWER, {fekLOWER}
INT_EXCEL_SHEET_FUNC_MID, {fekMID}
INT_EXCEL_SHEET_FUNC_PROPER, {fekPROPER}
INT_EXCEL_SHEET_FUNC_REPLACE, {fekREPLACE}
INT_EXCEL_SHEET_FUNC_RIGHT, {fekRIGHT}
INT_EXCEL_SHEET_FUNC_SUBSTITUTE,{fekSUBSTITUTE}
INT_EXCEL_SHEET_FUNC_TRIM, {fekTRIM}
INT_EXCEL_SHEET_FUNC_UPPER, {fekUPPER}
// lookup/reference functions
INT_EXCEL_SHEET_FUNC_COLUMN, {fekCOLUMN}
INT_EXCEL_SHEET_FUNC_COLUMNS, {fekCOLUMNS}
INT_EXCEL_SHEET_FUNC_ROW, {fekROW}
INT_EXCEL_SHEET_FUNC_ROWS, {fekROWS}
// Info functions
INT_EXCEL_SHEET_FUNC_CELL, {fekCELLINFO}
INT_EXCEL_SHEET_FUNC_INFO, {fekINFO}
INT_EXCEL_SHEET_FUNC_ISBLANK, {fekIsBLANK}
INT_EXCEL_SHEET_FUNC_ISERR, {fekIsERR}
INT_EXCEL_SHEET_FUNC_ISERROR, {fekIsERROR}
INT_EXCEL_SHEET_FUNC_ISLOGICAL, {fekIsLOGICAL}
INT_EXCEL_SHEET_FUNC_ISNA, {fekIsNA}
INT_EXCEL_SHEET_FUNC_ISNONTEXT, {fekIsNONTEXT}
INT_EXCEL_SHEET_FUNC_ISNUMBER, {fekIsNUMBER}
INT_EXCEL_SHEET_FUNC_ISREF, {fekIsREF}
INT_EXCEL_SHEET_FUNC_ISTEXT, {fekIsTEXT}
INT_EXCEL_SHEET_FUNC_VALUE, {fekValue}
// Other operations
INT_EXCEL_TOKEN_TATTR {fekOpSum}
);
*)
type
TBIFF58BlankRecord = packed record
RecordID: Word;
@ -572,8 +451,8 @@ type
Value: Double;
end;
function ConvertExcelDateTimeToDateTime(
const AExcelDateNum: Double; ADateMode: TDateMode): TDateTime;
function ConvertExcelDateTimeToDateTime(const AExcelDateNum: Double;
ADateMode: TDateMode): TDateTime;
begin
// Time only:
if (AExcelDateNum<1) and (AExcelDateNum>=0) then