c87afdcdec
- Allow processing of string formulas (conversion to/from rpn formulas, calculation). - Drop cell ContentType cctRPNFormula. - Drop field RPNFormulaValue of TCell record. - Remove all fekXXXX declarations for sheet functions. Function is specified by name now. - Complete registration mechanism for user-defined formulas. Adapt all demos Test cases working This commit does not yet support: shared formulas, formulas in ods. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3506 8e941d3f-bd1b-0410-a28a-d453659cc2b4
5508 lines
159 KiB
ObjectPascal
5508 lines
159 KiB
ObjectPascal
{
|
|
This file is part of the Free Component Library (FCL)
|
|
Copyright (c) 2008 Michael Van Canneyt.
|
|
|
|
Expression parser, supports variables, functions and
|
|
float/integer/string/boolean/datetime operations.
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
Modified for integration into fpspreadsheet by Werner Pamler:
|
|
- Original file name: fpexprpars.pp
|
|
- Rename identifiers to avoid naming conflicts with the original
|
|
- TsExpressionParser and TsBuiltinExpressionManager are not components
|
|
any more
|
|
- TsExpressionParser is created with the worksheet as a parameter.
|
|
- add new TExprNode classes:
|
|
- TsCellExprNode for references to cells
|
|
- TsCellRangeExprNode for references to cell ranges
|
|
- TsPercentExprNode and token "%" to handle Excel's percent operation
|
|
- TsParenthesisExprNode to handle the parenthesis token in RPN formulas
|
|
- TsConcatExprNode and token "&" to handle string concatenation
|
|
- TsUPlusExprNode for unary plus symbol
|
|
- remove and modifiy built-in function such that the parser is compatible
|
|
with Excel syntax (and Open/LibreOffice - which is the same).
|
|
- use double quotes for strings (instead of single quotes)
|
|
- add boolean constants "TRUE" and "FALSE".
|
|
- add property RPNFormula to interface the parser to RPN formulas of xls files.
|
|
- accept funtions with zero parameters
|
|
|
|
******************************************************************************}
|
|
|
|
// To do:
|
|
// Remove exceptions, use error message strings instead
|
|
// Cell reference not working (--> formula CELL!)
|
|
// Missing arguments
|
|
// Keep spaces in formula
|
|
|
|
{$mode objfpc}
|
|
{$h+}
|
|
unit fpsExprParser;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, contnrs, fpspreadsheet;
|
|
|
|
type
|
|
{ Tokens }
|
|
|
|
(* { Basic operands }
|
|
fekCell, fekCellRef, fekCellRange, fekCellOffset, fekNum, fekInteger,
|
|
fekString, fekBool, fekErr, fekMissingArg,
|
|
{ Basic operations }
|
|
fekAdd, fekSub, fekMul, fekDiv, fekPercent, fekPower, fekUMinus, fekUPlus,
|
|
fekConcat, // string concatenation
|
|
fekEqual, fekGreater, fekGreaterEqual, fekLess, fekLessEqual, fekNotEqual,
|
|
fekParen,
|
|
*)
|
|
TsTokenType = (
|
|
ttCell, ttCellRange, ttNumber, ttString, ttIdentifier,
|
|
ttPlus, ttMinus, ttMul, ttDiv, ttConcat, ttPercent, ttPower, ttLeft, ttRight,
|
|
ttLessThan, ttLargerThan, ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual,
|
|
ttComma, ttTrue, ttFalse, ttEOF
|
|
);
|
|
|
|
TsExprFloat = Double;
|
|
TsExprFloatArray = array of TsExprFloat;
|
|
|
|
const
|
|
ttDelimiters = [
|
|
ttPlus, ttMinus, ttMul, ttDiv, ttLeft, ttRight, ttLessThan, ttLargerThan,
|
|
ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual
|
|
];
|
|
|
|
ttComparisons = [
|
|
ttLargerThan, ttLessThan, ttLargerThanEqual, ttLessThanEqual, ttEqual, ttNotEqual
|
|
];
|
|
|
|
type
|
|
TsExpressionParser = class;
|
|
TsBuiltInExpressionManager = class;
|
|
|
|
TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
|
|
rtCell, rtCellRange, rtError, rtAny);
|
|
TsResultTypes = set of TsResultType;
|
|
|
|
TsExpressionResult = record
|
|
Worksheet : TsWorksheet;
|
|
ResString : String;
|
|
case ResultType : TsResultType of
|
|
rtEmpty : ();
|
|
rtError : (ResError : TsErrorValue);
|
|
rtBoolean : (ResBoolean : Boolean);
|
|
rtInteger : (ResInteger : Int64);
|
|
rtFloat : (ResFloat : TsExprFloat);
|
|
rtDateTime : (ResDateTime : TDatetime);
|
|
rtCell : (ResRow, ResCol : Cardinal);
|
|
rtCellRange : (ResCellRange : TsCellRange);
|
|
rtString : ();
|
|
end;
|
|
PsExpressionResult = ^TsExpressionResult;
|
|
TsExprParameterArray = array of TsExpressionResult;
|
|
|
|
{ TsExprNode }
|
|
TsExprNode = class(TObject)
|
|
protected
|
|
procedure CheckNodeType(ANode: TsExprNode; Allowed: TsResultTypes);
|
|
// A procedure with var saves an implicit try/finally in each node
|
|
// A marked difference in execution speed.
|
|
procedure GetNodeValue(var Result: TsExpressionResult); virtual; abstract;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; virtual; abstract;
|
|
function AsString: string; virtual; abstract;
|
|
procedure Check; virtual; abstract;
|
|
function NodeType: TsResultType; virtual; abstract;
|
|
function NodeValue: TsExpressionResult;
|
|
end;
|
|
|
|
TsExprArgumentArray = array of TsExprNode;
|
|
|
|
{ TsBinaryOperationExprNode }
|
|
TsBinaryOperationExprNode = class(TsExprNode)
|
|
private
|
|
FLeft: TsExprNode;
|
|
FRight: TsExprNode;
|
|
protected
|
|
procedure CheckSameNodeTypes; virtual;
|
|
public
|
|
constructor Create(ALeft, ARight: TsExprNode);
|
|
destructor Destroy; override;
|
|
procedure Check; override;
|
|
property Left: TsExprNode read FLeft;
|
|
property Right: TsExprNode read FRight;
|
|
end;
|
|
TsBinaryOperationExprNodeClass = class of TsBinaryOperationExprNode;
|
|
|
|
{ TsBooleanOperationExprNode }
|
|
TsBooleanOperationExprNode = class(TsBinaryOperationExprNode)
|
|
public
|
|
procedure Check; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsBooleanResultExprNode }
|
|
TsBooleanResultExprNode = class(TsBinaryOperationExprNode)
|
|
protected
|
|
procedure CheckSameNodeTypes; override;
|
|
public
|
|
procedure Check; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
TsBooleanResultExprNodeClass = class of TsBooleanResultExprNode;
|
|
|
|
{ TsEqualExprNode }
|
|
TsEqualExprNode = class(TsBooleanResultExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string; override;
|
|
end;
|
|
|
|
{ TsNotEqualExprNode }
|
|
TsNotEqualExprNode = class(TsEqualExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string; override;
|
|
end;
|
|
|
|
{ TsOrderingExprNode }
|
|
TsOrderingExprNode = class(TsBooleanResultExprNode)
|
|
protected
|
|
procedure CheckSameNodeTypes; override;
|
|
public
|
|
procedure Check; override;
|
|
end;
|
|
|
|
{ TsLessExprNode }
|
|
TsLessExprNode = class(TsOrderingExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string; override;
|
|
end;
|
|
|
|
{ TsGreaterExprNode }
|
|
TsGreaterExprNode = class(TsOrderingExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string; override;
|
|
end;
|
|
|
|
{ TsLessEqualExprNode }
|
|
TsLessEqualExprNode = class(TsGreaterExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string; override;
|
|
end;
|
|
|
|
{ TsGreaterEqualExprNode }
|
|
TsGreaterEqualExprNode = class(TsLessExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string; override;
|
|
end;
|
|
|
|
{ TsConcatExprNode }
|
|
TsConcatExprNode = class(TsBinaryOperationExprNode)
|
|
protected
|
|
procedure CheckSameNodeTypes; override;
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string ; override;
|
|
procedure Check; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsMathOperationExprNode }
|
|
TsMathOperationExprNode = class(TsBinaryOperationExprNode)
|
|
protected
|
|
procedure CheckSameNodeTypes; override;
|
|
public
|
|
procedure Check; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsAddExprNode }
|
|
TsAddExprNode = class(TsMathOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string ; override;
|
|
end;
|
|
|
|
{ TsSubtractExprNode }
|
|
TsSubtractExprNode = class(TsMathOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string ; override;
|
|
end;
|
|
|
|
{ TsMultiplyExprNode }
|
|
TsMultiplyExprNode = class(TsMathOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string ; override;
|
|
end;
|
|
|
|
{ TsDivideExprNode }
|
|
TsDivideExprNode = class(TsMathOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string ; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsPowerExprNode }
|
|
TsPowerExprNode = class(TsMathOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string ; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsUnaryOperationExprNode }
|
|
TsUnaryOperationExprNode = class(TsExprNode)
|
|
private
|
|
FOperand: TsExprNode;
|
|
protected
|
|
procedure Check; override;
|
|
public
|
|
constructor Create(AOperand: TsExprNode);
|
|
destructor Destroy; override;
|
|
property Operand: TsExprNode read FOperand;
|
|
end;
|
|
|
|
{ TsConvertExprNode }
|
|
TsConvertExprNode = class(TsUnaryOperationExprNode)
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
end;
|
|
|
|
{ TsNotExprNode }
|
|
TsNotExprNode = class(TsUnaryOperationExprNode)
|
|
protected
|
|
procedure Check; override;
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsConvertToIntExprNode }
|
|
TsConvertToIntExprNode = class(TsConvertExprNode)
|
|
public
|
|
procedure Check; override;
|
|
end;
|
|
|
|
{ TsIntToFloatExprNode }
|
|
TsIntToFloatExprNode = class(TsConvertToIntExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsIntToDateTimeExprNode }
|
|
TsIntToDateTimeExprNode = class(TsConvertToIntExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsFloatToDateTimeExprNode }
|
|
TsFloatToDateTimeExprNode = class(TsConvertExprNode)
|
|
protected
|
|
procedure Check; override;
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsUPlusExprNode }
|
|
TsUPlusExprNode = class(TsUnaryOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
procedure Check; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsUMinusExprNode }
|
|
TsUMinusExprNode = class(TsUnaryOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
procedure Check; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsPercentExprNode }
|
|
TsPercentExprNode = class(TsUnaryOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
procedure Check; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsParenthesisExprNode }
|
|
TsParenthesisExprNode = class(TsUnaryOperationExprNode)
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
function NodeType: TsResultType; override;
|
|
end;
|
|
|
|
{ TsConstExprNode }
|
|
TsConstExprNode = class(TsExprNode)
|
|
private
|
|
FValue: TsExpressionResult;
|
|
protected
|
|
procedure Check; override;
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
constructor CreateString(AValue: String);
|
|
constructor CreateInteger(AValue: Int64);
|
|
constructor CreateDateTime(AValue: TDateTime);
|
|
constructor CreateFloat(AValue: TsExprFloat);
|
|
constructor CreateBoolean(AValue: Boolean);
|
|
constructor CreateError(AValue: TsErrorValue);
|
|
function AsString: string; override;
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function NodeType : TsResultType; override;
|
|
// For inspection
|
|
property ConstValue: TsExpressionResult read FValue;
|
|
end;
|
|
|
|
TsExprIdentifierType = (itVariable, itFunctionCallBack, itFunctionHandler);
|
|
|
|
TsExprFunctionCallBack = procedure (var Result: TsExpressionResult;
|
|
const Args: TsExprParameterArray);
|
|
|
|
TsExprFunctionEvent = procedure (var Result: TsExpressionResult;
|
|
const Args: TsExprParameterArray) of object;
|
|
|
|
{ TsExprIdentifierDef }
|
|
TsExprIdentifierDef = class(TCollectionItem)
|
|
private
|
|
FStringValue: String;
|
|
FValue: TsExpressionResult;
|
|
FArgumentTypes: String;
|
|
FIDType: TsExprIdentifierType;
|
|
FName: ShortString;
|
|
FExcelCode: Integer;
|
|
FVariableArgumentCount: Boolean;
|
|
FOnGetValue: TsExprFunctionEvent;
|
|
FOnGetValueCB: TsExprFunctionCallBack;
|
|
function GetAsBoolean: Boolean;
|
|
function GetAsDateTime: TDateTime;
|
|
function GetAsFloat: TsExprFloat;
|
|
function GetAsInteger: Int64;
|
|
function GetAsString: String;
|
|
function GetResultType: TsResultType;
|
|
function GetValue: String;
|
|
procedure SetArgumentTypes(const AValue: String);
|
|
procedure SetAsBoolean(const AValue: Boolean);
|
|
procedure SetAsDateTime(const AValue: TDateTime);
|
|
procedure SetAsFloat(const AValue: TsExprFloat);
|
|
procedure SetAsInteger(const AValue: Int64);
|
|
procedure SetAsString(const AValue: String);
|
|
procedure SetName(const AValue: ShortString);
|
|
procedure SetResultType(const AValue: TsResultType);
|
|
procedure SetValue(const AValue: String);
|
|
protected
|
|
procedure CheckResultType(const AType: TsResultType);
|
|
procedure CheckVariable;
|
|
public
|
|
function ArgumentCount: Integer;
|
|
procedure Assign(Source: TPersistent); override;
|
|
property AsFloat: TsExprFloat Read GetAsFloat Write SetAsFloat;
|
|
property AsInteger: Int64 Read GetAsInteger Write SetAsInteger;
|
|
property AsString: String Read GetAsString Write SetAsString;
|
|
property AsBoolean: Boolean Read GetAsBoolean Write SetAsBoolean;
|
|
property AsDateTime: TDateTime Read GetAsDateTime Write SetAsDateTime;
|
|
function HasFixedArgumentCount: Boolean;
|
|
function IsOptionalArgument(AIndex: Integer): Boolean;
|
|
property OnGetFunctionValueCallBack: TsExprFunctionCallBack read FOnGetValueCB write FOnGetValueCB;
|
|
published
|
|
property IdentifierType: TsExprIdentifierType read FIDType write FIDType;
|
|
property Name: ShortString read FName write SetName;
|
|
property Value: String read GetValue write SetValue;
|
|
property ParameterTypes: String read FArgumentTypes write SetArgumentTypes;
|
|
property ResultType: TsResultType read GetResultType write SetResultType;
|
|
property ExcelCode: Integer read FExcelCode write FExcelCode;
|
|
property VariableArgumentCount: Boolean read FVariableArgumentCount write FVariableArgumentCount;
|
|
property OnGetFunctionValue: TsExprFunctionEvent read FOnGetValue write FOnGetValue;
|
|
end;
|
|
|
|
TsBuiltInExprCategory = (bcMath, bcStatistics, bcStrings, bcLogical, bcDateTime,
|
|
bcLookup, bcInfo, bcUser);
|
|
|
|
TsBuiltInExprCategories = set of TsBuiltInExprCategory;
|
|
|
|
{ TsBuiltInExprIdentifierDef }
|
|
TsBuiltInExprIdentifierDef = class(TsExprIdentifierDef)
|
|
private
|
|
FCategory: TsBuiltInExprCategory;
|
|
public
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property Category: TsBuiltInExprCategory read FCategory write FCategory;
|
|
end;
|
|
|
|
{ TsExprIdentifierDefs }
|
|
TsExprIdentifierDefs = class(TCollection)
|
|
private
|
|
FParser: TsExpressionParser;
|
|
function GetI(AIndex: Integer): TsExprIdentifierDef;
|
|
procedure SetI(AIndex: Integer; const AValue: TsExprIdentifierDef);
|
|
protected
|
|
procedure Update(Item: TCollectionItem); override;
|
|
property Parser: TsExpressionParser read FParser;
|
|
public
|
|
function FindIdentifier(const AName: ShortString): TsExprIdentifierDef;
|
|
function IdentifierByExcelCode(const AExcelCode: Integer): TsExprIdentifierDef;
|
|
function IdentifierByName(const AName: ShortString): TsExprIdentifierDef;
|
|
function IndexOfIdentifier(const AName: ShortString): Integer; overload;
|
|
function IndexOfIdentifier(const AExcelCode: Integer): Integer; overload;
|
|
function AddVariable(const AName: ShortString; AResultType: TsResultType;
|
|
AValue: String): TsExprIdentifierDef;
|
|
function AddBooleanVariable(const AName: ShortString;
|
|
AValue: Boolean): TsExprIdentifierDef;
|
|
function AddIntegerVariable(const AName: ShortString;
|
|
AValue: Integer): TsExprIdentifierDef;
|
|
function AddFloatVariable(const AName: ShortString;
|
|
AValue: TsExprFloat): TsExprIdentifierDef;
|
|
function AddStringVariable(const AName: ShortString;
|
|
AValue: String): TsExprIdentifierDef;
|
|
function AddDateTimeVariable(const AName: ShortString;
|
|
AValue: TDateTime): TsExprIdentifierDef;
|
|
function AddFunction(const AName: ShortString; const AResultType: Char;
|
|
const AParamTypes: String; const AExcelCode: Integer;
|
|
ACallBack: TsExprFunctionCallBack): TsExprIdentifierDef;
|
|
function AddFunction(const AName: ShortString; const AResultType: Char;
|
|
const AParamTypes: String; const AExcelCode: Integer;
|
|
ACallBack: TsExprFunctionEvent): TsExprIdentifierDef;
|
|
property Identifiers[AIndex: Integer]: TsExprIdentifierDef read GetI write SetI; default;
|
|
end;
|
|
|
|
{ TsIdentifierExprNode }
|
|
TsIdentifierExprNode = class(TsExprNode)
|
|
private
|
|
FID: TsExprIdentifierDef;
|
|
PResult: PsExpressionResult;
|
|
FResultType: TsResultType;
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
constructor CreateIdentifier(AID: TsExprIdentifierDef);
|
|
function NodeType: TsResultType; override;
|
|
property Identifier: TsExprIdentifierDef read FID;
|
|
end;
|
|
|
|
{ TsVariableExprNode }
|
|
TsVariableExprNode = class(TsIdentifierExprNode)
|
|
procedure Check; override;
|
|
function AsString: string; override;
|
|
Function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
end;
|
|
|
|
{ TsFunctionExprNode }
|
|
TsFunctionExprNode = class(TsIdentifierExprNode)
|
|
private
|
|
FArgumentNodes: TsExprArgumentArray;
|
|
FargumentParams: TsExprParameterArray;
|
|
protected
|
|
procedure CalcParams;
|
|
public
|
|
constructor CreateFunction(AID: TsExprIdentifierDef;
|
|
const Args: TsExprArgumentArray); virtual;
|
|
destructor Destroy; override;
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
procedure Check; override;
|
|
property ArgumentNodes: TsExprArgumentArray read FArgumentNodes;
|
|
property ArgumentParams: TsExprParameterArray read FArgumentParams;
|
|
end;
|
|
|
|
{ TsFunctionCallBackExprNode }
|
|
TsFunctionCallBackExprNode = class(TsFunctionExprNode)
|
|
private
|
|
FCallBack: TsExprFunctionCallBack;
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
constructor CreateFunction(AID: TsExprIdentifierDef;
|
|
const Args: TsExprArgumentArray); override;
|
|
property CallBack: TsExprFunctionCallBack read FCallBack;
|
|
end;
|
|
|
|
{ TFPFunctionEventHandlerExprNode }
|
|
TFPFunctionEventHandlerExprNode = class(TsFunctionExprNode)
|
|
private
|
|
FCallBack: TsExprFunctionEvent;
|
|
protected
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
constructor CreateFunction(AID: TsExprIdentifierDef;
|
|
const Args: TsExprArgumentArray); override;
|
|
property CallBack: TsExprFunctionEvent read FCallBack;
|
|
end;
|
|
|
|
{ TsCellExprNode }
|
|
TsCellExprNode = class(TsExprNode)
|
|
private
|
|
FWorksheet: TsWorksheet;
|
|
FRow, FCol: Cardinal;
|
|
FFlags: TsRelFlags;
|
|
FCell: PCell;
|
|
FIsRef: Boolean;
|
|
protected
|
|
procedure Check; override;
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
constructor Create(AWorksheet: TsWorksheet; ACellString: String); overload;
|
|
constructor Create(AWorksheet: TsWorksheet; ARow, ACol: Cardinal;
|
|
AFlags: TsRelFlags); overload;
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: string; override;
|
|
function NodeType: TsResultType; override;
|
|
property Worksheet: TsWorksheet read FWorksheet;
|
|
end;
|
|
|
|
{ TsCellRangeExprNode }
|
|
TsCellRangeExprNode = class(TsExprNode)
|
|
private
|
|
FWorksheet: TsWorksheet;
|
|
FRow1, FRow2: Cardinal;
|
|
FCol1, FCol2: Cardinal;
|
|
FFlags: TsRelFlags;
|
|
protected
|
|
procedure Check; override;
|
|
procedure GetNodeValue(var Result: TsExpressionResult); override;
|
|
public
|
|
constructor Create(AWorksheet: TsWorksheet; ACellRangeString: String); overload;
|
|
constructor Create(AWorksheet: TsWorksheet; ARow1,ACol1, ARow2,ACol2: Cardinal;
|
|
AFlags: TsRelFlags); overload;
|
|
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
|
|
function AsString: String; override;
|
|
function NodeType: TsResultType; override;
|
|
property Worksheet: TsWorksheet read FWorksheet;
|
|
end;
|
|
|
|
{ TsExpressionScanner }
|
|
TsExpressionScanner = class(TObject)
|
|
FSource : String;
|
|
LSource,
|
|
FPos: Integer;
|
|
FChar: PChar;
|
|
FToken: String;
|
|
FTokenType: TsTokenType;
|
|
private
|
|
function GetCurrentChar: Char;
|
|
procedure ScanError(Msg: String);
|
|
protected
|
|
procedure SetSource(const AValue: String); virtual;
|
|
function DoIdentifier: TsTokenType;
|
|
function DoNumber: TsTokenType;
|
|
function DoDelimiter: TsTokenType;
|
|
function DoString: TsTokenType;
|
|
function NextPos: Char; // inline;
|
|
procedure SkipWhiteSpace; // inline;
|
|
function IsWordDelim(C: Char): Boolean; // inline;
|
|
function IsDelim(C: Char): Boolean; // inline;
|
|
function IsDigit(C: Char): Boolean; // inline;
|
|
function IsAlpha(C: Char): Boolean; // inline;
|
|
public
|
|
constructor Create;
|
|
function GetToken: TsTokenType;
|
|
property Token: String read FToken;
|
|
property TokenType: TsTokenType read FTokenType;
|
|
property Source: String read FSource write SetSource;
|
|
property Pos: Integer read FPos;
|
|
property CurrentChar: Char read GetCurrentChar;
|
|
end;
|
|
|
|
EExprScanner = class(Exception);
|
|
|
|
{ TsExpressionParser }
|
|
TsExpressionParser = class
|
|
private
|
|
FBuiltIns: TsBuiltInExprCategories;
|
|
FExpression: String;
|
|
FScanner: TsExpressionScanner;
|
|
FExprNode: TsExprNode;
|
|
FIdentifiers: TsExprIdentifierDefs;
|
|
FHashList: TFPHashObjectlist;
|
|
FDirty: Boolean;
|
|
FWorksheet: TsWorksheet;
|
|
procedure CheckEOF;
|
|
procedure CheckNodes(var ALeft, ARight: TsExprNode);
|
|
function ConvertNode(Todo: TsExprNode; ToType: TsResultType): TsExprNode;
|
|
function GetAsBoolean: Boolean;
|
|
function GetAsDateTime: TDateTime;
|
|
function GetAsFloat: TsExprFloat;
|
|
function GetAsInteger: Int64;
|
|
function GetAsString: String;
|
|
function GetRPNFormula: TsRPNFormula;
|
|
function MatchNodes(Todo, Match: TsExprNode): TsExprNode;
|
|
procedure SetBuiltIns(const AValue: TsBuiltInExprCategories);
|
|
procedure SetIdentifiers(const AValue: TsExprIdentifierDefs);
|
|
procedure SetRPNFormula(const AFormula: TsRPNFormula);
|
|
|
|
protected
|
|
class function BuiltinExpressionManager: TsBuiltInExpressionManager;
|
|
procedure ParserError(Msg: String);
|
|
procedure SetExpression(const AValue: String); virtual;
|
|
procedure CheckResultType(const Res: TsExpressionResult;
|
|
AType: TsResultType); inline;
|
|
function CurrentToken: String;
|
|
function GetToken: TsTokenType;
|
|
function Level1: TsExprNode;
|
|
function Level2: TsExprNode;
|
|
function Level3: TsExprNode;
|
|
function Level4: TsExprNode;
|
|
function Level5: TsExprNode;
|
|
function Level6: TsExprNode;
|
|
function Primitive: TsExprNode;
|
|
function TokenType: TsTokenType;
|
|
procedure CreateHashList;
|
|
property Scanner: TsExpressionScanner read FScanner;
|
|
property ExprNode: TsExprNode read FExprNode;
|
|
property Dirty: Boolean read FDirty;
|
|
|
|
public
|
|
constructor Create(AWorksheet: TsWorksheet); virtual;
|
|
destructor Destroy; override;
|
|
function IdentifierByName(AName: ShortString): TsExprIdentifierDef; virtual;
|
|
procedure Clear;
|
|
function BuildStringFormula: String;
|
|
function Evaluate: TsExpressionResult;
|
|
procedure EvaluateExpression(var Result: TsExpressionResult);
|
|
function ResultType: TsResultType;
|
|
property AsFloat: TsExprFloat read GetAsFloat;
|
|
property AsInteger: Int64 read GetAsInteger;
|
|
property AsString: String read GetAsString;
|
|
property AsBoolean: Boolean read GetAsBoolean;
|
|
property AsDateTime: TDateTime read GetAsDateTime;
|
|
// The expression to parse
|
|
property Expression: String read FExpression write SetExpression;
|
|
property RPNFormula: TsRPNFormula read GetRPNFormula write SetRPNFormula;
|
|
property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers;
|
|
property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns;
|
|
property Worksheet: TsWorksheet read FWorksheet;
|
|
end;
|
|
|
|
TsSpreadsheetParser = class(TsExpressionParser)
|
|
public
|
|
constructor Create(AWorksheet: TsWorksheet); override;
|
|
end;
|
|
|
|
|
|
{ TsBuiltInExpressionManager }
|
|
TsBuiltInExpressionManager = class(TComponent)
|
|
private
|
|
FDefs: TsExprIdentifierDefs;
|
|
function GetCount: Integer;
|
|
function GetI(AIndex: Integer): TsBuiltInExprIdentifierDef;
|
|
protected
|
|
property Defs: TsExprIdentifierDefs read FDefs;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function IndexOfIdentifier(const AName: ShortString): Integer;
|
|
function FindIdentifier(const AName: ShortString): TsBuiltInExprIdentifierDef;
|
|
function IdentifierByExcelCode(const AExcelCode: Integer): TsBuiltInExprIdentifierDef;
|
|
function IdentifierByName(const AName: ShortString): TsBuiltInExprIdentifierDef;
|
|
function AddVariable(const ACategory: TsBuiltInExprCategory; const AName: ShortString;
|
|
AResultType: TsResultType; AValue: String): TsBuiltInExprIdentifierDef;
|
|
function AddBooleanVariable(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; AValue: Boolean): TsBuiltInExprIdentifierDef;
|
|
function AddIntegerVariable(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; AValue: Integer): TsBuiltInExprIdentifierDef;
|
|
function AddFloatVariable(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; AValue: TsExprFloat): TsBuiltInExprIdentifierDef;
|
|
function AddStringVariable(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; AValue: String): TsBuiltInExprIdentifierDef;
|
|
function AddDateTimeVariable(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; AValue: TDateTime): TsBuiltInExprIdentifierDef;
|
|
function AddFunction(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; const AResultType: Char; const AParamTypes: String;
|
|
const AExcelCode: Integer; ACallBack: TsExprFunctionCallBack): TsBuiltInExprIdentifierDef;
|
|
function AddFunction(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; const AResultType: Char; const AParamTypes: String;
|
|
const AExcelCode: Integer; ACallBack: TsExprFunctionEvent): TsBuiltInExprIdentifierDef;
|
|
property IdentifierCount: Integer read GetCount;
|
|
property Identifiers[AIndex: Integer]: TsBuiltInExprIdentifierDef read GetI;
|
|
end;
|
|
|
|
EExprParser = class(Exception);
|
|
|
|
function TokenName(AToken: TsTokenType): String;
|
|
function ResultTypeName(AResult: TsResultType): String;
|
|
function CharToResultType(C: Char): TsResultType;
|
|
function BuiltinIdentifiers: TsBuiltInExpressionManager;
|
|
procedure RegisterStdBuiltins(AManager: TsBuiltInExpressionManager);
|
|
function ArgToBoolean(Arg: TsExpressionResult): Boolean;
|
|
function ArgToCell(Arg: TsExpressionResult): PCell;
|
|
function ArgToDateTime(Arg: TsExpressionResult): TDateTime;
|
|
function ArgToInt(Arg: TsExpressionResult): Integer;
|
|
function ArgToFloat(Arg: TsExpressionResult): TsExprFloat;
|
|
function ArgToString(Arg: TsExpressionResult): String;
|
|
procedure ArgsToFloatArray(const Args: TsExprParameterArray; out AData: TsExprFloatArray);
|
|
function BooleanResult(AValue: Boolean): TsExpressionResult;
|
|
function DateTimeResult(AValue: TDateTime): TsExpressionResult;
|
|
function EmptyResult: TsExpressionResult;
|
|
function ErrorResult(const AValue: TsErrorValue): TsExpressionResult;
|
|
function FloatResult(const AValue: TsExprFloat): TsExpressionResult;
|
|
function IntegerResult(const AValue: Integer): TsExpressionResult;
|
|
function StringResult(const AValue: String): TsExpressionResult;
|
|
|
|
procedure RegisterFunction(const AName: ShortString; const AResultType: Char;
|
|
const AParamTypes: String; const AExcelCode: Integer; ACallBack: TsExprFunctionCallBack);
|
|
|
|
const
|
|
AllBuiltIns = [bcMath, bcStatistics, bcStrings, bcLogical, bcDateTime, bcLookup,
|
|
bcInfo, bcUser];
|
|
|
|
var
|
|
ExprFormatSettings: TFormatSettings;
|
|
|
|
implementation
|
|
|
|
uses
|
|
typinfo, math, lazutf8, dateutils, xlsconst, fpsutils;
|
|
|
|
const
|
|
cNull = #0;
|
|
cDoubleQuote = '"';
|
|
|
|
Digits = ['0'..'9', '.'];
|
|
WhiteSpace = [' ', #13, #10, #9];
|
|
Operators = ['+', '-', '<', '>', '=', '/', '*', '&', '%', '^'];
|
|
Delimiters = Operators + [',', '(', ')'];
|
|
Symbols = Delimiters;
|
|
WordDelimiters = WhiteSpace + Symbols;
|
|
|
|
resourcestring
|
|
SBadQuotes = 'Unterminated string';
|
|
SUnknownDelimiter = 'Unknown delimiter character: "%s"';
|
|
SErrUnknownCharacter = 'Unknown character at pos %d: "%s"';
|
|
SErrUnexpectedEndOfExpression = 'Unexpected end of expression';
|
|
SErrUnknownComparison = 'Internal error: Unknown comparison';
|
|
SErrUnknownBooleanOp = 'Internal error: Unknown boolean operation';
|
|
SErrBracketExpected = 'Expected ) bracket at position %d, but got %s';
|
|
SerrUnknownTokenAtPos = 'Unknown token at pos %d : %s';
|
|
SErrLeftBracketExpected = 'Expected ( bracket at position %d, but got %s';
|
|
SErrInvalidFloat = '%s is not a valid floating-point value';
|
|
SErrUnknownIdentifier = 'Unknown identifier: %s';
|
|
SErrInExpression = 'Cannot evaluate: error in expression';
|
|
SErrInExpressionEmpty = 'Cannot evaluate: empty expression';
|
|
SErrCommaExpected = 'Expected comma (,) at position %d, but got %s';
|
|
SErrInvalidNumberChar = 'Unexpected character in number : %s';
|
|
SErrInvalidNumber = 'Invalid numerical value : %s';
|
|
SErrNoOperand = 'No operand for unary operation %s';
|
|
SErrNoLeftOperand = 'No left operand for binary operation %s';
|
|
SErrNoRightOperand = 'No left operand for binary operation %s';
|
|
SErrNoNegation = 'Cannot negate expression of type %s: %s';
|
|
SErrNoUPlus = 'Cannot perform unary plus operation on type %s: %s';
|
|
SErrNoNOTOperation = 'Cannot perform NOT operation on expression of type %s: %s';
|
|
SErrNoPercentOperation = 'Cannot perform percent operation on expression of type %s: %s';
|
|
SErrTypesDoNotMatch = 'Type mismatch: %s<>%s for expressions "%s" and "%s".';
|
|
SErrTypesIncompatible = 'Incompatible types: %s<>%s for expressions "%s" and "%s".';
|
|
SErrNoNodeToCheck = 'Internal error: No node to check !';
|
|
SInvalidNodeType = 'Node type (%s) not in allowed types (%s) for expression: %s';
|
|
SErrUnterminatedExpression = 'Badly terminated expression. Found token at position %d : %s';
|
|
SErrDuplicateIdentifier = 'An identifier with name "%s" already exists.';
|
|
SErrInvalidResultCharacter = '"%s" is not a valid return type indicator';
|
|
ErrInvalidArgumentCount = 'Invalid argument count for function %s';
|
|
SErrInvalidArgumentType = 'Invalid type for argument %d: Expected %s, got %s';
|
|
SErrInvalidResultType = 'Invalid result type: %s';
|
|
SErrNotVariable = 'Identifier %s is not a variable';
|
|
SErrInactive = 'Operation not allowed while an expression is active';
|
|
SErrCircularReference = 'Circular reference found when calculating worksheet formulas';
|
|
|
|
{ ---------------------------------------------------------------------
|
|
Auxiliary functions
|
|
---------------------------------------------------------------------}
|
|
|
|
procedure RaiseParserError(Msg: String);
|
|
begin
|
|
raise EExprParser.Create(Msg);
|
|
end;
|
|
|
|
procedure RaiseParserError(Fmt: String; Args: Array of const);
|
|
begin
|
|
raise EExprParser.CreateFmt(Fmt, Args);
|
|
end;
|
|
|
|
function TokenName(AToken: TsTokenType): String;
|
|
begin
|
|
Result := GetEnumName(TypeInfo(TsTokenType), ord(AToken));
|
|
end;
|
|
|
|
function ResultTypeName(AResult: TsResultType): String;
|
|
begin
|
|
Result := GetEnumName(TypeInfo(TsResultType), ord(AResult));
|
|
end;
|
|
|
|
function CharToResultType(C: Char): TsResultType;
|
|
begin
|
|
case Upcase(C) of
|
|
'S' : Result := rtString;
|
|
'D' : Result := rtDateTime;
|
|
'B' : Result := rtBoolean;
|
|
'I' : Result := rtInteger;
|
|
'F' : Result := rtFloat;
|
|
'R' : Result := rtCellRange;
|
|
'C' : Result := rtCell;
|
|
'?' : Result := rtAny;
|
|
else
|
|
RaiseParserError(SErrInvalidResultCharacter, [C]);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
BuiltIns: TsBuiltInExpressionManager = nil;
|
|
|
|
function BuiltinIdentifiers: TsBuiltInExpressionManager;
|
|
begin
|
|
If (BuiltIns = nil) then
|
|
BuiltIns := TsBuiltInExpressionManager.Create(nil);
|
|
Result := BuiltIns;
|
|
end;
|
|
|
|
procedure FreeBuiltIns;
|
|
begin
|
|
FreeAndNil(Builtins);
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TsExpressionScanner }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
constructor TsExpressionScanner.Create;
|
|
begin
|
|
Source := '';
|
|
end;
|
|
|
|
function TsExpressionScanner.DoDelimiter: TsTokenType;
|
|
var
|
|
B : Boolean;
|
|
C, D : Char;
|
|
begin
|
|
C := FChar^;
|
|
FToken := C;
|
|
B := C in ['<', '>'];
|
|
D := C;
|
|
C := NextPos;
|
|
|
|
if B and (C in ['=', '>']) then
|
|
begin
|
|
FToken := FToken + C;
|
|
NextPos;
|
|
If D = '>' then
|
|
Result := ttLargerThanEqual
|
|
else if C = '>' then
|
|
Result := ttNotEqual
|
|
else
|
|
Result := ttLessThanEqual;
|
|
end
|
|
else
|
|
case D of
|
|
'+' : Result := ttPlus;
|
|
'-' : Result := ttMinus;
|
|
'*' : Result := ttMul;
|
|
'/' : Result := ttDiv;
|
|
'^' : Result := ttPower;
|
|
'%' : Result := ttPercent;
|
|
'&' : Result := ttConcat;
|
|
'<' : Result := ttLessThan;
|
|
'>' : Result := ttLargerThan;
|
|
'=' : Result := ttEqual;
|
|
'(' : Result := ttLeft;
|
|
')' : Result := ttRight;
|
|
',' : Result := ttComma;
|
|
else
|
|
ScanError(Format(SUnknownDelimiter, [D]));
|
|
end;
|
|
end;
|
|
|
|
function TsExpressionScanner.DoIdentifier: TsTokenType;
|
|
var
|
|
C: Char;
|
|
S: String;
|
|
row, row2: Cardinal;
|
|
col, col2: Cardinal;
|
|
flags: TsRelFlags;
|
|
begin
|
|
C := CurrentChar;
|
|
while (not IsWordDelim(C)) and (C <> cNull) do
|
|
begin
|
|
FToken := FToken + C;
|
|
C := NextPos;
|
|
end;
|
|
S := LowerCase(Token);
|
|
if ParseCellString(S, row, col, flags) and (C <> '(') then
|
|
Result := ttCell
|
|
else if ParseCellRangeString(S, row, col, row2, col2, flags) and (C <> '(') then
|
|
Result := ttCellRange
|
|
else if (S = 'true') and (C <> '(') then
|
|
Result := ttTrue
|
|
else if (S = 'false') and (C <> '(') then
|
|
Result := ttFalse
|
|
else
|
|
Result := ttIdentifier;
|
|
end;
|
|
|
|
function TsExpressionScanner.DoNumber: TsTokenType;
|
|
var
|
|
C: Char;
|
|
X: TsExprFloat;
|
|
prevC: Char;
|
|
begin
|
|
C := CurrentChar;
|
|
prevC := #0;
|
|
while (not IsWordDelim(C) or (prevC = 'E')) and (C <> cNull) do
|
|
begin
|
|
if not ( IsDigit(C)
|
|
or ((FToken <> '') and (Upcase(C) = 'E'))
|
|
or ((FToken <> '') and (C in ['+', '-']) and (prevC = 'E'))
|
|
)
|
|
then
|
|
ScanError(Format(SErrInvalidNumberChar, [C]));
|
|
FToken := FToken+C;
|
|
prevC := Upcase(C);
|
|
C := NextPos;
|
|
end;
|
|
if not TryStrToFloat(FToken, X, ExprFormatSettings) then
|
|
ScanError(Format(SErrInvalidNumber, [FToken]));
|
|
Result := ttNumber;
|
|
end;
|
|
|
|
function TsExpressionScanner.DoString: TsTokenType;
|
|
|
|
function TerminatingChar(C: Char): boolean;
|
|
begin
|
|
Result := (C = cNull)
|
|
or ((C = cDoubleQuote) and
|
|
not ((FPos < LSource) and (FSource[FPos+1] = cDoubleQuote)));
|
|
end;
|
|
|
|
var
|
|
C: Char;
|
|
begin
|
|
FToken := '';
|
|
C := NextPos;
|
|
while not TerminatingChar(C) do
|
|
begin
|
|
FToken := FToken+C;
|
|
if C = cDoubleQuote then
|
|
NextPos;
|
|
C := NextPos;
|
|
end;
|
|
if (C = cNull) then
|
|
ScanError(SBadQuotes);
|
|
Result := ttString;
|
|
FTokenType := Result;
|
|
NextPos;
|
|
end;
|
|
|
|
function TsExpressionScanner.GetCurrentChar: Char;
|
|
begin
|
|
if FChar <> nil then
|
|
Result := FChar^
|
|
else
|
|
Result := #0;
|
|
end;
|
|
|
|
function TsExpressionScanner.GetToken: TsTokenType;
|
|
var
|
|
C: Char;
|
|
begin
|
|
FToken := '';
|
|
SkipWhiteSpace;
|
|
C := FChar^;
|
|
if c = cNull then
|
|
Result := ttEOF
|
|
else if IsDelim(C) then
|
|
Result := DoDelimiter
|
|
else if (C = cDoubleQuote) then
|
|
Result := DoString
|
|
else if IsDigit(C) then
|
|
Result := DoNumber
|
|
else if IsAlpha(C) or (C = '$') then
|
|
Result := DoIdentifier
|
|
else
|
|
ScanError(Format(SErrUnknownCharacter, [FPos, C]));
|
|
FTokenType := Result;
|
|
end;
|
|
|
|
function TsExpressionScanner.IsAlpha(C: Char): Boolean;
|
|
begin
|
|
Result := C in ['A'..'Z', 'a'..'z'];
|
|
end;
|
|
|
|
function TsExpressionScanner.IsDelim(C: Char): Boolean;
|
|
begin
|
|
Result := C in Delimiters;
|
|
end;
|
|
|
|
function TsExpressionScanner.IsDigit(C: Char): Boolean;
|
|
begin
|
|
Result := C in Digits;
|
|
end;
|
|
|
|
function TsExpressionScanner.IsWordDelim(C: Char): Boolean;
|
|
begin
|
|
Result := C in WordDelimiters;
|
|
end;
|
|
|
|
function TsExpressionScanner.NextPos: Char;
|
|
begin
|
|
Inc(FPos);
|
|
Inc(FChar);
|
|
Result := FChar^;
|
|
end;
|
|
|
|
procedure TsExpressionScanner.ScanError(Msg: String);
|
|
begin
|
|
raise EExprScanner.Create(Msg)
|
|
end;
|
|
|
|
procedure TsExpressionScanner.SetSource(const AValue: String);
|
|
begin
|
|
FSource := AValue;
|
|
LSource := Length(FSource);
|
|
FTokenType := ttEOF;
|
|
if LSource = 0 then
|
|
FPos := 0
|
|
else
|
|
FPos := 1;
|
|
FChar := PChar(FSource);
|
|
FToken := '';
|
|
end;
|
|
|
|
procedure TsExpressionScanner.SkipWhiteSpace;
|
|
begin
|
|
while (FChar^ in WhiteSpace) and (FPos <= LSource) do
|
|
NextPos;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TsExpressionParser }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
constructor TsExpressionParser.Create(AWorksheet: TsWorksheet);
|
|
begin
|
|
inherited Create;
|
|
FWorksheet := AWorksheet;
|
|
FIdentifiers := TsExprIdentifierDefs.Create(TsExprIdentifierDef);
|
|
FIdentifiers.FParser := Self;
|
|
FScanner := TsExpressionScanner.Create;
|
|
FHashList := TFPHashObjectList.Create(False);
|
|
end;
|
|
|
|
destructor TsExpressionParser.Destroy;
|
|
begin
|
|
FreeAndNil(FHashList);
|
|
FreeAndNil(FExprNode);
|
|
FreeAndNil(FIdentifiers);
|
|
FreeAndNil(FScanner);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TsExpressionParser.BuildStringFormula: String;
|
|
begin
|
|
if FExprNode = nil then
|
|
Result := ''
|
|
else
|
|
Result := FExprNode.AsString;
|
|
end;
|
|
|
|
class function TsExpressionParser.BuiltinExpressionManager: TsBuiltInExpressionManager;
|
|
begin
|
|
Result := BuiltinIdentifiers;
|
|
end;
|
|
|
|
procedure TsExpressionParser.CheckEOF;
|
|
begin
|
|
if (TokenType = ttEOF) then
|
|
ParserError(SErrUnexpectedEndOfExpression);
|
|
end;
|
|
|
|
{ If the result types differ, they are converted to a common type if possible. }
|
|
procedure TsExpressionParser.CheckNodes(var ALeft, ARight: TsExprNode);
|
|
begin
|
|
ALeft := MatchNodes(ALeft, ARight);
|
|
ARight := MatchNodes(ARight, ALeft);
|
|
end;
|
|
|
|
procedure TsExpressionParser.CheckResultType(const Res: TsExpressionResult;
|
|
AType: TsResultType); inline;
|
|
begin
|
|
if (Res.ResultType <> AType) then
|
|
RaiseParserError(SErrInvalidResultType, [ResultTypeName(Res.ResultType)]);
|
|
end;
|
|
|
|
procedure TsExpressionParser.Clear;
|
|
begin
|
|
FExpression := '';
|
|
FHashList.Clear;
|
|
FreeAndNil(FExprNode);
|
|
end;
|
|
|
|
function TsExpressionParser.ConvertNode(ToDo: TsExprNode;
|
|
ToType: TsResultType): TsExprNode;
|
|
begin
|
|
Result := ToDo;
|
|
case ToDo.NodeType of
|
|
rtInteger :
|
|
case ToType of
|
|
rtFloat : Result := TsIntToFloatExprNode.Create(Result);
|
|
rtDateTime : Result := TsIntToDateTimeExprNode.Create(Result);
|
|
end;
|
|
rtFloat :
|
|
case ToType of
|
|
rtDateTime : Result := TsFloatToDateTimeExprNode.Create(Result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TsExpressionParser.CreateHashList;
|
|
var
|
|
ID: TsExprIdentifierDef;
|
|
BID: TsBuiltInExprIdentifierDef;
|
|
i: Integer;
|
|
M: TsBuiltInExpressionManager;
|
|
begin
|
|
FHashList.Clear;
|
|
// Builtins
|
|
M := BuiltinExpressionManager;
|
|
If (FBuiltins <> []) and Assigned(M) then
|
|
for i:=0 to M.IdentifierCount-1 do
|
|
begin
|
|
BID := M.Identifiers[i];
|
|
If BID.Category in FBuiltins then
|
|
FHashList.Add(UpperCase(BID.Name), BID);
|
|
end;
|
|
// User
|
|
for i:=0 to FIdentifiers.Count-1 do
|
|
begin
|
|
ID := FIdentifiers[i];
|
|
FHashList.Add(UpperCase(ID.Name), ID);
|
|
end;
|
|
FDirty := False;
|
|
end;
|
|
|
|
function TsExpressionParser.CurrentToken: String;
|
|
begin
|
|
Result := FScanner.Token;
|
|
end;
|
|
|
|
function TsExpressionParser.Evaluate: TsExpressionResult;
|
|
begin
|
|
EvaluateExpression(Result);
|
|
end;
|
|
|
|
procedure TsExpressionParser.EvaluateExpression(var Result: TsExpressionResult);
|
|
begin
|
|
if (FExpression = '') then
|
|
ParserError(SErrInExpressionEmpty);
|
|
if not Assigned(FExprNode) then
|
|
ParserError(SErrInExpression);
|
|
FExprNode.GetNodeValue(Result);
|
|
end;
|
|
|
|
function TsExpressionParser.GetAsBoolean: Boolean;
|
|
var
|
|
Res: TsExpressionResult;
|
|
begin
|
|
EvaluateExpression(Res);
|
|
CheckResultType(Res, rtBoolean);
|
|
Result := Res.ResBoolean;
|
|
end;
|
|
|
|
function TsExpressionParser.GetAsDateTime: TDateTime;
|
|
var
|
|
Res: TsExpressionResult;
|
|
begin
|
|
EvaluateExpression(Res);
|
|
CheckResultType(Res, rtDateTime);
|
|
Result := Res.ResDatetime;
|
|
end;
|
|
|
|
function TsExpressionParser.GetAsFloat: TsExprFloat;
|
|
var
|
|
Res: TsExpressionResult;
|
|
begin
|
|
EvaluateExpression(Res);
|
|
CheckResultType(Res, rtFloat);
|
|
Result := Res.ResFloat;
|
|
end;
|
|
|
|
function TsExpressionParser.GetAsInteger: Int64;
|
|
var
|
|
Res: TsExpressionResult;
|
|
begin
|
|
EvaluateExpression(Res);
|
|
CheckResultType(Res, rtInteger);
|
|
Result := Res.ResInteger;
|
|
end;
|
|
|
|
function TsExpressionParser.GetAsString: String;
|
|
var
|
|
Res: TsExpressionResult;
|
|
begin
|
|
EvaluateExpression(Res);
|
|
CheckResultType(Res, rtString);
|
|
Result := Res.ResString;
|
|
end;
|
|
|
|
function TsExpressionParser.GetRPNFormula: TsRPNFormula;
|
|
begin
|
|
Result := CreateRPNFormula(FExprNode.AsRPNItem(nil), true);
|
|
end;
|
|
|
|
function TsExpressionParser.GetToken: TsTokenType;
|
|
begin
|
|
Result := FScanner.GetToken;
|
|
end;
|
|
|
|
function TsExpressionParser.IdentifierByName(AName: ShortString): TsExprIdentifierDef;
|
|
var
|
|
s: String;
|
|
begin
|
|
if FDirty then
|
|
CreateHashList;
|
|
s := FHashList.NameOfIndex(0);
|
|
s := FHashList.NameOfIndex(25);
|
|
s := FHashList.NameOfIndex(36);
|
|
Result := TsExprIdentifierDef(FHashList.Find(UpperCase(AName)));
|
|
end;
|
|
|
|
function TsExpressionParser.Level1: TsExprNode;
|
|
var
|
|
tt: TsTokenType;
|
|
Right: TsExprNode;
|
|
begin
|
|
{$ifdef debugexpr}Writeln('Level 1 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
|
{
|
|
if TokenType = ttNot then
|
|
begin
|
|
GetToken;
|
|
CheckEOF;
|
|
Right := Level2;
|
|
Result := TsNotExprNode.Create(Right);
|
|
end
|
|
else
|
|
}
|
|
Result := Level2;
|
|
{
|
|
try
|
|
if TokenType = ttPower then
|
|
begin
|
|
tt := Tokentype;
|
|
GetToken;
|
|
CheckEOF;
|
|
Right := Level2;
|
|
Result := TsPowerExprNode.Create(Result, Right);
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
}
|
|
{
|
|
try
|
|
|
|
while (TokenType in [ttAnd, ttOr, ttXor]) do
|
|
begin
|
|
tt := TokenType;
|
|
GetToken;
|
|
CheckEOF;
|
|
Right := Level2;
|
|
case tt of
|
|
ttOr : Result := TsBinaryOrExprNode.Create(Result, Right);
|
|
ttAnd : Result := TsBinaryAndExprNode.Create(Result, Right);
|
|
ttXor : Result := TsBinaryXorExprNode.Create(Result, Right);
|
|
else
|
|
ParserError(SErrUnknownBooleanOp)
|
|
end;
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
}
|
|
end;
|
|
|
|
function TsExpressionParser.Level2: TsExprNode;
|
|
var
|
|
right: TsExprNode;
|
|
tt: TsTokenType;
|
|
C: TsBinaryOperationExprNodeClass;
|
|
begin
|
|
{$ifdef debugexpr} Writeln('Level 2 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
|
Result := Level3;
|
|
try
|
|
if (TokenType in ttComparisons) then
|
|
begin
|
|
tt := TokenType;
|
|
GetToken;
|
|
CheckEOF;
|
|
Right := Level3;
|
|
CheckNodes(Result, right);
|
|
case tt of
|
|
ttLessthan : C := TsLessExprNode;
|
|
ttLessthanEqual : C := TsLessEqualExprNode;
|
|
ttLargerThan : C := TsGreaterExprNode;
|
|
ttLargerThanEqual : C := TsGreaterEqualExprNode;
|
|
ttEqual : C := TsEqualExprNode;
|
|
ttNotEqual : C := TsNotEqualExprNode;
|
|
else
|
|
ParserError(SErrUnknownComparison)
|
|
end;
|
|
Result := C.Create(Result, right);
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function TsExpressionParser.Level3: TsExprNode;
|
|
var
|
|
tt: TsTokenType;
|
|
right: TsExprNode;
|
|
begin
|
|
{$ifdef debugexpr} Writeln('Level 3 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
|
Result := Level4;
|
|
try
|
|
while TokenType in [ttPlus, ttMinus, ttConcat] do begin
|
|
tt := TokenType;
|
|
GetToken;
|
|
CheckEOF;
|
|
right := Level4;
|
|
CheckNodes(Result, right);
|
|
case tt of
|
|
ttPlus : Result := TsAddExprNode.Create(Result, right);
|
|
ttMinus : Result := TsSubtractExprNode.Create(Result, right);
|
|
ttConcat: Result := TsConcatExprNode.Create(Result, right);
|
|
end;
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function TsExpressionParser.Level4: TsExprNode;
|
|
var
|
|
tt: TsTokenType;
|
|
right: TsExprNode;
|
|
begin
|
|
{$ifdef debugexpr} Writeln('Level 4 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
|
Result := Level5;
|
|
try
|
|
while (TokenType in [ttMul, ttDiv]) do
|
|
begin
|
|
tt := TokenType;
|
|
GetToken;
|
|
right := Level5;
|
|
CheckNodes(Result, right);
|
|
case tt of
|
|
ttMul : Result := TsMultiplyExprNode.Create(Result, right);
|
|
ttDiv : Result := TsDivideExprNode.Create(Result, right);
|
|
end;
|
|
end;
|
|
except
|
|
Result.Free;
|
|
Raise;
|
|
end;
|
|
end;
|
|
|
|
function TsExpressionParser.Level5: TsExprNode;
|
|
var
|
|
isPlus, isMinus: Boolean;
|
|
tt: TsTokenType;
|
|
begin
|
|
{$ifdef debugexpr} Writeln('Level 5 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
|
isPlus := false;
|
|
isMinus := false;
|
|
if (TokenType in [ttPlus, ttMinus]) then
|
|
begin
|
|
isPlus := (TokenType = ttPlus);
|
|
isMinus := (TokenType = ttMinus);
|
|
GetToken;
|
|
end;
|
|
Result := Level6;
|
|
if isPlus then
|
|
Result := TsUPlusExprNode.Create(Result);
|
|
if isMinus then
|
|
Result := TsUMinusExprNode.Create(Result);
|
|
end;
|
|
|
|
function TsExpressionParser.Level6: TsExprNode;
|
|
var
|
|
tt: TsTokenType;
|
|
Right: TsExprNode;
|
|
begin
|
|
{$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
|
if (TokenType = ttLeft) then
|
|
begin
|
|
GetToken;
|
|
Result := TsParenthesisExprNode.Create(Level1);
|
|
try
|
|
if (TokenType <> ttRight) then
|
|
ParserError(Format(SErrBracketExpected, [SCanner.Pos, CurrentToken]));
|
|
GetToken;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end
|
|
else
|
|
Result := Primitive;
|
|
|
|
if TokenType = ttPower then
|
|
begin
|
|
try
|
|
CheckEOF;
|
|
tt := Tokentype;
|
|
GetToken;
|
|
Right := Primitive;
|
|
CheckNodes(Result, right);
|
|
Result := TsPowerExprNode.Create(Result, Right);
|
|
//GetToken;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Checks types of todo and match. If ToDO can be converted to it matches
|
|
the type of match, then a node is inserted.
|
|
For binary operations, this function is called for both operands. }
|
|
function TsExpressionParser.MatchNodes(ToDo, Match: TsExprNode): TsExprNode;
|
|
var
|
|
TT, MT : TsResultType;
|
|
begin
|
|
Result := ToDo;
|
|
TT := ToDo.NodeType;
|
|
MT := Match.NodeType;
|
|
if TT <> MT then
|
|
begin
|
|
if TT = rtInteger then
|
|
begin
|
|
if (MT in [rtFloat, rtDateTime]) then
|
|
Result := ConvertNode(ToDo, MT);
|
|
end
|
|
else if (TT = rtFloat) then
|
|
begin
|
|
if (MT = rtDateTime) then
|
|
Result := ConvertNode(ToDo, rtDateTime);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TsExpressionParser.ParserError(Msg: String);
|
|
begin
|
|
raise EExprParser.Create(Msg);
|
|
end;
|
|
|
|
function TsExpressionParser.Primitive: TsExprNode;
|
|
var
|
|
I: Int64;
|
|
X: TsExprFloat;
|
|
lCount: Integer;
|
|
ID: TsExprIdentifierDef;
|
|
Args: TsExprArgumentArray;
|
|
AI: Integer;
|
|
cell: PCell;
|
|
optional: Boolean;
|
|
token: String;
|
|
begin
|
|
{$ifdef debugexpr} Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
|
SetLength(Args, 0);
|
|
if (TokenType = ttNumber) then
|
|
begin
|
|
if TryStrToInt64(CurrentToken, I) then
|
|
Result := TsConstExprNode.CreateInteger(I)
|
|
else
|
|
begin
|
|
if TryStrToFloat(CurrentToken, X, ExprFormatSettings) then
|
|
Result := TsConstExprNode.CreateFloat(X)
|
|
else
|
|
ParserError(Format(SErrInvalidFloat, [CurrentToken]));
|
|
end;
|
|
end
|
|
else if (TokenType = ttTrue) then
|
|
Result := TsConstExprNode.CreateBoolean(true)
|
|
else if (TokenType = ttFalse) then
|
|
Result := TsConstExprNode.CreateBoolean(false)
|
|
else if (TokenType = ttString) then
|
|
Result := TsConstExprNode.CreateString(CurrentToken)
|
|
else if (TokenType = ttCell) then
|
|
Result := TsCellExprNode.Create(FWorksheet, CurrentToken)
|
|
else if (TokenType = ttCellRange) then
|
|
Result := TsCellRangeExprNode.Create(FWorksheet, CurrentToken)
|
|
else if not (TokenType in [ttIdentifier{, ttIf}]) then
|
|
ParserError(Format(SerrUnknownTokenAtPos, [Scanner.Pos, CurrentToken]))
|
|
else
|
|
begin
|
|
token := Uppercase(CurrentToken);
|
|
ID := self.IdentifierByName(token);
|
|
if (ID = nil) then
|
|
ParserError(Format(SErrUnknownIdentifier, [token]));
|
|
if (ID.IdentifierType in [itFunctionCallBack, itFunctionHandler]) then
|
|
begin
|
|
lCount := ID.ArgumentCount;
|
|
if lCount = 0 then // we have to handle the () here, it will be skipped below.
|
|
begin
|
|
GetToken;
|
|
if (TokenType <> ttLeft) then
|
|
ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken]));
|
|
GetToken;
|
|
if (TokenType <> ttRight) then
|
|
ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken]));
|
|
SetLength(Args, 0);
|
|
end;
|
|
end
|
|
else
|
|
lCount := 0;
|
|
|
|
// Parse arguments.
|
|
// Negative is for variable number of arguments, where Abs(value) is the minimum number of arguments
|
|
if (lCount <> 0) then
|
|
begin
|
|
GetToken;
|
|
if (TokenType <> ttLeft) then
|
|
ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken]));
|
|
SetLength(Args, abs(lCount));
|
|
AI := 0;
|
|
try
|
|
repeat
|
|
GetToken;
|
|
// Check if we must enlarge the argument array
|
|
if (lCount < 0) and (AI = Length(Args)) then
|
|
begin
|
|
SetLength(Args, AI+1);
|
|
Args[AI] := nil;
|
|
end;
|
|
Args[AI] := Level1;
|
|
inc(AI);
|
|
optional := ID.IsOptionalArgument(AI+1);
|
|
if not optional then
|
|
begin
|
|
if (TokenType <> ttComma) then
|
|
if (AI < abs(lCount)) then
|
|
ParserError(Format(SErrCommaExpected, [Scanner.Pos, CurrentToken]))
|
|
end;
|
|
until (AI = lCount) or (((lCount < 0) or optional) and (TokenType = ttRight));
|
|
if TokenType <> ttRight then
|
|
ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken]));
|
|
if AI < abs(lCount) then
|
|
SetLength(Args, AI);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
dec(AI);
|
|
while (AI >= 0) do
|
|
begin
|
|
FreeAndNil(Args[Ai]);
|
|
dec(AI);
|
|
end;
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
case ID.IdentifierType of
|
|
itVariable : Result := TsVariableExprNode.CreateIdentifier(ID);
|
|
itFunctionCallBack : Result := TsFunctionCallBackExprNode.CreateFunction(ID, Args);
|
|
itFunctionHandler : Result := TFPFunctionEventHandlerExprNode.CreateFunction(ID, Args);
|
|
end;
|
|
end;
|
|
GetToken;
|
|
if TokenType = ttPercent then begin
|
|
Result := TsPercentExprNode.Create(Result);
|
|
GetToken;
|
|
end;
|
|
end;
|
|
|
|
function TsExpressionParser.ResultType: TsResultType;
|
|
begin
|
|
if not Assigned(FExprNode) then
|
|
ParserError(SErrInExpression);
|
|
Result := FExprNode.NodeType;;
|
|
end;
|
|
|
|
procedure TsExpressionParser.SetBuiltIns(const AValue: TsBuiltInExprCategories);
|
|
begin
|
|
if FBuiltIns = AValue then
|
|
exit;
|
|
FBuiltIns := AValue;
|
|
FDirty := true;
|
|
end;
|
|
|
|
procedure TsExpressionParser.SetExpression(const AValue: String);
|
|
begin
|
|
if FExpression = AValue then
|
|
exit;
|
|
FExpression := AValue;
|
|
if (AValue <> '') and (AValue[1] = '=') then
|
|
FScanner.Source := Copy(AValue, 2, Length(AValue))
|
|
else
|
|
FScanner.Source := AValue;
|
|
FreeAndNil(FExprNode);
|
|
if (FExpression <> '') then
|
|
begin
|
|
GetToken;
|
|
FExprNode := Level1;
|
|
if (TokenType <> ttEOF) then
|
|
ParserError(Format(SErrUnterminatedExpression, [Scanner.Pos, CurrentToken]));
|
|
FExprNode.Check;
|
|
end;
|
|
end;
|
|
|
|
procedure TsExpressionParser.SetIdentifiers(const AValue: TsExprIdentifierDefs);
|
|
begin
|
|
FIdentifiers.Assign(AValue)
|
|
end;
|
|
|
|
procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
|
|
|
|
procedure CreateNodeFromRPN(var ANode: TsExprNode; var AIndex: Integer);
|
|
var
|
|
node: TsExprNode;
|
|
left: TsExprNode;
|
|
right: TsExprNode;
|
|
operand: TsExprNode;
|
|
fek: TFEKind;
|
|
r,c, r2,c2: Cardinal;
|
|
flags: TsRelFlags;
|
|
ID: TsExprIdentifierDef;
|
|
i, n: Integer;
|
|
args: TsExprArgumentArray;
|
|
begin
|
|
if AIndex < 0 then
|
|
exit;
|
|
|
|
fek := AFormula[AIndex].ElementKind;
|
|
|
|
case fek of
|
|
fekCell, fekCellRef:
|
|
begin
|
|
r := AFormula[AIndex].Row;
|
|
c := AFormula[AIndex].Col;
|
|
flags := AFormula[AIndex].RelFlags;
|
|
ANode := TsCellExprNode.Create(FWorksheet, r, c, flags);
|
|
dec(AIndex);
|
|
end;
|
|
fekCellRange:
|
|
begin
|
|
r := AFormula[AIndex].Row;
|
|
c := AFormula[AIndex].Col;
|
|
r2 := AFormula[AIndex].Row2;
|
|
c2 := AFormula[AIndex].Col2;
|
|
flags := AFormula[AIndex].RelFlags;
|
|
ANode := TsCellRangeExprNode.Create(FWorksheet, r, c, r2, c2, flags);
|
|
dec(AIndex);
|
|
end;
|
|
fekNum:
|
|
begin
|
|
ANode := TsConstExprNode.CreateFloat(AFormula[AIndex].DoubleValue);
|
|
dec(AIndex);
|
|
end;
|
|
fekInteger:
|
|
begin
|
|
ANode := TsConstExprNode.CreateInteger(AFormula[AIndex].IntValue);
|
|
dec(AIndex);
|
|
end;
|
|
fekString:
|
|
begin
|
|
ANode := TsConstExprNode.CreateString(AFormula[AIndex].StringValue);
|
|
dec(AIndex);
|
|
end;
|
|
fekBool:
|
|
begin
|
|
ANode := TsConstExprNode.CreateBoolean(AFormula[AIndex].DoubleValue <> 0.0);
|
|
dec(AIndex);
|
|
end;
|
|
fekErr:
|
|
begin
|
|
ANode := TsConstExprNode.CreateError(TsErrorValue(AFormula[AIndex].IntValue));
|
|
dec(AIndex);
|
|
end;
|
|
|
|
// unary operations
|
|
fekPercent, fekUMinus, fekUPlus, fekParen:
|
|
begin
|
|
dec(AIndex);
|
|
CreateNodeFromRPN(operand, AIndex);
|
|
case fek of
|
|
fekPercent : ANode := TsPercentExprNode.Create(operand);
|
|
fekUMinus : ANode := TsUMinusExprNode.Create(operand);
|
|
fekUPlus : ANode := TsUPlusExprNode.Create(operand);
|
|
fekParen : ANode := TsParenthesisExprNode.Create(operand);
|
|
end;
|
|
end;
|
|
|
|
// binary operations
|
|
fekAdd, fekSub, fekMul, fekDiv,
|
|
fekPower, fekConcat,
|
|
fekEqual, fekNotEqual,
|
|
fekGreater, fekGreaterEqual,
|
|
fekLess, fekLessEqual:
|
|
begin
|
|
dec(AIndex);
|
|
CreateNodeFromRPN(right, AIndex);
|
|
CreateNodeFromRPN(left, AIndex);
|
|
CheckNodes(left, right);
|
|
case fek of
|
|
fekAdd : ANode := TsAddExprNode.Create(left, right);
|
|
fekSub : ANode := TsSubtractExprNode.Create(left, right);
|
|
fekMul : ANode := TsMultiplyExprNode.Create(left, right);
|
|
fekDiv : ANode := TsDivideExprNode.Create(left, right);
|
|
fekPower : ANode := TsPowerExprNode.Create(left, right);
|
|
fekConcat : ANode := tsConcatExprNode.Create(left, right);
|
|
fekEqual : ANode := TsEqualExprNode.Create(left, right);
|
|
fekNotEqual : ANode := TsNotEqualExprNode.Create(left, right);
|
|
fekGreater : ANode := TsGreaterExprNode.Create(left, right);
|
|
fekGreaterEqual: ANode := TsGreaterEqualExprNode.Create(left, right);
|
|
fekLess : ANode := TsLessExprNode.Create(left, right);
|
|
fekLessEqual : ANode := tsLessEqualExprNode.Create(left, right);
|
|
end;
|
|
end;
|
|
|
|
// functions
|
|
fekFunc:
|
|
begin
|
|
ID := self.IdentifierByName(AFormula[AIndex].FuncName);
|
|
if ID = nil then
|
|
begin
|
|
ParserError(Format(SErrUnknownIdentifier,[AFormula[AIndex].FuncName]));
|
|
dec(AIndex);
|
|
end else
|
|
begin
|
|
if ID.HasFixedArgumentCount then
|
|
n := ID.ArgumentCount
|
|
else
|
|
n := AFormula[AIndex].ParamsNum;
|
|
dec(AIndex);
|
|
SetLength(args, n);
|
|
for i:=n-1 downto 0 do
|
|
CreateNodeFromRPN(args[i], AIndex);
|
|
case ID.IdentifierType of
|
|
itVariable : ANode := TsVariableExprNode.CreateIdentifier(ID);
|
|
itFunctionCallBack : ANode := TsFunctionCallBackExprNode.CreateFunction(ID, args);
|
|
itFunctionHandler : ANode := TFPFunctionEventHandlerExprNode.CreateFunction(ID, args);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end; //case
|
|
end; //begin
|
|
|
|
var
|
|
index: Integer;
|
|
node: TsExprNode;
|
|
begin
|
|
FExpression := '';
|
|
FreeAndNil(FExprNode);
|
|
index := Length(AFormula)-1;
|
|
CreateNodeFromRPN(FExprNode, index);
|
|
if Assigned(FExprNode) then FExprNode.Check;
|
|
end;
|
|
|
|
function TsExpressionParser.TokenType: TsTokenType;
|
|
begin
|
|
Result := FScanner.TokenType;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TsSpreadsheetParser }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
constructor TsSpreadsheetParser.Create(AWorksheet: TsWorksheet);
|
|
begin
|
|
inherited Create(AWorksheet);
|
|
BuiltIns := AllBuiltIns;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TsExprIdentifierDefs }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
function TsExprIdentifierDefs.AddBooleanVariable(const AName: ShortString;
|
|
AValue: Boolean): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.IdentifierType := itVariable;
|
|
Result.Name := AName;
|
|
Result.ResultType := rtBoolean;
|
|
Result.FValue.ResBoolean := AValue;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.AddDateTimeVariable(const AName: ShortString;
|
|
AValue: TDateTime): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.IdentifierType := itVariable;
|
|
Result.Name := AName;
|
|
Result.ResultType := rtDateTime;
|
|
Result.FValue.ResDateTime := AValue;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.AddFloatVariable(const AName: ShortString;
|
|
AValue: TsExprFloat): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.IdentifierType := itVariable;
|
|
Result.Name := AName;
|
|
Result.ResultType := rtFloat;
|
|
Result.FValue.ResFloat := AValue;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.AddFunction(const AName: ShortString;
|
|
const AResultType: Char; const AParamTypes: String; const AExcelCode: Integer;
|
|
ACallBack: TsExprFunctionCallBack): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.Name := AName;
|
|
Result.IdentifierType := itFunctionCallBack;
|
|
Result.ResultType := CharToResultType(AResultType);
|
|
Result.ExcelCode := AExcelCode;
|
|
Result.FOnGetValueCB := ACallBack;
|
|
if (Length(AParamTypes) > 0) and (AParamTypes[Length(AParamTypes)]='+') then
|
|
begin
|
|
Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
|
|
Result.VariableArgumentCount := true;
|
|
end else
|
|
Result.ParameterTypes := AParamTypes;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.AddFunction(const AName: ShortString;
|
|
const AResultType: Char; const AParamTypes: String; const AExcelCode: Integer;
|
|
ACallBack: TsExprFunctionEvent): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.Name := AName;
|
|
Result.IdentifierType := itFunctionHandler;
|
|
Result.ResultType := CharToResultType(AResultType);
|
|
Result.ExcelCode := AExcelCode;
|
|
Result.FOnGetValue := ACallBack;
|
|
if (Length(AParamTypes) > 0) and (AParamTypes[Length(AParamTypes)]='+') then
|
|
begin
|
|
Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
|
|
Result.VariableArgumentCount := true;
|
|
end else
|
|
Result.ParameterTypes := AParamTypes;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.AddIntegerVariable(const AName: ShortString;
|
|
AValue: Integer): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.IdentifierType := itVariable;
|
|
Result.Name := AName;
|
|
Result.ResultType := rtInteger;
|
|
Result.FValue.ResInteger := AValue;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.AddStringVariable(const AName: ShortString;
|
|
AValue: String): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.IdentifierType := itVariable;
|
|
Result.Name := AName;
|
|
Result.ResultType := rtString;
|
|
Result.FValue.ResString := AValue;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.AddVariable(const AName: ShortString;
|
|
AResultType: TsResultType; AValue: String): TsExprIdentifierDef;
|
|
begin
|
|
Result := Add as TsExprIdentifierDef;
|
|
Result.IdentifierType := itVariable;
|
|
Result.Name := AName;
|
|
Result.ResultType := AResultType;
|
|
Result.Value := AValue;
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.FindIdentifier(const AName: ShortString
|
|
): TsExprIdentifierDef;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndexOfIdentifier(AName);
|
|
if (I = -1) then
|
|
Result := nil
|
|
else
|
|
Result := GetI(I);
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.GetI(AIndex : Integer): TsExprIdentifierDef;
|
|
begin
|
|
Result := TsExprIdentifierDef(Items[AIndex]);
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.IdentifierByExcelCode(const AExcelCode: Integer
|
|
): TsExprIdentifierDef;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndexOfIdentifier(AExcelCode);
|
|
if I = -1 then
|
|
Result := nil
|
|
else
|
|
Result := GetI(I);
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.IdentifierByName(const AName: ShortString
|
|
): TsExprIdentifierDef;
|
|
begin
|
|
Result := FindIdentifier(AName);
|
|
if (Result = nil) then
|
|
RaiseParserError(SErrUnknownIdentifier, [AName]);
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.IndexOfIdentifier(const AName: ShortString): Integer;
|
|
begin
|
|
Result := Count-1;
|
|
while (Result >= 0) and (CompareText(GetI(Result).Name, AName) <> 0) do
|
|
dec(Result);
|
|
end;
|
|
|
|
function TsExprIdentifierDefs.IndexOfIdentifier(const AExcelCode: Integer): Integer;
|
|
var
|
|
ID: TsExprIdentifierDef;
|
|
begin
|
|
Result := Count-1;
|
|
while (Result >= 0) do begin
|
|
ID := GetI(Result);
|
|
if ID.ExcelCode = AExcelCode then exit;
|
|
dec(Result);
|
|
end;
|
|
{
|
|
while (Result >= 0) and (GetI(Result).ExcelCode = AExcelCode) do
|
|
dec(Result);
|
|
}
|
|
end;
|
|
|
|
procedure TsExprIdentifierDefs.SetI(AIndex: Integer;
|
|
const AValue: TsExprIdentifierDef);
|
|
begin
|
|
Items[AIndex] := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDefs.Update(Item: TCollectionItem);
|
|
begin
|
|
if Assigned(FParser) then
|
|
FParser.FDirty := true;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TsExprIdentifierDef }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
function TsExprIdentifierDef.ArgumentCount: Integer;
|
|
begin
|
|
if FVariableArgumentCount then
|
|
Result := -Length(FArgumentTypes)
|
|
else
|
|
Result := Length(FArgumentTypes);
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.Assign(Source: TPersistent);
|
|
var
|
|
EID: TsExprIdentifierDef;
|
|
begin
|
|
if (Source is TsExprIdentifierDef) then
|
|
begin
|
|
EID := Source as TsExprIdentifierDef;
|
|
FStringValue := EID.FStringValue;
|
|
FValue := EID.FValue;
|
|
FArgumentTypes := EID.FArgumentTypes;
|
|
FVariableArgumentCount := EID.FVariableArgumentCount;
|
|
FExcelCode := EID.ExcelCode;
|
|
FIDType := EID.FIDType;
|
|
FName := EID.FName;
|
|
FOnGetValue := EID.FOnGetValue;
|
|
FOnGetValueCB := EID.FOnGetValueCB;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.CheckResultType(const AType: TsResultType);
|
|
begin
|
|
if (FValue.ResultType <> AType) then
|
|
RaiseParserError(SErrInvalidResultType, [ResultTypeName(AType)])
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.CheckVariable;
|
|
begin
|
|
if Identifiertype <> itVariable then
|
|
RaiseParserError(SErrNotVariable, [Name]);
|
|
end;
|
|
|
|
function TsExprIdentifierDef.GetAsBoolean: Boolean;
|
|
begin
|
|
CheckResultType(rtBoolean);
|
|
CheckVariable;
|
|
Result := FValue.ResBoolean;
|
|
end;
|
|
|
|
function TsExprIdentifierDef.GetAsDateTime: TDateTime;
|
|
begin
|
|
CheckResultType(rtDateTime);
|
|
CheckVariable;
|
|
Result := FValue.ResDateTime;
|
|
end;
|
|
|
|
function TsExprIdentifierDef.GetAsFloat: TsExprFloat;
|
|
begin
|
|
CheckResultType(rtFloat);
|
|
CheckVariable;
|
|
Result := FValue.ResFloat;
|
|
end;
|
|
|
|
function TsExprIdentifierDef.GetAsInteger: Int64;
|
|
begin
|
|
CheckResultType(rtInteger);
|
|
CheckVariable;
|
|
Result := FValue.ResInteger;
|
|
end;
|
|
|
|
function TsExprIdentifierDef.GetAsString: String;
|
|
begin
|
|
CheckResultType(rtString);
|
|
CheckVariable;
|
|
Result := FValue.ResString;
|
|
end;
|
|
|
|
function TsExprIdentifierDef.GetResultType: TsResultType;
|
|
begin
|
|
Result := FValue.ResultType;
|
|
end;
|
|
|
|
function TsExprIdentifierDef.GetValue: String;
|
|
begin
|
|
case FValue.ResultType of
|
|
rtBoolean : if FValue.ResBoolean then
|
|
Result := 'True'
|
|
else
|
|
Result := 'False';
|
|
rtInteger : Result := IntToStr(FValue.ResInteger);
|
|
rtFloat : Result := FloatToStr(FValue.ResFloat, ExprFormatSettings);
|
|
rtDateTime : Result := FormatDateTime('cccc', FValue.ResDateTime);
|
|
rtString : Result := FValue.ResString;
|
|
end;
|
|
end;
|
|
|
|
{ Returns true if the epxression has a fixed number of arguments. }
|
|
function TsExprIdentifierDef.HasFixedArgumentCount: Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FVariableArgumentCount then
|
|
Result := false
|
|
else
|
|
begin
|
|
for i:= 1 to Length(FArgumentTypes) do
|
|
if IsOptionalArgument(i) then
|
|
begin
|
|
Result := false;
|
|
exit;
|
|
end;
|
|
Result := true;
|
|
end;
|
|
end;
|
|
|
|
{ Checks whether an argument is optional. Index number starts at 1.
|
|
Optional arguments are lower-case characters in the argument list. }
|
|
function TsExprIdentifierDef.IsOptionalArgument(AIndex: Integer): Boolean;
|
|
begin
|
|
Result := (AIndex <= Length(FArgumentTypes))
|
|
and (UpCase(FArgumentTypes[AIndex]) <> FArgumentTypes[AIndex]);
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetArgumentTypes(const AValue: String);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if FArgumentTypes = AValue then
|
|
exit;
|
|
for i:=1 to Length(AValue) do
|
|
CharToResultType(AValue[i]);
|
|
FArgumentTypes := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetAsBoolean(const AValue: Boolean);
|
|
begin
|
|
CheckVariable;
|
|
CheckResultType(rtBoolean);
|
|
FValue.ResBoolean := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetAsDateTime(const AValue: TDateTime);
|
|
begin
|
|
CheckVariable;
|
|
CheckResultType(rtDateTime);
|
|
FValue.ResDateTime := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetAsFloat(const AValue: TsExprFloat);
|
|
begin
|
|
CheckVariable;
|
|
CheckResultType(rtFloat);
|
|
FValue.ResFloat := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetAsInteger(const AValue: Int64);
|
|
begin
|
|
CheckVariable;
|
|
CheckResultType(rtInteger);
|
|
FValue.ResInteger := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetAsString(const AValue: String);
|
|
begin
|
|
CheckVariable;
|
|
CheckResultType(rtString);
|
|
FValue.resString := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetName(const AValue: ShortString);
|
|
begin
|
|
if FName = AValue then
|
|
exit;
|
|
if (AValue <> '') then
|
|
if Assigned(Collection) and (TsExprIdentifierDefs(Collection).IndexOfIdentifier(AValue) <> -1) then
|
|
RaiseParserError(SErrDuplicateIdentifier,[AValue]);
|
|
FName := AValue;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetResultType(const AValue: TsResultType);
|
|
begin
|
|
if AValue <> FValue.ResultType then
|
|
begin
|
|
FValue.ResultType := AValue;
|
|
SetValue(FStringValue);
|
|
end;
|
|
end;
|
|
|
|
procedure TsExprIdentifierDef.SetValue(const AValue: String);
|
|
begin
|
|
FStringValue := AValue;
|
|
if (AValue <> '') then
|
|
case FValue.ResultType of
|
|
rtBoolean : FValue.ResBoolean := FStringValue='True';
|
|
rtInteger : FValue.ResInteger := StrToInt(AValue);
|
|
rtFloat : FValue.ResFloat := StrToFloat(AValue);
|
|
rtDateTime : FValue.ResDateTime := StrToDateTime(AValue);
|
|
rtString : FValue.ResString := AValue;
|
|
end
|
|
else
|
|
case FValue.ResultType of
|
|
rtBoolean : FValue.ResBoolean := false;
|
|
rtInteger : FValue.ResInteger := 0;
|
|
rtFloat : FValue.ResFloat := 0.0;
|
|
rtDateTime : FValue.ResDateTime := 0;
|
|
rtString : FValue.ResString := '';
|
|
end
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TsBuiltInExpressionManager }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
constructor TsBuiltInExpressionManager.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDefs := TsExprIdentifierDefs.Create(TsBuiltInExprIdentifierDef)
|
|
end;
|
|
|
|
destructor TsBuiltInExpressionManager.Destroy;
|
|
begin
|
|
FreeAndNil(FDefs);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddVariable(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; AResultType: TsResultType; AValue: String
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.Addvariable(AName, AResultType, AValue));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddBooleanVariable(
|
|
const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: Boolean
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.AddBooleanvariable(AName, AValue));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddDateTimeVariable(
|
|
const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: TDateTime
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.AddDateTimeVariable(AName, AValue));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddFloatVariable(
|
|
const ACategory: TsBuiltInExprCategory; const AName: ShortString;
|
|
AValue: TsExprFloat): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.AddFloatVariable(AName, AValue));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddFunction(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; const AResultType: Char; const AParamTypes: String;
|
|
const AExcelCode: Integer; ACallBack: TsExprFunctionCallBack): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.AddFunction(AName, AResultType,
|
|
AParamTypes, AExcelCode, ACallBack));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddFunction(const ACategory: TsBuiltInExprCategory;
|
|
const AName: ShortString; const AResultType: Char; const AParamTypes: String;
|
|
const AExcelCode: Integer; ACallBack: TsExprFunctionEvent): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.AddFunction(AName, AResultType,
|
|
AParamTypes, AExcelCode, ACallBack));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddIntegerVariable(
|
|
const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: Integer
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.AddIntegerVariable(AName, AValue));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.AddStringVariable(
|
|
const ACategory: TsBuiltInExprCategory; const AName: ShortString; AValue: String
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.AddStringVariable(AName, AValue));
|
|
Result.Category := ACategory;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.FindIdentifier(const AName: ShortString
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.FindIdentifier(AName));
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.GetCount: Integer;
|
|
begin
|
|
Result := FDefs.Count;
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.GetI(AIndex: Integer): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs[Aindex])
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.IdentifierByExcelCode(const AExcelCode: Integer
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.IdentifierByExcelCode(AExcelCode));
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.IdentifierByName(const AName: ShortString
|
|
): TsBuiltInExprIdentifierDef;
|
|
begin
|
|
Result := TsBuiltInExprIdentifierDef(FDefs.IdentifierByName(AName));
|
|
end;
|
|
|
|
function TsBuiltInExpressionManager.IndexOfIdentifier(const AName: ShortString): Integer;
|
|
begin
|
|
Result := FDefs.IndexOfIdentifier(AName);
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Various Nodes }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
{ TsExprNode }
|
|
|
|
procedure TsExprNode.CheckNodeType(ANode: TsExprNode; Allowed: TsResultTypes);
|
|
var
|
|
S: String;
|
|
A: TsResultType;
|
|
begin
|
|
if (ANode = nil) then
|
|
RaiseParserError(SErrNoNodeToCheck);
|
|
if not (ANode.NodeType in Allowed) then
|
|
begin
|
|
S := '';
|
|
for A := Low(TsResultType) to High(TsResultType) do
|
|
if A in Allowed then
|
|
begin
|
|
if S <> '' then
|
|
S := S + ',';
|
|
S := S + ResultTypeName(A);
|
|
end;
|
|
RaiseParserError(SInvalidNodeType, [ResultTypeName(ANode.NodeType), S, ANode.AsString]);
|
|
end;
|
|
end;
|
|
|
|
function TsExprNode.NodeValue: TsExpressionResult;
|
|
begin
|
|
GetNodeValue(Result);
|
|
end;
|
|
|
|
|
|
{ TsUnaryOperationExprNode }
|
|
|
|
constructor TsUnaryOperationExprNode.Create(AOperand: TsExprNode);
|
|
begin
|
|
FOperand := AOperand;
|
|
end;
|
|
|
|
destructor TsUnaryOperationExprNode.Destroy;
|
|
begin
|
|
FreeAndNil(FOperand);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TsUnaryOperationExprNode.Check;
|
|
begin
|
|
if not Assigned(Operand) then
|
|
RaiseParserError(SErrNoOperand, [Self.ClassName]);
|
|
end;
|
|
|
|
|
|
{ TsBinaryOperationExprNode }
|
|
|
|
constructor TsBinaryOperationExprNode.Create(ALeft, ARight: TsExprNode);
|
|
begin
|
|
FLeft := ALeft;
|
|
FRight := ARight;
|
|
end;
|
|
|
|
destructor TsBinaryOperationExprNode.Destroy;
|
|
begin
|
|
FreeAndNil(FLeft);
|
|
FreeAndNil(FRight);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TsBinaryOperationExprNode.Check;
|
|
begin
|
|
if not Assigned(Left) then
|
|
RaiseParserError(SErrNoLeftOperand,[classname]);
|
|
if not Assigned(Right) then
|
|
RaiseParserError(SErrNoRightOperand,[classname]);
|
|
end;
|
|
|
|
procedure TsBinaryOperationExprNode.CheckSameNodeTypes;
|
|
var
|
|
LT, RT: TsResultType;
|
|
begin
|
|
LT := Left.NodeType;
|
|
RT := Right.NodeType;
|
|
if (RT <> LT) then
|
|
RaiseParserError(SErrTypesDoNotMatch, [ResultTypeName(LT), ResultTypeName(RT), Left.AsString, Right.AsString])
|
|
end;
|
|
|
|
|
|
{ TsBooleanOperationExprNode }
|
|
|
|
procedure TsBooleanOperationExprNode.Check;
|
|
begin
|
|
inherited Check;
|
|
CheckNodeType(Left, [rtBoolean, rtCell, rtError, rtEmpty]);
|
|
CheckNodeType(Right, [rtBoolean, rtCell, rtError, rtEmpty]);
|
|
CheckSameNodeTypes;
|
|
end;
|
|
|
|
function TsBooleanOperationExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := Left.NodeType;
|
|
end;
|
|
|
|
|
|
{ TsConstExprNode }
|
|
|
|
constructor TsConstExprNode.CreateString(AValue: String);
|
|
begin
|
|
FValue.ResultType := rtString;
|
|
FValue.ResString := AValue;
|
|
end;
|
|
|
|
constructor TsConstExprNode.CreateInteger(AValue: Int64);
|
|
begin
|
|
FValue.ResultType := rtInteger;
|
|
FValue.ResInteger := AValue;
|
|
end;
|
|
|
|
constructor TsConstExprNode.CreateDateTime(AValue: TDateTime);
|
|
begin
|
|
FValue.ResultType := rtDateTime;
|
|
FValue.ResDateTime := AValue;
|
|
end;
|
|
|
|
constructor TsConstExprNode.CreateFloat(AValue: TsExprFloat);
|
|
begin
|
|
Inherited Create;
|
|
FValue.ResultType := rtFloat;
|
|
FValue.ResFloat := AValue;
|
|
end;
|
|
|
|
constructor TsConstExprNode.CreateBoolean(AValue: Boolean);
|
|
begin
|
|
FValue.ResultType := rtBoolean;
|
|
FValue.ResBoolean := AValue;
|
|
end;
|
|
|
|
constructor TsConstExprNode.CreateError(AValue: TsErrorValue);
|
|
begin
|
|
FValue.ResultType := rtError;
|
|
FValue.ResError := AValue;
|
|
end;
|
|
|
|
procedure TsConstExprNode.Check;
|
|
begin
|
|
// Nothing to check;
|
|
end;
|
|
|
|
function TsConstExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := FValue.ResultType;
|
|
end;
|
|
|
|
procedure TsConstExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TsConstExprNode.AsString: string;
|
|
begin
|
|
case NodeType of
|
|
rtString : Result := cDoubleQuote + FValue.ResString + cDoubleQuote;
|
|
rtInteger : Result := IntToStr(FValue.ResInteger);
|
|
rtDateTime : Result := '''' + FormatDateTime('cccc', FValue.ResDateTime) + ''''; // Probably wrong !!!
|
|
rtBoolean : if FValue.ResBoolean then Result := 'TRUE' else Result := 'FALSE';
|
|
rtFloat : Result := FloatToStr(FValue.ResFloat, ExprFormatSettings);
|
|
end;
|
|
end;
|
|
|
|
function TsConstExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
case NodeType of
|
|
rtString : Result := RPNString(FValue.ResString, ANext);
|
|
rtInteger : Result := RPNInteger(FValue.ResInteger, ANext);
|
|
rtDateTime : Result := RPNNumber(FValue.ResDateTime, ANext);
|
|
rtBoolean : Result := RPNBool(FValue.ResBoolean, ANext);
|
|
rtFloat : Result := RPNNumber(FValue.ResFloat, ANext);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TsUPlusExprNode }
|
|
|
|
function TsUPlusExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekUPlus,
|
|
Operand.AsRPNItem(
|
|
ANext
|
|
));
|
|
end;
|
|
|
|
function TsUPlusExprNode.AsString: String;
|
|
begin
|
|
Result := '+' + TrimLeft(Operand.AsString);
|
|
end;
|
|
|
|
procedure TsUPlusExprNode.Check;
|
|
const
|
|
AllowedTokens = [rtInteger, rtFloat, rtCell, rtEmpty, rtError];
|
|
begin
|
|
inherited;
|
|
if not (Operand.NodeType in AllowedTokens) then
|
|
RaiseParserError(SErrNoUPlus, [ResultTypeName(Operand.NodeType), Operand.AsString])
|
|
end;
|
|
|
|
procedure TsUPlusExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
res: TsExpressionresult;
|
|
cell: PCell;
|
|
begin
|
|
Operand.GetNodeValue(Result);
|
|
case Result.ResultType of
|
|
rtInteger, rtFloat, rtError:
|
|
exit;
|
|
rtCell:
|
|
begin
|
|
cell := ArgToCell(Result);
|
|
if cell = nil then
|
|
Result := FloatResult(0.0)
|
|
else
|
|
if cell^.ContentType = cctNumber then
|
|
begin
|
|
if frac(cell^.NumberValue) = 0.0 then
|
|
Result := IntegerResult(trunc(cell^.NumberValue))
|
|
else
|
|
Result := FloatResult(cell^.NumberValue);
|
|
end;
|
|
end;
|
|
rtEmpty:
|
|
Result := FloatResult(0.0);
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
end;
|
|
|
|
function TsUPlusExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := Operand.NodeType;
|
|
end;
|
|
|
|
|
|
{ TsUMinusExprNode }
|
|
|
|
function TsUMinusExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekUMinus,
|
|
Operand.AsRPNItem(
|
|
ANext
|
|
));
|
|
end;
|
|
|
|
function TsUMinusExprNode.AsString: String;
|
|
begin
|
|
Result := '-' + TrimLeft(Operand.AsString);
|
|
end;
|
|
|
|
procedure TsUMinusExprNode.Check;
|
|
const
|
|
AllowedTokens = [rtInteger, rtFloat, rtCell, rtEmpty, rtError];
|
|
begin
|
|
inherited;
|
|
if not (Operand.NodeType in AllowedTokens) then
|
|
RaiseParserError(SErrNoNegation, [ResultTypeName(Operand.NodeType), Operand.AsString])
|
|
end;
|
|
|
|
procedure TsUMinusExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Operand.GetNodeValue(Result);
|
|
case Result.ResultType of
|
|
rtError:
|
|
exit;
|
|
rtFloat:
|
|
Result := FloatResult(-Result.ResFloat);
|
|
rtInteger:
|
|
Result := IntegerResult(-Result.ResInteger);
|
|
rtCell:
|
|
begin
|
|
cell := ArgToCell(Result);
|
|
if (cell <> nil) and (cell^.ContentType = cctNumber) then
|
|
begin
|
|
if frac(cell^.NumberValue) = 0.0 then
|
|
Result := IntegerResult(-trunc(cell^.NumberValue))
|
|
else
|
|
Result := FloatResult(cell^.NumberValue);
|
|
end else
|
|
Result := FloatResult(0.0);
|
|
end;
|
|
rtEmpty:
|
|
Result := FloatResult(0.0);
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
end;
|
|
|
|
function TsUMinusExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := Operand.NodeType;
|
|
end;
|
|
|
|
|
|
{ TsPercentExprNode }
|
|
|
|
function TsPercentExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekPercent,
|
|
Operand.AsRPNItem(
|
|
ANext
|
|
));
|
|
end;
|
|
|
|
function TsPercentExprNode.AsString: String;
|
|
begin
|
|
Result := Operand.AsString + '%';
|
|
end;
|
|
|
|
procedure TsPercentExprNode.Check;
|
|
const
|
|
AllowedTokens = [rtInteger, rtFloat, rtCell, rtEmpty, rtError];
|
|
begin
|
|
inherited;
|
|
if not (Operand.NodeType in AllowedTokens) then
|
|
RaiseParserError(SErrNoPercentOperation, [ResultTypeName(Operand.NodeType), Operand.AsString])
|
|
end;
|
|
|
|
procedure TsPercentExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Operand.GetNodeValue(Result);
|
|
case Result.ResultType of
|
|
rtError:
|
|
exit;
|
|
rtFloat, rtInteger, rtCell:
|
|
Result := FloatResult(ArgToFloat(Result)*0.01);
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
end;
|
|
|
|
function TsPercentExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtFloat;
|
|
end;
|
|
|
|
|
|
{ TsParenthesisExprNode }
|
|
|
|
function TsParenthesisExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekParen,
|
|
Operand.AsRPNItem(
|
|
ANext
|
|
));
|
|
end;
|
|
|
|
function TsParenthesisExprNode.AsString: String;
|
|
begin
|
|
Result := '(' + Operand.AsString + ')';
|
|
end;
|
|
|
|
function TsParenthesisExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := Operand.NodeType;
|
|
end;
|
|
|
|
procedure TsParenthesisExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Result := Operand.NodeValue;
|
|
end;
|
|
|
|
|
|
{ TsNotExprNode }
|
|
|
|
function TsNotExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc('NOT',
|
|
Operand.AsRPNItem(
|
|
ANext
|
|
));
|
|
end;
|
|
|
|
function TsNotExprNode.AsString: String;
|
|
begin
|
|
Result := 'not ' + Operand.AsString;
|
|
end;
|
|
|
|
procedure TsNotExprNode.Check;
|
|
const
|
|
AllowedTokens = [rtBoolean, rtEmpty, rtError];
|
|
begin
|
|
if not (Operand.NodeType in AllowedTokens) then
|
|
RaiseParserError(SErrNoNotOperation, [ResultTypeName(Operand.NodeType), Operand.AsString])
|
|
end;
|
|
|
|
procedure TsNotExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Operand.GetNodeValue(Result);
|
|
case Result.ResultType of
|
|
rtBoolean : Result.ResBoolean := not Result.ResBoolean;
|
|
rtEmpty : Result := BooleanResult(true);
|
|
end
|
|
end;
|
|
|
|
function TsNotExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := Operand.NodeType;
|
|
end;
|
|
|
|
|
|
{ TsBooleanResultExprNode }
|
|
|
|
procedure TsBooleanResultExprNode.Check;
|
|
begin
|
|
inherited Check;
|
|
CheckSameNodeTypes;
|
|
end;
|
|
|
|
procedure TsBooleanResultExprNode.CheckSameNodeTypes;
|
|
begin
|
|
// Same node types are checked in GetNodevalue
|
|
end;
|
|
|
|
function TsBooleanResultExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtBoolean;
|
|
end;
|
|
|
|
|
|
{ TsEqualExprNode }
|
|
|
|
function TsEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekEqual,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsEqualExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '=' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
Right.GetNodeValue(RRes);
|
|
|
|
if (Result.ResultType in [rtInteger, rtFloat, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtInteger, rtFloat, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToFloat(Result) = ArgToFloat(RRes))
|
|
else
|
|
if (Result.ResultType in [rtString, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtString, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToString(Result) = ArgToString(RRes))
|
|
else
|
|
if (Result.ResultType in [rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtDateTime, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToDateTime(Result) = ArgToDateTime(RRes))
|
|
else
|
|
if (Result.ResultType in [rtBoolean, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtBoolean, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToBoolean(Result) = ArgToBoolean(RRes))
|
|
else
|
|
if (Result.ResultType = rtError)
|
|
then Result := ErrorResult(Result.ResError)
|
|
else
|
|
if (RRes.ResultType = rtError)
|
|
then Result := ErrorResult(RRes.ResError)
|
|
else
|
|
Result := BooleanResult(false);
|
|
end;
|
|
|
|
|
|
{ TsNotEqualExprNode }
|
|
|
|
function TsNotEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekNotEqual,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsNotEqualExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '<>' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsNotEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
inherited GetNodeValue(Result);
|
|
Result.ResBoolean := not Result.ResBoolean;
|
|
end;
|
|
|
|
|
|
{ TsOrderingExprNode }
|
|
|
|
procedure TsOrderingExprNode.Check;
|
|
const
|
|
AllowedTypes = [rtBoolean, rtInteger, rtFloat, rtDateTime, rtString, rtEmpty, rtError, rtCell];
|
|
begin
|
|
CheckNodeType(Left, AllowedTypes);
|
|
CheckNodeType(Right, AllowedTypes);
|
|
inherited Check;
|
|
end;
|
|
|
|
procedure TsOrderingExprNode.CheckSameNodeTypes;
|
|
var
|
|
LT, RT: TsResultType;
|
|
begin
|
|
{
|
|
LT := Left.NodeType;
|
|
RT := Right.NodeType;
|
|
case LT of
|
|
rtFloat, rtInteger:
|
|
if (RT in [rtFloat, rtInteger]) or
|
|
((Rt = rtCell) and (Right.Res
|
|
if (RT <> LT) then
|
|
RaiseParserError(SErrTypesDoNotMatch, [ResultTypeName(LT), ResultTypeName(RT), Left.AsString, Right.AsString])
|
|
}
|
|
end;
|
|
|
|
|
|
|
|
{ TsLessExprNode }
|
|
|
|
function TsLessExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekLess,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsLessExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '<' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsLessExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
Right.GetNodeValue(RRes);
|
|
if (Result.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToFloat(Result) < ArgToFloat(RRes))
|
|
else
|
|
if (Result.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToString(Result) < ArgToString(RRes))
|
|
else
|
|
if (Result.ResultType in [rtBoolean, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtBoolean, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ord(ArgToBoolean(Result)) < ord(ArgToBoolean(RRes)))
|
|
else
|
|
if (Result.ResultType = rtError)
|
|
then Result := ErrorResult(Result.ResError)
|
|
else
|
|
if (RRes.ResultType = rtError)
|
|
then Result := ErrorResult(RRes.ResError)
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
|
|
|
|
{ TsGreaterExprNode }
|
|
|
|
function TsGreaterExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekGreater,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsGreaterExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '>' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsGreaterExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
Right.GetNodeValue(RRes);
|
|
if (Result.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToFloat(Result) > ArgToFloat(RRes))
|
|
else
|
|
if (Result.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtString, rtInteger, rtFloat, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ArgToString(Result) > ArgToString(RRes))
|
|
else
|
|
if (Result.ResultType in [rtBoolean, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtBoolean, rtCell, rtEmpty])
|
|
then
|
|
Result := BooleanResult(ord(ArgToBoolean(Result)) > ord(ArgToBoolean(RRes)))
|
|
else
|
|
if (Result.ResultType = rtError)
|
|
then Result := ErrorResult(Result.ResError)
|
|
else
|
|
if (RRes.ResultType = rtError)
|
|
then Result := ErrorResult(RRes.ResError)
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
|
|
|
|
{ TsGreaterEqualExprNode }
|
|
|
|
function TsGreaterEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekGreaterEqual,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsGreaterEqualExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '>=' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsGreaterEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
inherited GetNodeValue(Result);
|
|
Result.ResBoolean := not Result.ResBoolean;
|
|
end;
|
|
|
|
|
|
{ TsLessEqualExprNode }
|
|
|
|
function TsLessEqualExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekLessEqual,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsLessEqualExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '<=' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsLessEqualExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
inherited GetNodeValue(Result);
|
|
Result.ResBoolean := not Result.ResBoolean;
|
|
end;
|
|
|
|
|
|
{ TsConcatExprNode }
|
|
|
|
function TsConcatExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekConcat,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
nil)));
|
|
end;
|
|
|
|
function TsConcatExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '&' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsConcatExprNode.Check;
|
|
begin
|
|
inherited Check;
|
|
CheckNodeType(Left, [rtString, rtCell, rtEmpty, rtError]);
|
|
CheckNodeType(Right, [rtString, rtCell, rtEmpty, rtError]);
|
|
end;
|
|
|
|
procedure TsConcatExprNode.CheckSameNodeTypes;
|
|
begin
|
|
// Same node types are checked in GetNodevalue
|
|
end;
|
|
|
|
procedure TsConcatExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes : TsExpressionResult;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
if (Result.ResultType = rtError)
|
|
then exit;
|
|
Right.GetNodeValue(RRes);
|
|
if (Result.ResultType in [rtString, rtCell]) and (RRes.ResultType in [rtString, rtCell])
|
|
then Result := StringResult(ArgToString(Result) + ArgToString(RRes))
|
|
else
|
|
if (RRes.ResultType = rtError)
|
|
then Result := ErrorResult(RRes.ResError)
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
|
|
function TsConcatExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtString;
|
|
end;
|
|
|
|
|
|
{ TsMathOperationExprNode }
|
|
|
|
procedure TsMathOperationExprNode.Check;
|
|
const
|
|
AllowedTypes = [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty, rtError];
|
|
begin
|
|
inherited Check;
|
|
CheckNodeType(Left, AllowedTypes);
|
|
CheckNodeType(Right, AllowedTypes);
|
|
CheckSameNodeTypes;
|
|
end;
|
|
|
|
procedure TsMathOperationExprNode.CheckSameNodeTypes;
|
|
begin
|
|
// Same node types are checked in GetNodevalue
|
|
end;
|
|
|
|
function TsMathOperationExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := Left.NodeType;
|
|
end;
|
|
|
|
|
|
{ TsAddExprNode }
|
|
|
|
function TsAddExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekAdd,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsAddExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '+' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsAddExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
if Result.ResultType = rtError then
|
|
exit;
|
|
|
|
Right.GetNodeValue(RRes);
|
|
if RRes.ResultType = rtError then
|
|
begin
|
|
Result := ErrorResult(RRes.ResError);
|
|
exit;
|
|
end;
|
|
|
|
if (Result.ResultType in [rtInteger, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtInteger, rtCell, rtEmpty])
|
|
then
|
|
Result := IntegerResult(ArgToInt(Result) + ArgToInt(RRes))
|
|
else
|
|
if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
|
|
then
|
|
Result := FloatResult(ArgToFloat(Result) + ArgToFloat(RRes));
|
|
end;
|
|
|
|
|
|
{ TsSubtractExprNode }
|
|
|
|
function TsSubtractExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekSub,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsSubtractExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '-' + Right.asString;
|
|
end;
|
|
|
|
procedure TsSubtractExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
if Result.ResultType = rtError then
|
|
exit;
|
|
|
|
Right.GetNodeValue(RRes);
|
|
if RRes.ResultType = rtError then
|
|
begin
|
|
Result := ErrorResult(RRes.ResError);
|
|
exit;
|
|
end;
|
|
|
|
if (Result.ResultType in [rtInteger, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtInteger, rtCell, rtEmpty])
|
|
then
|
|
Result := IntegerResult(ArgToInt(Result) - ArgToInt(RRes))
|
|
else
|
|
if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
|
|
then
|
|
Result := FloatResult(ArgToFloat(Result) - ArgToFloat(RRes));
|
|
end;
|
|
|
|
|
|
{ TsMultiplyExprNode }
|
|
|
|
function TsMultiplyExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekMul,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsMultiplyExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '*' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsMultiplyExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
if Result.ResultType = rtError then
|
|
exit;
|
|
|
|
Right.GetNodeValue(RRes);
|
|
if RRes.ResultType = rtError then
|
|
begin
|
|
Result := ErrorResult(RRes.ResError);
|
|
exit;
|
|
end;
|
|
|
|
if (Result.ResultType in [rtInteger, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtInteger, rtCell, rtEmpty])
|
|
then
|
|
Result := IntegerResult(ArgToInt(Result) * ArgToInt(RRes))
|
|
else
|
|
if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
|
|
then
|
|
Result := FloatResult(ArgToFloat(Result) * ArgToFloat(RRes));
|
|
end;
|
|
|
|
|
|
{ TsDivideExprNode }
|
|
|
|
function TsDivideExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekDiv,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsDivideExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '/' + Right.asString;
|
|
end;
|
|
|
|
procedure TsDivideExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
y: TsExprFloat;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
if Result.ResultType = rtError then
|
|
exit;
|
|
|
|
Right.GetNodeValue(RRes);
|
|
if RRes.ResultType = rtError then
|
|
begin
|
|
Result := ErrorResult(RRes.ResError);
|
|
exit;
|
|
end;
|
|
|
|
if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
|
|
then begin
|
|
y := ArgToFloat(RRes);
|
|
if y = 0.0 then
|
|
Result := ErrorResult(errDivideByZero)
|
|
else
|
|
Result := FloatResult(ArgToFloat(Result) / y);
|
|
end;
|
|
end;
|
|
|
|
function TsDivideExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtFLoat;
|
|
end;
|
|
|
|
|
|
{ TsPowerExprNode }
|
|
|
|
function TsPowerExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := RPNFunc(fekPower,
|
|
Right.AsRPNItem(
|
|
Left.AsRPNItem(
|
|
ANext
|
|
)));
|
|
end;
|
|
|
|
function TsPowerExprNode.AsString: string;
|
|
begin
|
|
Result := Left.AsString + '^' + Right.AsString;
|
|
end;
|
|
|
|
procedure TsPowerExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
RRes: TsExpressionResult;
|
|
ex: TsExprFloat;
|
|
begin
|
|
Left.GetNodeValue(Result);
|
|
if Result.ResultType = rtError then
|
|
exit;
|
|
|
|
Right.GetNodeValue(RRes);
|
|
if RRes.ResultType = rtError then
|
|
begin
|
|
Result := ErrorResult(RRes.ResError);
|
|
exit;
|
|
end;
|
|
|
|
if (Result.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty]) and
|
|
(RRes.ResultType in [rtFloat, rtInteger, rtDateTime, rtCell, rtEmpty])
|
|
then
|
|
try
|
|
Result := FloatResult(Power(ArgToFloat(Result), ArgToFloat(RRes)));
|
|
except
|
|
on E: EInvalidArgument do Result := ErrorResult(errOverflow);
|
|
end;
|
|
end;
|
|
|
|
function TsPowerExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtFloat;
|
|
end;
|
|
|
|
|
|
{ TsConvertExprNode }
|
|
|
|
function TsConvertExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
Result := Operand.AsRPNItem(ANext);
|
|
end;
|
|
|
|
function TsConvertExprNode.AsString: String;
|
|
begin
|
|
Result := Operand.AsString;
|
|
end;
|
|
|
|
|
|
{ TsIntToFloatExprNode }
|
|
|
|
procedure TsConvertToIntExprNode.Check;
|
|
begin
|
|
inherited Check;
|
|
CheckNodeType(Operand, [rtInteger, rtCell])
|
|
end;
|
|
|
|
procedure TsIntToFloatExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Operand.GetNodeValue(Result);
|
|
if Result.ResultType in [rtInteger, rtCell] then
|
|
Result := FloatResult(ArgToInt(Result));
|
|
end;
|
|
|
|
function TsIntToFloatExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtFloat;
|
|
end;
|
|
|
|
|
|
{ TsIntToDateTimeExprNode }
|
|
|
|
function TsIntToDateTimeExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtDatetime;
|
|
end;
|
|
|
|
procedure TsIntToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Operand.GetnodeValue(Result);
|
|
if Result.ResultType in [rtInteger, rtCell] then
|
|
Result := DateTimeResult(ArgToInt(Result));
|
|
end;
|
|
|
|
|
|
{ TsFloatToDateTimeExprNode }
|
|
|
|
procedure TsFloatToDateTimeExprNode.Check;
|
|
begin
|
|
inherited Check;
|
|
CheckNodeType(Operand, [rtFloat, rtCell]);
|
|
end;
|
|
|
|
function TsFloatToDateTimeExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtDateTime;
|
|
end;
|
|
|
|
procedure TsFloatToDateTimeExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Operand.GetNodeValue(Result);
|
|
if Result.ResultType in [rtFloat, rtCell] then
|
|
Result := DateTimeResult(ArgToFloat(Result));
|
|
end;
|
|
|
|
|
|
{ TsIdentifierExprNode }
|
|
|
|
constructor TsIdentifierExprNode.CreateIdentifier(AID: TsExprIdentifierDef);
|
|
begin
|
|
inherited Create;
|
|
FID := AID;
|
|
PResult := @FID.FValue;
|
|
FResultType := FID.ResultType;
|
|
end;
|
|
|
|
function TsIdentifierExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := FResultType;
|
|
end;
|
|
|
|
procedure TsIdentifierExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Result := PResult^;
|
|
Result.ResultType := FResultType;
|
|
end;
|
|
|
|
|
|
{ TsVariableExprNode }
|
|
|
|
procedure TsVariableExprNode.Check;
|
|
begin
|
|
// Do nothing;
|
|
end;
|
|
|
|
function TsVariableExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
RaiseParserError('Cannot handle variables for RPN, so far.');
|
|
end;
|
|
|
|
function TsVariableExprNode.AsString: string;
|
|
begin
|
|
Result := FID.Name;
|
|
end;
|
|
|
|
|
|
{ TsFunctionExprNode }
|
|
|
|
constructor TsFunctionExprNode.CreateFunction(AID: TsExprIdentifierDef;
|
|
const Args: TsExprArgumentArray);
|
|
begin
|
|
inherited CreateIdentifier(AID);
|
|
FArgumentNodes := Args;
|
|
SetLength(FArgumentParams, Length(Args));
|
|
end;
|
|
|
|
destructor TsFunctionExprNode.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to Length(FArgumentNodes)-1 do
|
|
FreeAndNil(FArgumentNodes[i]);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TsFunctionExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
var
|
|
i, n: Integer;
|
|
begin
|
|
if FID.HasFixedArgumentCount then
|
|
n := FID.ArgumentCount
|
|
else
|
|
n := Length(FArgumentNodes);
|
|
Result := ANext;
|
|
// for i:=Length(FArgumentNodes)-1 downto 0 do
|
|
for i:=0 to High(FArgumentNodes) do
|
|
Result := FArgumentNodes[i].AsRPNItem(Result);
|
|
Result := RPNFunc(FID.Name, n, Result);
|
|
end;
|
|
|
|
function TsFunctionExprNode.AsString: String;
|
|
var
|
|
S : String;
|
|
i : Integer;
|
|
begin
|
|
S := '';
|
|
for i := 0 to Length(FArgumentNodes)-1 do
|
|
begin
|
|
if (S <> '') then
|
|
S := S + ',';
|
|
S := S + FArgumentNodes[i].AsString;
|
|
end;
|
|
S := '(' + S + ')';
|
|
Result := FID.Name + S;
|
|
end;
|
|
|
|
procedure TsFunctionExprNode.CalcParams;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
for i := 0 to Length(FArgumentParams)-1 do
|
|
{
|
|
case FArgumentParams[i].ResultType of
|
|
rtEmpty: FID.FValue.ResultType := rtEmpty;
|
|
rtError: if FID.FValue.ResultType <> rtError then
|
|
begin
|
|
FID.FValue.ResultType := rtError;
|
|
FID.FValue.ResError := FArgumentParams[i].ResError;
|
|
end;
|
|
else FArgumentNodes[i].GetNodeValue(FArgumentParams[i]);
|
|
end;
|
|
}
|
|
FArgumentNodes[i].GetNodeValue(FArgumentParams[i]);
|
|
end;
|
|
|
|
procedure TsFunctionExprNode.Check;
|
|
var
|
|
i: Integer;
|
|
rta, // parameter types passed to the function
|
|
rtp: TsResultType; // Parameter types expected from the parameter symbol
|
|
lastrtp: TsResultType;
|
|
begin
|
|
if Length(FArgumentNodes) <> FID.ArgumentCount then
|
|
begin
|
|
for i:=Length(FArgumentNodes)+1 to FID.ArgumentCount do
|
|
if not FID.IsOptionalArgument(i) then
|
|
RaiseParserError(ErrInvalidArgumentCount, [FID.Name]);
|
|
end;
|
|
|
|
for i := 0 to Length(FArgumentNodes)-1 do
|
|
begin
|
|
rta := FArgumentNodes[i].NodeType;
|
|
|
|
// A "cell" can return any type --> no type conversion required here.
|
|
if rta = rtCell then
|
|
Continue;
|
|
|
|
if i+1 <= Length(FID.ParameterTypes) then
|
|
begin
|
|
rtp := CharToResultType(FID.ParameterTypes[i+1]);
|
|
lastrtp := rtp;
|
|
end else
|
|
rtp := lastrtp;
|
|
if rtp = rtAny then
|
|
Continue;
|
|
if (rtp <> rta) and not (rta in [rtCellRange, rtError, rtEmpty]) then
|
|
begin
|
|
// Automatically convert integers to floats in functions that return a float
|
|
if (rta = rtInteger) and (rtp = rtFloat) then
|
|
begin
|
|
FArgumentNodes[i] := TsIntToFloatExprNode(FArgumentNodes[i]);
|
|
exit;
|
|
end;
|
|
// Floats are truncated automatically to integers - that's what Excel does.
|
|
if (rta = rtFloat) and (rtp = rtInteger) then
|
|
exit;
|
|
RaiseParserError(SErrInvalidArgumentType, [i+1, ResultTypeName(rtp), ResultTypeName(rta)])
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TsFunctionCallBackExprNode }
|
|
|
|
constructor TsFunctionCallBackExprNode.CreateFunction(AID: TsExprIdentifierDef;
|
|
const Args: TsExprArgumentArray);
|
|
begin
|
|
inherited;
|
|
FCallBack := AID.OnGetFunctionValueCallBack;
|
|
end;
|
|
|
|
procedure TsFunctionCallBackExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Result.ResultType := NodeType; // was at end!
|
|
if Length(FArgumentParams) > 0 then
|
|
CalcParams;
|
|
FCallBack(Result, FArgumentParams);
|
|
end;
|
|
|
|
|
|
{ TFPFunctionEventHandlerExprNode }
|
|
|
|
constructor TFPFunctionEventHandlerExprNode.CreateFunction(AID: TsExprIdentifierDef;
|
|
const Args: TsExprArgumentArray);
|
|
begin
|
|
inherited;
|
|
FCallBack := AID.OnGetFunctionValue;
|
|
end;
|
|
|
|
procedure TFPFunctionEventHandlerExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
Result.ResultType := NodeType; // was at end
|
|
if Length(FArgumentParams) > 0 then
|
|
CalcParams;
|
|
FCallBack(Result, FArgumentParams);
|
|
end;
|
|
|
|
|
|
{ TsCellExprNode }
|
|
|
|
constructor TsCellExprNode.Create(AWorksheet: TsWorksheet; ACellString: String);
|
|
var
|
|
r, c: Cardinal;
|
|
flags: TsRelFlags;
|
|
begin
|
|
ParseCellString(ACellString, r, c, flags);
|
|
Create(AWorksheet, r, c, flags);
|
|
end;
|
|
|
|
constructor TsCellExprNode.Create(AWorksheet: TsWorksheet; ARow,ACol: Cardinal;
|
|
AFlags: TsRelFlags);
|
|
begin
|
|
FWorksheet := AWorksheet;
|
|
FRow := ARow;
|
|
FCol := ACol;
|
|
FFlags := AFlags;
|
|
FCell := AWorksheet.FindCell(FRow, FCol);
|
|
end;
|
|
|
|
function TsCellExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
if FIsRef then
|
|
Result := RPNCellRef(FRow, FCol, FFlags, ANext)
|
|
else
|
|
Result := RPNCellValue(FRow, FCol, FFlags, ANext);
|
|
end;
|
|
|
|
function TsCellExprNode.AsString: string;
|
|
begin
|
|
Result := GetCellString(FRow, FCol, FFlags);
|
|
end;
|
|
|
|
procedure TsCellExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
begin
|
|
if (FCell <> nil) and HasFormula(FCell) then
|
|
case FCell^.CalcState of
|
|
csNotCalculated:
|
|
Worksheet.CalcFormula(FCell);
|
|
csCalculating:
|
|
raise Exception.Create(SErrCircularReference);
|
|
end;
|
|
|
|
Result.ResultType := rtCell;
|
|
Result.ResRow := FRow;
|
|
Result.ResCol := FCol;
|
|
Result.Worksheet := FWorksheet;
|
|
end;
|
|
|
|
procedure TsCellExprNode.Check;
|
|
begin
|
|
// Nothing to check;
|
|
end;
|
|
|
|
function TsCellExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtCell;
|
|
{
|
|
if FIsRef then
|
|
Result := rtCell
|
|
else
|
|
begin
|
|
Result := rtEmpty;
|
|
if FCell <> nil then
|
|
case FCell^.ContentType of
|
|
cctNumber:
|
|
if frac(FCell^.NumberValue) = 0 then
|
|
Result := rtInteger
|
|
else
|
|
Result := rtFloat;
|
|
cctDateTime:
|
|
Result := rtDateTime;
|
|
cctUTF8String:
|
|
Result := rtString;
|
|
cctBool:
|
|
Result := rtBoolean;
|
|
cctError:
|
|
Result := rtError;
|
|
end;
|
|
end;
|
|
}
|
|
end;
|
|
|
|
|
|
{ TsCellRangeExprNode }
|
|
|
|
constructor TsCellRangeExprNode.Create(AWorksheet: TsWorksheet; ACellRangeString: String);
|
|
var
|
|
r1, c1, r2, c2: Cardinal;
|
|
flags: TsRelFlags;
|
|
begin
|
|
if pos(':', ACellRangeString) = 0 then
|
|
begin
|
|
ParseCellString(ACellRangeString, r1, c1, flags);
|
|
if rfRelRow in flags then Include(flags, rfRelRow2);
|
|
if rfRelCol in flags then Include(flags, rfRelCol2);
|
|
Create(AWorksheet, r1, c1, r1, c1, flags);
|
|
end else
|
|
begin
|
|
ParseCellRangeString(ACellRangeString, r1, c1, r2, c2, flags);
|
|
Create(AWorksheet, r1, c1, r2, c2, flags);
|
|
end;
|
|
end;
|
|
|
|
constructor TsCellRangeExprNode.Create(AWorksheet: TsWorksheet;
|
|
ARow1,ACol1,ARow2,ACol2: Cardinal; AFlags: TsRelFlags);
|
|
begin
|
|
FWorksheet := AWorksheet;
|
|
FRow1 := ARow1;
|
|
FCol1 := ACol1;
|
|
FRow2 := ARow2;
|
|
FCol2 := ACol2;
|
|
FFlags := AFlags;
|
|
end;
|
|
|
|
function TsCellRangeExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
|
|
begin
|
|
{
|
|
if (FRow1 = FRow2) and (FCol1 = FCol2) then
|
|
Result := RPNCellRef(FRow1, FCol1, FFlags, ANext)
|
|
else
|
|
}
|
|
Result := RPNCellRange(FRow1, FCol1, FRow2, FCol2, FFlags, ANext);
|
|
end;
|
|
|
|
function TsCellRangeExprNode.AsString: string;
|
|
begin
|
|
if (FRow1 = FRow2) and (FCol1 = FCol2) then
|
|
Result := GetCellString(FRow1, FCol1, FFlags)
|
|
else
|
|
Result := GetCellRangeString(FRow1, FCol1, FRow2, FCol2, FFlags);
|
|
end;
|
|
|
|
procedure TsCellRangeExprNode.Check;
|
|
begin
|
|
// Nothing to check;
|
|
end;
|
|
|
|
procedure TsCellRangeExprNode.GetNodeValue(var Result: TsExpressionResult);
|
|
var
|
|
r,c: Cardinal;
|
|
cell: PCell;
|
|
begin
|
|
for r := FRow1 to FRow2 do
|
|
for c := FCol1 to FCol2 do
|
|
begin
|
|
cell := FWorksheet.FindCell(r, c);
|
|
if HasFormula(cell) then
|
|
case cell^.CalcState of
|
|
csNotCalculated: FWorksheet.CalcFormula(cell);
|
|
csCalculating : raise Exception.Create(SErrCircularReference);
|
|
end;
|
|
end;
|
|
|
|
Result.ResultType := rtCellRange;
|
|
Result.ResCellRange.Row1 := FRow1;
|
|
Result.ResCellRange.Col1 := FCol1;
|
|
Result.ResCellRange.Row2 := FRow2;
|
|
Result.ResCellRange.Col2 := FCol2;
|
|
Result.Worksheet := FWorksheet;
|
|
end;
|
|
|
|
function TsCellRangeExprNode.NodeType: TsResultType;
|
|
begin
|
|
Result := rtCellRange;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Conversion of arguments to simple data types }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
function ArgToBoolean(Arg: TsExpressionResult): Boolean;
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := false;
|
|
if Arg.ResultType = rtBoolean then
|
|
Result := Arg.ResBoolean
|
|
else
|
|
if (Arg.ResultType = rtCell) then begin
|
|
cell := ArgToCell(Arg);
|
|
if (cell <> nil) and (cell^.ContentType = cctBool) then
|
|
Result := cell^.BoolValue;
|
|
end;
|
|
end;
|
|
|
|
function ArgToCell(Arg: TsExpressionResult): PCell;
|
|
begin
|
|
if Arg.ResultType = rtCell then
|
|
Result := Arg.Worksheet.FindCell(Arg.ResRow, Arg.ResCol)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function ArgToInt(Arg: TsExpressionResult): Integer;
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := 0;
|
|
if Arg.ResultType = rtInteger then
|
|
result := Arg.ResInteger
|
|
else
|
|
if Arg.ResultType = rtFloat then
|
|
result := trunc(Arg.ResFloat)
|
|
else
|
|
if Arg.ResultType = rtDateTime then
|
|
result := trunc(Arg.ResDateTime)
|
|
else
|
|
if (Arg.ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Arg);
|
|
if Assigned(cell) and (cell^.ContentType = cctNumber) then
|
|
result := trunc(cell^.NumberValue);
|
|
end;
|
|
end;
|
|
|
|
function ArgToFloat(Arg: TsExpressionResult): TsExprFloat;
|
|
// Utility function for the built-in math functions. Accepts also integers
|
|
// in place of the floating point arguments. To be called in builtins or
|
|
// user-defined callbacks having float results.
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := 0.0;
|
|
if Arg.ResultType = rtInteger then
|
|
result := Arg.ResInteger
|
|
else
|
|
if Arg.ResultType = rtDateTime then
|
|
result := Arg.ResDateTime
|
|
else
|
|
if Arg.ResultType = rtFloat then
|
|
result := Arg.ResFloat
|
|
else
|
|
if (Arg.ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Arg);
|
|
if Assigned(cell) then
|
|
case cell^.ContentType of
|
|
cctNumber : Result := cell^.NumberValue;
|
|
cctDateTime : Result := cell^.DateTimeValue;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ArgToDateTime(Arg: TsExpressionResult): TDateTime;
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := 0.0;
|
|
if Arg.ResultType = rtDateTime then
|
|
result := Arg.ResDateTime
|
|
else
|
|
if Arg.ResultType = rtInteger then
|
|
Result := Arg.ResInteger
|
|
else
|
|
if Arg.ResultType = rtFloat then
|
|
Result := Arg.ResFloat
|
|
else
|
|
if (Arg.ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Arg);
|
|
if Assigned(cell) and (cell^.ContentType = cctDateTime) then
|
|
Result := cell^.DateTimeValue;
|
|
end;
|
|
end;
|
|
|
|
function ArgToString(Arg: TsExpressionResult): String;
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := '';
|
|
case Arg.ResultType of
|
|
rtString : result := Arg.ResString;
|
|
rtInteger : Result := IntToStr(Arg.ResInteger);
|
|
rtFloat : Result := FloatToStr(Arg.ResFloat);
|
|
rtCell : begin
|
|
cell := ArgToCell(Arg);
|
|
if Assigned(cell) and (cell^.ContentType = cctUTF8String) then
|
|
Result := cell^.UTF8Stringvalue;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Conversion simple data types to ExpressionResults }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
function BooleanResult(AValue: Boolean): TsExpressionResult;
|
|
begin
|
|
Result.ResultType := rtBoolean;
|
|
Result.ResBoolean := AValue;
|
|
end;
|
|
|
|
function DateTimeResult(AValue: TDateTime): TsExpressionResult;
|
|
begin
|
|
Result.ResultType := rtDateTime;
|
|
Result.ResDateTime := AValue;
|
|
end;
|
|
|
|
function EmptyResult: TsExpressionResult;
|
|
begin
|
|
Result.ResultType := rtEmpty;
|
|
end;
|
|
|
|
function ErrorResult(const AValue: TsErrorValue): TsExpressionResult;
|
|
begin
|
|
Result.ResultType := rtError;
|
|
Result.ResError := AValue;
|
|
end;
|
|
|
|
function FloatResult(const AValue: TsExprFloat): TsExpressionResult;
|
|
begin
|
|
Result.ResultType := rtFloat;
|
|
Result.ResFloat := AValue;
|
|
end;
|
|
|
|
function IntegerResult(const AValue: Integer): TsExpressionResult;
|
|
begin
|
|
Result.ResultType := rtInteger;
|
|
Result.ResInteger := AValue;
|
|
end;
|
|
|
|
function StringResult(const AValue: string): TsExpressionResult;
|
|
begin
|
|
Result.ResultType := rtString;
|
|
Result.ResString := AValue;
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Standard Builtins support }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
// Builtin math functions
|
|
|
|
procedure fpsABS(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(abs(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsACOS(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if InRange(x, -1, +1) then
|
|
Result := FloatResult(arccos(x))
|
|
else
|
|
Result := ErrorResult(errOverflow); // #NUM!
|
|
end;
|
|
|
|
procedure fpsACOSH(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if x >= 1 then
|
|
Result := FloatResult(arccosh(ArgToFloat(Args[0])))
|
|
else
|
|
Result := ErrorResult(errOverflow);
|
|
end;
|
|
|
|
procedure fpsASIN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if InRange(x, -1, +1) then
|
|
Result := FloatResult(arcsin(ArgToFloat(Args[0])))
|
|
else
|
|
Result := ErrorResult(errOverflow);
|
|
end;
|
|
|
|
procedure fpsASINH(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(arcsinh(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsATAN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(arctan(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsATANH(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if (x > -1) and (x < +1) then
|
|
Result := FloatResult(arctanh(ArgToFloat(Args[0])))
|
|
else
|
|
Result := ErrorResult(errOverflow); // #NUM!
|
|
end;
|
|
|
|
procedure fpsCOS(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(cos(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsCOSH(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(cosh(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsDEGREES(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(RadToDeg(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsEXP(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(exp(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsINT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(floor(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsLN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if x > 0 then
|
|
Result := FloatResult(ln(x))
|
|
else
|
|
Result := ErrorResult(errOverflow); // #NUM!
|
|
end;
|
|
|
|
procedure fpsLOG(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// LOG( number [, base] ) - base is 10 if omitted.
|
|
var
|
|
x: TsExprFloat;
|
|
base: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if x <= 0 then begin
|
|
Result := ErrorResult(errOverflow); // #NUM!
|
|
exit;
|
|
end;
|
|
|
|
if Length(Args) = 2 then begin
|
|
base := ArgToFloat(Args[1]);
|
|
if base < 0 then begin
|
|
Result := ErrorResult(errOverflow); // #NUM!
|
|
exit;
|
|
end;
|
|
end else
|
|
base := 10;
|
|
|
|
Result := FloatResult(logn(base, x));
|
|
end;
|
|
|
|
procedure fpsLOG10(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if x > 0 then
|
|
Result := FloatResult(log10(x))
|
|
else
|
|
Result := ErrorResult(errOverflow); // #NUM!
|
|
end;
|
|
|
|
procedure fpsPI(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Unused(Args);
|
|
Result := FloatResult(pi);
|
|
end;
|
|
|
|
procedure fpsPOWER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
try
|
|
Result := FloatResult(Power(ArgToFloat(Args[0]), ArgToFloat(Args[1])));
|
|
except
|
|
Result := ErrorResult(errOverflow);
|
|
end;
|
|
end;
|
|
|
|
procedure fpsRADIANS(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(DegToRad(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsRAND(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Unused(Args);
|
|
Result := FloatResult(random);
|
|
end;
|
|
|
|
procedure fpsROUND(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
n: Integer;
|
|
begin
|
|
if Args[1].ResultType = rtInteger then
|
|
n := Args[1].ResInteger
|
|
else
|
|
n := round(Args[1].ResFloat);
|
|
Result := FloatResult(RoundTo(ArgToFloat(Args[0]), n));
|
|
end;
|
|
|
|
procedure fpsSIGN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(sign(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsSIN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(sin(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsSINH(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(sinh(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsSQRT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if x >= 0 then
|
|
Result := FloatResult(sqrt(x))
|
|
else
|
|
Result := ErrorResult(errOverflow);
|
|
end;
|
|
|
|
procedure fpsTAN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
var
|
|
x: TsExprFloat;
|
|
begin
|
|
x := ArgToFloat(Args[0]);
|
|
if frac(x / (pi*0.5)) = 0 then
|
|
Result := ErrorResult(errOverflow) // #NUM!
|
|
else
|
|
Result := FloatResult(tan(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
procedure fpsTANH(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result := FloatResult(tanh(ArgToFloat(Args[0])));
|
|
end;
|
|
|
|
|
|
// Builtin date/time functions
|
|
|
|
procedure fpsDATE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// DATE( year, month, day )
|
|
begin
|
|
Result := DateTimeResult(
|
|
EncodeDate(ArgToInt(Args[0]), ArgToInt(Args[1]), ArgToInt(Args[2]))
|
|
);
|
|
end;
|
|
|
|
procedure fpsDATEDIF(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
{ DATEDIF( start_date, end_date, interval )
|
|
start_date <= end_date !
|
|
interval = Y - The number of complete years.
|
|
= M - The number of complete months.
|
|
= D - The number of days.
|
|
= MD - The difference between the days (months and years are ignored).
|
|
= YM - The difference between the months (days and years are ignored).
|
|
= YD - The difference between the days (years and dates are ignored). }
|
|
var
|
|
interval: String;
|
|
start_date, end_date: TDate;
|
|
begin
|
|
start_date := ArgToDateTime(Args[0]);
|
|
end_date := ArgToDateTime(Args[1]);
|
|
interval := ArgToString(Args[2]);
|
|
|
|
if end_date > start_date then
|
|
Result := ErrorResult(errOverflow)
|
|
else if interval = 'Y' then
|
|
Result := FloatResult(YearsBetween(end_date, start_date))
|
|
else if interval = 'M' then
|
|
Result := FloatResult(MonthsBetween(end_date, start_date))
|
|
else if interval = 'D' then
|
|
Result := FloatResult(DaysBetween(end_date, start_date))
|
|
else
|
|
Result := ErrorResult(errFormulaNotSupported);
|
|
end;
|
|
|
|
procedure fpsDATEVALUE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the serial number of a date. Input is a string.
|
|
// DATE( date_string )
|
|
var
|
|
d: TDateTime;
|
|
begin
|
|
if TryStrToDate(Args[0].ResString, d) then
|
|
Result := DateTimeResult(d)
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
|
|
procedure fpsDAY(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// DAY( date_value )
|
|
// date_value can be a serial number or a string
|
|
var
|
|
y,m,d: Word;
|
|
dt: TDateTime;
|
|
begin
|
|
if (Args[0].ResultType in [rtDateTime, rtFloat, rtInteger]) then
|
|
DecodeDate(ArgToFloat(Args[0]), y,m,d)
|
|
else
|
|
if Args[0].ResultType in [rtString] then
|
|
begin
|
|
if TryStrToDate(Args[0].ResString, dt) then
|
|
DecodeDate(dt, y,m,d)
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := IntegerResult(d);
|
|
end;
|
|
|
|
procedure fpsHOUR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// HOUR( time_value )
|
|
// time_value can be a number or a string.
|
|
var
|
|
h, m, s, ms: Word;
|
|
t: double;
|
|
begin
|
|
if (Args[0].ResultType in [rtDateTime, rtFloat, rtInteger]) then
|
|
DecodeTime(ArgToFloat(Args[0]), h,m,s,ms)
|
|
else
|
|
if (Args[0].ResultType in [rtString]) then
|
|
begin
|
|
if TryStrToTime(Args[0].ResString, t) then
|
|
DecodeTime(t, h,m,s,ms)
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := IntegerResult(h);
|
|
end;
|
|
|
|
procedure fpsMINUTE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// MINUTE( serial_number or string )
|
|
var
|
|
h, m, s, ms: Word;
|
|
t: double;
|
|
begin
|
|
if (Args[0].resultType in [rtDateTime, rtFloat, rtInteger]) then
|
|
DecodeTime(ArgToFloat(Args[0]), h,m,s,ms)
|
|
else
|
|
if (Args[0].ResultType in [rtString]) then
|
|
begin
|
|
if TryStrToTime(Args[0].ResString, t) then
|
|
DecodeTime(t, h,m,s,ms)
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := IntegerResult(m);
|
|
end;
|
|
|
|
procedure fpsMONTH(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// MONTH( date_value or string )
|
|
var
|
|
y,m,d: Word;
|
|
dt: TDateTime;
|
|
begin
|
|
if (Args[0].ResultType in [rtDateTime, rtFloat, rtInteger]) then
|
|
DecodeDate(ArgToFloat(Args[0]), y,m,d)
|
|
else
|
|
if (Args[0].ResultType in [rtString]) then
|
|
begin
|
|
if TryStrToDate(Args[0].ResString, dt) then
|
|
DecodeDate(dt, y,m,d)
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := IntegerResult(m);
|
|
end;
|
|
|
|
procedure fpsNOW(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the current system date and time. Willrefresh the date/time value
|
|
// whenever the worksheet recalculates.
|
|
// NOW()
|
|
begin
|
|
Result := DateTimeResult(Now);
|
|
end;
|
|
|
|
procedure fpsSECOND(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// SECOND( serial_number )
|
|
var
|
|
h, m, s, ms: Word;
|
|
t: Double;
|
|
begin
|
|
if (Args[0].ResultType in [rtDateTime, rtFloat, rtInteger]) then
|
|
DecodeTime(ArgToFloat(Args[0]), h,m,s,ms)
|
|
else
|
|
if (Args[0].ResultType in [rtString]) then
|
|
begin
|
|
if TryStrToTime(Args[0].ResString, t) then
|
|
DecodeTime(t, h,m,s,ms)
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := IntegerResult(s);
|
|
end;
|
|
|
|
procedure fpsTIME(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// TIME( hour, minute, second)
|
|
begin
|
|
Result := DateTimeResult(
|
|
EncodeTime(ArgToInt(Args[0]), ArgToInt(Args[1]), ArgToInt(Args[2]), 0)
|
|
);
|
|
end;
|
|
|
|
procedure fpsTIMEVALUE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the serial number of a time. Input must be a string.
|
|
// DATE( date_string )
|
|
var
|
|
t: TDateTime;
|
|
begin
|
|
if TryStrToTime(Args[0].ResString, t) then
|
|
Result := DateTimeResult(t)
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
|
|
procedure fpsTODAY(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the current system date. This function will refresh the date
|
|
// whenever the worksheet recalculates.
|
|
// TODAY()
|
|
begin
|
|
Result := DateTimeResult(Date);
|
|
end;
|
|
|
|
procedure fpsWEEKDAY(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
{ WEEKDAY( serial_number, [return_value] )
|
|
return_value = 1 - Returns a number from 1 (Sunday) to 7 (Saturday) (default)
|
|
= 2 - Returns a number from 1 (Monday) to 7 (Sunday).
|
|
= 3 - Returns a number from 0 (Monday) to 6 (Sunday). }
|
|
var
|
|
n: Integer;
|
|
dow: Integer;
|
|
dt: TDateTime;
|
|
begin
|
|
if Length(Args) = 2 then
|
|
n := ArgToInt(Args[1])
|
|
else
|
|
n := 1;
|
|
if Args[0].ResultType in [rtDateTime, rtFloat, rtInteger] then
|
|
dt := ArgToDateTime(Args[0])
|
|
else
|
|
if Args[0].ResultType in [rtString] then
|
|
if not TryStrToDate(Args[0].ResString, dt) then
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
dow := DayOfWeek(dt); // Sunday = 1 ... Saturday = 7
|
|
case n of
|
|
1: ;
|
|
2: if dow > 1 then dow := dow - 1 else dow := 7;
|
|
3: if dow > 1 then dow := dow - 2 else dow := 6;
|
|
end;
|
|
Result := IntegerResult(dow);
|
|
end;
|
|
|
|
procedure fpsYEAR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// YEAR( date_value )
|
|
var
|
|
y,m,d: Word;
|
|
dt: TDateTime;
|
|
begin
|
|
if Args[0].ResultType in [rtDateTime, rtFloat, rtInteger] then
|
|
DecodeDate(ArgToFloat(Args[0]), y,m,d)
|
|
else
|
|
if Args[0].ResultType in [rtString] then
|
|
begin
|
|
if TryStrToDate(Args[0].ResString, dt) then
|
|
DecodeDate(dt, y,m,d)
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := IntegerResult(y);
|
|
end;
|
|
|
|
|
|
// Builtin string functions
|
|
|
|
procedure fpsCHAR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// CHAR( ascii_value )
|
|
// returns the character based on the ASCII value
|
|
var
|
|
arg: Integer;
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
case Args[0].ResultType of
|
|
rtInteger, rtFloat:
|
|
if Args[0].ResultType in [rtInteger, rtFloat] then
|
|
begin
|
|
arg := ArgToInt(Args[0]);
|
|
if (arg >= 0) and (arg < 256) then
|
|
Result := StringResult(AnsiToUTF8(Char(arg)));
|
|
end;
|
|
rtError:
|
|
Result := ErrorResult(Args[0].ResError);
|
|
rtEmpty:
|
|
Result.ResultType := rtEmpty;
|
|
end;
|
|
end;
|
|
|
|
procedure fpsCODE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// CODE( text )
|
|
// returns the ASCII value of a character or the first character in a string.
|
|
var
|
|
s: String;
|
|
ch: Char;
|
|
begin
|
|
s := ArgToString(Args[0]);
|
|
if s = '' then
|
|
Result := ErrorResult(errWrongType)
|
|
else
|
|
begin
|
|
ch := UTF8ToAnsi(s)[1];
|
|
Result := IntegerResult(ord(ch));
|
|
end;
|
|
end;
|
|
|
|
procedure fpsCONCATENATE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// CONCATENATE( text1, text2, ... text_n )
|
|
// Joins two or more strings together
|
|
var
|
|
s: String;
|
|
i: Integer;
|
|
begin
|
|
s := '';
|
|
for i:=0 to Length(Args)-1 do
|
|
begin
|
|
if Args[i].ResultType = rtError then
|
|
begin
|
|
Result := ErrorResult(Args[i].ResError);
|
|
exit;
|
|
end;
|
|
s := s + ArgToString(Args[i]);
|
|
end;
|
|
Result := StringResult(s);
|
|
end;
|
|
|
|
procedure fpsLEFT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// LEFT( text, [number_of_characters] )
|
|
// extracts a substring from a string, starting from the left-most character
|
|
var
|
|
s: String;
|
|
count: Integer;
|
|
begin
|
|
s := Args[0].ResString;
|
|
if s = '' then
|
|
Result.ResultType := rtEmpty
|
|
else
|
|
begin
|
|
if Length(Args) = 1 then
|
|
count := 1
|
|
else
|
|
if Args[1].ResultType in [rtInteger, rtFloat] then
|
|
count := ArgToInt(Args[1])
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
Result := StringResult(UTF8LeftStr(s, count));
|
|
end;
|
|
end;
|
|
|
|
procedure fpsLEN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// LEN( text )
|
|
// returns the length of the specified string.
|
|
begin
|
|
Result := IntegerResult(UTF8Length(Args[0].ResString));
|
|
end;
|
|
|
|
procedure fpsLOWER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// LOWER( text )
|
|
// converts all letters in the specified string to lowercase. If there are
|
|
// characters in the string that are not letters, they are not affected.
|
|
begin
|
|
Result := StringResult(UTF8Lowercase(Args[0].ResString));
|
|
end;
|
|
|
|
procedure fpsMID(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// MID( text, start_position, number_of_characters )
|
|
// extracts a substring from a string (starting at any position).
|
|
begin
|
|
Result := StringResult(UTF8Copy(Args[0].ResString, ArgToInt(Args[1]), ArgToInt(Args[2])));
|
|
end;
|
|
|
|
procedure fpsREPLACE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// REPLACE( old_text, start, number_of_chars, new_text )
|
|
// replaces a sequence of characters in a string with another set of characters
|
|
var
|
|
sOld, sNew, s1, s2: String;
|
|
start: Integer;
|
|
count: Integer;
|
|
begin
|
|
sOld := Args[0].ResString;
|
|
start := ArgToInt(Args[1]);
|
|
count := ArgToInt(Args[2]);
|
|
sNew := Args[3].ResString;
|
|
s1 := UTF8Copy(sOld, 1, start-1);
|
|
s2 := UTF8Copy(sOld, start+count, UTF8Length(sOld));
|
|
Result := StringResult(s1 + sNew + s2);
|
|
end;
|
|
|
|
procedure fpsRIGHT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// RIGHT( text, [number_of_characters] )
|
|
// extracts a substring from a string, starting from the last character
|
|
var
|
|
s: String;
|
|
count: Integer;
|
|
begin
|
|
s := Args[0].ResString;
|
|
if s = '' then
|
|
Result.ResultType := rtEmpty
|
|
else begin
|
|
if Length(Args) = 1 then
|
|
count := 1
|
|
else
|
|
if Args[1].ResultType in [rtInteger, rtFloat] then
|
|
count := ArgToInt(Args[1])
|
|
else
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
Result := StringResult(UTF8RightStr(s, count));
|
|
end;
|
|
end;
|
|
|
|
procedure fpsSUBSTITUTE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// SUBSTITUTE( text, old_text, new_text, [nth_appearance] )
|
|
// replaces a set of characters with another.
|
|
var
|
|
sOld: String;
|
|
sNew: String;
|
|
s1, s2: String;
|
|
n: Integer;
|
|
s: String;
|
|
p: Integer;
|
|
begin
|
|
s := Args[0].ResString;
|
|
sOld := ArgToString(Args[1]);
|
|
sNew := ArgToString(Args[2]);
|
|
if Length(Args) = 4 then
|
|
begin
|
|
n := ArgToInt(Args[3]); // THIS PART NOT YET CHECKED !!!!!!
|
|
if n <= 0 then
|
|
begin
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
p := UTF8Pos(sOld, s);
|
|
while (n > 1) do begin
|
|
p := UTF8Pos(sOld, s, p+1);
|
|
dec(n);
|
|
end;
|
|
if p > 0 then begin
|
|
s1 := UTF8Copy(s, 1, p-1);
|
|
s2 := UTF8Copy(s, p+UTF8Length(sOld), UTF8Length(s));
|
|
s := s1 + sNew + s2;
|
|
end;
|
|
Result := StringResult(s);
|
|
end else
|
|
Result := StringResult(UTF8StringReplace(s, sOld, sNew, [rfReplaceAll]));
|
|
end;
|
|
|
|
procedure fpsTRIM(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// TRIM( text )
|
|
// returns a text value with the leading and trailing spaces removed
|
|
begin
|
|
Result := StringResult(UTF8Trim(Args[0].ResString));
|
|
end;
|
|
|
|
procedure fpsUPPER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// UPPER( text )
|
|
// converts all letters in the specified string to uppercase. If there are
|
|
// characters in the string that are not letters, they are not affected.
|
|
begin
|
|
Result := StringResult(UTF8Uppercase(Args[0].ResString));
|
|
end;
|
|
|
|
procedure fpsVALUE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// VALUE( text )
|
|
// converts a text value that represents a number to a number.
|
|
var
|
|
x: Double;
|
|
n: Integer;
|
|
s: String;
|
|
begin
|
|
s := ArgToString(Args[0]);
|
|
if TryStrToInt(s, n) then
|
|
Result := IntegerResult(n)
|
|
else
|
|
if TryStrToFloat(s, x, ExprFormatSettings) then
|
|
Result := FloatResult(x)
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
|
|
|
|
{ Builtin logical functions }
|
|
|
|
procedure fpsAND(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// AND( condition1, [condition2], ... )
|
|
// up to 30 parameters. At least 1 parameter.
|
|
var
|
|
i: Integer;
|
|
b: Boolean;
|
|
begin
|
|
b := true;
|
|
for i:=0 to High(Args) do
|
|
b := b and Args[i].ResBoolean;
|
|
Result.ResBoolean := b;
|
|
end;
|
|
|
|
procedure fpsFALSE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// FALSE ()
|
|
begin
|
|
Unused(Args);
|
|
Result.ResBoolean := false;
|
|
end;
|
|
|
|
procedure fpsIF(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// IF( condition, value_if_true, [value_if_false] )
|
|
begin
|
|
if Length(Args) > 2 then
|
|
begin
|
|
if Args[0].ResBoolean then
|
|
Result := Args[1]
|
|
else
|
|
Result := Args[2];
|
|
end else
|
|
begin
|
|
if Args[0].ResBoolean then
|
|
Result := Args[1]
|
|
else
|
|
Result.ResBoolean := false;
|
|
end;
|
|
end;
|
|
|
|
procedure fpsNOT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// NOT( condition )
|
|
begin
|
|
Result.ResBoolean := not Args[0].ResBoolean;
|
|
end;
|
|
|
|
procedure fpsOR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// OR( condition1, [condition2], ... )
|
|
// up to 30 parameters. At least 1 parameter.
|
|
var
|
|
i: Integer;
|
|
b: Boolean;
|
|
begin
|
|
b := false;
|
|
for i:=0 to High(Args) do
|
|
b := b or Args[i].ResBoolean;
|
|
Result.ResBoolean := b;
|
|
end;
|
|
|
|
procedure fpsTRUE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// TRUE()
|
|
begin
|
|
Unused(Args);
|
|
Result.ResBoolean := true;
|
|
end;
|
|
|
|
|
|
{ Builtin statistical functions }
|
|
|
|
procedure ArgsToFloatArray(const Args: TsExprParameterArray; out AData: TsExprFloatArray);
|
|
const
|
|
BLOCKSIZE = 128;
|
|
var
|
|
i, n: Integer;
|
|
r, c: Cardinal;
|
|
cell: PCell;
|
|
arg: TsExpressionResult;
|
|
begin
|
|
SetLength(AData, BLOCKSIZE);
|
|
n := 0;
|
|
for i:=0 to High(Args) do
|
|
begin
|
|
arg := Args[i];
|
|
if arg.ResultType = rtCellRange then
|
|
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
|
|
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
|
|
begin
|
|
cell := arg.Worksheet.FindCell(r, c);
|
|
if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
|
|
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
|
|
else
|
|
if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell]) then
|
|
begin
|
|
AData[n] := ArgToFloat(arg);
|
|
inc(n);
|
|
if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
|
|
end;
|
|
end;
|
|
SetLength(AData, n);
|
|
end;
|
|
|
|
|
|
procedure fpsAVEDEV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Average value of absolute deviations of data from their mean.
|
|
// AVEDEV( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
m: TsExprFloat;
|
|
i: Integer;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
m := Mean(data);
|
|
for i:=0 to High(data) do // replace data by their average deviation from the mean
|
|
data[i] := abs(data[i] - m);
|
|
Result.ResFloat := Mean(data);
|
|
end;
|
|
|
|
procedure fpsAVERAGE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// AVERAGE( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
Result.ResFloat := Mean(data);
|
|
end;
|
|
|
|
procedure fpsCOUNT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
{ counts the number of cells that contain numbers as well as the number of
|
|
arguments that contain numbers.
|
|
COUNT( value1, [value2, ... value_n] ) }
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
Result.ResInteger := Length(data);
|
|
end;
|
|
|
|
procedure fpsCOUNTA(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Counts the number of cells that are not empty as well as the number of
|
|
// arguments that contain values
|
|
// COUNTA( value1, [value2, ... value_n] )
|
|
var
|
|
i, n: Integer;
|
|
r, c: Cardinal;
|
|
cell: PCell;
|
|
arg: TsExpressionResult;
|
|
begin
|
|
n := 0;
|
|
for i:=0 to High(Args) do
|
|
begin
|
|
arg := Args[i];
|
|
case arg.ResultType of
|
|
rtInteger, rtFloat, rtDateTime, rtBoolean:
|
|
inc(n);
|
|
rtString:
|
|
if arg.ResString <> '' then inc(n);
|
|
rtError:
|
|
if arg.ResError <> errOK then inc(n);
|
|
rtCell:
|
|
begin
|
|
cell := ArgToCell(arg);
|
|
if cell <> nil then
|
|
case cell^.ContentType of
|
|
cctNumber, cctDateTime, cctBool: inc(n);
|
|
cctUTF8String: if cell^.UTF8StringValue <> '' then inc(n);
|
|
cctError: if cell^.ErrorValue <> errOK then inc(n);
|
|
end;
|
|
end;
|
|
rtCellRange:
|
|
for r := arg.ResCellRange.Row1 to arg.ResCellRange.Row2 do
|
|
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
|
|
begin
|
|
cell := arg.Worksheet.FindCell(r, c);
|
|
if (cell <> nil) then
|
|
case cell^.ContentType of
|
|
cctNumber, cctDateTime, cctBool : inc(n);
|
|
cctUTF8String: if cell^.UTF8StringValue <> '' then inc(n);
|
|
cctError: if cell^.ErrorValue <> errOK then inc(n);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
Result.ResInteger := n;
|
|
end;
|
|
|
|
procedure fpsCOUNTBLANK(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
{ Counts the number of empty cells in a range.
|
|
COUNTBLANK( range )
|
|
"range" is the range of cells to count empty cells. }
|
|
var
|
|
n: Integer;
|
|
r, c: Cardinal;
|
|
cell: PCell;
|
|
arg: TsExpressionResult;
|
|
begin
|
|
n := 0;
|
|
case Args[0].ResultType of
|
|
rtEmpty:
|
|
inc(n);
|
|
rtCell:
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if cell = nil then
|
|
inc(n)
|
|
else
|
|
case cell^.ContentType of
|
|
cctNumber, cctDateTime, cctBool: ;
|
|
cctUTF8String: if cell^.UTF8StringValue = '' then inc(n);
|
|
cctError: if cell^.ErrorValue = errOK then inc(n);
|
|
end;
|
|
end;
|
|
rtCellRange:
|
|
for r := Args[0].ResCellRange.Row1 to Args[0].ResCellRange.Row2 do
|
|
for c := Args[0].ResCellRange.Col1 to Args[0].ResCellRange.Col2 do begin
|
|
cell := Args[0].Worksheet.FindCell(r, c);
|
|
if cell = nil then
|
|
inc(n)
|
|
else
|
|
case cell^.ContentType of
|
|
cctNumber, cctDateTime, cctBool: ;
|
|
cctUTF8String: if cell^.UTF8StringValue = '' then inc(n);
|
|
cctError: if cell^.ErrorValue = errOK then inc(n);
|
|
end;
|
|
end;
|
|
end;
|
|
Result.ResInteger := n;
|
|
end;
|
|
|
|
procedure fpsMAX(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// MAX( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
Result.ResFloat := MaxValue(data);
|
|
end;
|
|
|
|
procedure fpsMIN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// MIN( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
Result.ResFloat := MinValue(data);
|
|
end;
|
|
|
|
procedure fpsPRODUCT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// PRODUCT( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
i: Integer;
|
|
p: TsExprFloat;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
p := 1.0;
|
|
for i := 0 to High(data) do
|
|
p := p * data[i];
|
|
Result.ResFloat := p;
|
|
end;
|
|
|
|
procedure fpsSTDEV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the standard deviation of a population based on a sample of numbers
|
|
// of numbers.
|
|
// STDEV( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
if Length(data) > 1 then
|
|
Result.ResFloat := StdDev(data)
|
|
else
|
|
begin
|
|
Result.ResultType := rtError;
|
|
Result.ResError := errDivideByZero;
|
|
end;
|
|
end;
|
|
|
|
procedure fpsSTDEVP(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the standard deviation of a population based on an entire population
|
|
// STDEVP( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
if Length(data) > 0 then
|
|
Result.ResFloat := PopnStdDev(data)
|
|
else
|
|
begin
|
|
Result.ResultType := rtError;
|
|
Result.ResError := errDivideByZero;
|
|
end;
|
|
end;
|
|
|
|
procedure fpsSUM(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// SUM( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
Result.ResFloat := Sum(data);
|
|
end;
|
|
|
|
procedure fpsSUMSQ(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the sum of the squares of a series of values.
|
|
// SUMSQ( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
Result.ResFloat := SumOfSquares(data);
|
|
end;
|
|
|
|
procedure fpsVAR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the variance of a population based on a sample of numbers.
|
|
// VAR( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
if Length(data) > 1 then
|
|
Result.ResFloat := Variance(data)
|
|
else
|
|
begin
|
|
Result.ResultType := rtError;
|
|
Result.ResError := errDivideByZero;
|
|
end;
|
|
end;
|
|
|
|
procedure fpsVARP(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// Returns the variance of a population based on an entire population of numbers.
|
|
// VARP( value1, [value2, ... value_n] )
|
|
var
|
|
data: TsExprFloatArray;
|
|
begin
|
|
ArgsToFloatArray(Args, data);
|
|
if Length(data) > 0 then
|
|
Result.ResFloat := PopnVariance(data)
|
|
else
|
|
begin
|
|
Result.ResultType := rtError;
|
|
Result.ResError := errDivideByZero;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Builtin info functions }
|
|
|
|
{ !!!!!!!!!!!!!! not working !!!!!!!!!!!!!!!!!!!!!! }
|
|
{ !!!!!!!!!!!!!! needs localized strings !!!!!!!!!!! }
|
|
|
|
procedure fpsCELL(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// CELL( type, [range] )
|
|
|
|
{ from http://www.techonthenet.com/excel/formulas/cell.php:
|
|
|
|
"type" is the type of information that we retrieve for the cell and can have
|
|
one of the following values:
|
|
Value Explanation
|
|
------------- --------------------------------------------------------------
|
|
"address" Address of the cell. If the cell refers to a range, it is the
|
|
first cell in the range.
|
|
"col" Column number of the cell.
|
|
"color" Returns 1 if the color is a negative value; Otherwise it returns 0.
|
|
"contents" Contents of the upper-left cell.
|
|
"filename" Filename of the file that contains reference.
|
|
"format" Number format of the cell according to:
|
|
"G" General
|
|
"F0" 0
|
|
",0" #,##0
|
|
"F2" 0.00
|
|
",2" #,##0.00
|
|
"C0" $#,##0_);($#,##0)
|
|
"C0-" $#,##0_);[Red]($#,##0)
|
|
"C2" $#,##0.00_);($#,##0.00)
|
|
"C2-" $#,##0.00_);[Red]($#,##0.00)
|
|
"P0" 0%
|
|
"P2" 0.00%
|
|
"S2" 0.00E+00
|
|
"G" # ?/? or # ??/??
|
|
"D4" m/d/yy or m/d/yy h:mm or mm/dd/yy
|
|
"D1" d-mmm-yy or dd-mmm-yy
|
|
"D2" d-mmm or dd-mmm
|
|
"D3" mmm-yy
|
|
"D5" mm/dd
|
|
"D6" h:mm:ss AM/PM
|
|
"D7" h:mm AM/PM
|
|
"D8" h:mm:ss
|
|
"D9" h:mm
|
|
"parentheses" Returns 1 if the cell is formatted with parentheses;
|
|
Otherwise, it returns 0.
|
|
"prefix" Label prefix for the cell.
|
|
- Returns a single quote (') if the cell is left-aligned.
|
|
- Returns a double quote (") if the cell is right-aligned.
|
|
- Returns a caret (^) if the cell is center-aligned.
|
|
- Returns a back slash (\) if the cell is fill-aligned.
|
|
- Returns an empty text value for all others.
|
|
"protect" Returns 1 if the cell is locked. Returns 0 if the cell is not locked.
|
|
"row" Row number of the cell.
|
|
"type" Returns "b" if the cell is empty.
|
|
Returns "l" if the cell contains a text constant.
|
|
Returns "v" for all others.
|
|
"width" Column width of the cell, rounded to the nearest integer.
|
|
|
|
!!!! NOT ALL OF THEM ARE SUPPORTED HERE !!!
|
|
|
|
"range" is optional in Excel. It is the cell (or range) that you wish to retrieve
|
|
information for. If the range parameter is omitted, the CELL function will
|
|
assume that you are retrieving information for the last cell that was changed.
|
|
|
|
"range" is NOT OPTIONAL here because we don't know the last cell changed !!!
|
|
}
|
|
var
|
|
stype: String;
|
|
r1,r2, c1,c2: Cardinal;
|
|
cell: PCell;
|
|
res: TsExpressionResult;
|
|
begin
|
|
if Length(Args)=1 then
|
|
begin
|
|
// This case is not supported by us, but it is by Excel.
|
|
// Therefore the error is not quite correct...
|
|
Result := ErrorResult(errIllegalRef);
|
|
exit;
|
|
end;
|
|
|
|
stype := lowercase(ArgToString(Args[0]));
|
|
|
|
case Args[1].ResultType of
|
|
rtCell:
|
|
begin
|
|
cell := ArgToCell(Args[1]);
|
|
r1 := Args[1].ResRow;
|
|
c1 := Args[1].ResCol;
|
|
r2 := r1;
|
|
c2 := c1;
|
|
end;
|
|
rtCellRange:
|
|
begin
|
|
r1 := Args[1].ResCellRange.Row1;
|
|
r2 := Args[1].ResCellRange.Row2;
|
|
c1 := Args[1].ResCellRange.Col1;
|
|
c2 := Args[1].ResCellRange.Col2;
|
|
cell := Args[1].Worksheet.FindCell(r1, c1);
|
|
end;
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
exit;
|
|
end;
|
|
|
|
if stype = 'address' then
|
|
Result := StringResult(GetCellString(r1, c1, []))
|
|
else
|
|
if stype = 'col' then
|
|
Result := IntegerResult(c1+1)
|
|
else
|
|
if stype = 'color' then
|
|
begin
|
|
if (cell <> nil) and (cell^.NumberFormat = nfCurrencyRed) then
|
|
Result := IntegerResult(1)
|
|
else
|
|
Result := IntegerResult(0);
|
|
end else
|
|
if stype = 'contents' then
|
|
begin
|
|
if cell = nil then
|
|
Result := IntegerResult(0)
|
|
else
|
|
case cell^.ContentType of
|
|
cctNumber : if frac(cell^.NumberValue) = 0 then
|
|
Result := IntegerResult(trunc(cell^.NumberValue))
|
|
else
|
|
Result := FloatResult(cell^.NumberValue);
|
|
cctDateTime : Result := DateTimeResult(cell^.DateTimeValue);
|
|
cctUTF8String : Result := StringResult(cell^.UTF8StringValue);
|
|
cctBool : Result := BooleanResult(cell^.BoolValue);
|
|
cctError : Result := ErrorResult(cell^.ErrorValue);
|
|
end;
|
|
end else
|
|
if stype = 'filename' then
|
|
Result := Stringresult(
|
|
ExtractFilePath(Args[1].Worksheet.Workbook.FileName) + '[' +
|
|
ExtractFileName(Args[1].Worksheet.Workbook.FileName) + ']' +
|
|
Args[1].Worksheet.Name
|
|
)
|
|
else
|
|
if stype = 'format' then begin
|
|
Result := StringResult('G');
|
|
if cell <> nil then
|
|
case cell^.NumberFormat of
|
|
nfGeneral:
|
|
Result := StringResult('G');
|
|
nfFixed:
|
|
if cell^.NumberFormatStr= '0' then Result := StringResult('0') else
|
|
if cell^.NumberFormatStr = '0.00' then Result := StringResult('F0');
|
|
nfFixedTh:
|
|
if cell^.NumberFormatStr = '#,##0' then Result := StringResult(',0') else
|
|
if cell^.NumberFormatStr = '#,##0.00' then Result := StringResult(',2');
|
|
nfPercentage:
|
|
if cell^.NumberFormatStr = '0%' then Result := StringResult('P0') else
|
|
if cell^.NumberFormatStr = '0.00%' then Result := StringResult('P2');
|
|
nfExp:
|
|
if cell^.NumberFormatStr = '0.00E+00' then Result := StringResult('S2');
|
|
nfShortDate, nfLongDate, nfShortDateTime:
|
|
Result := StringResult('D4');
|
|
nfLongTimeAM:
|
|
Result := StringResult('D6');
|
|
nfShortTimeAM:
|
|
Result := StringResult('D7');
|
|
nfLongTime:
|
|
Result := StringResult('D8');
|
|
nfShortTime:
|
|
Result := StringResult('D9');
|
|
end;
|
|
end else
|
|
if stype = 'prefix' then
|
|
begin
|
|
Result := StringResult('');
|
|
if (cell^.ContentType = cctUTF8String) then
|
|
case cell^.HorAlignment of
|
|
haLeft : Result := StringResult('''');
|
|
haCenter: Result := StringResult('^');
|
|
haRight : Result := StringResult('"');
|
|
end;
|
|
end else
|
|
if stype = 'row' then
|
|
Result := IntegerResult(r1+1)
|
|
else
|
|
if stype = 'type' then begin
|
|
if (cell = nil) or (cell^.ContentType = cctEmpty) then
|
|
Result := StringResult('b')
|
|
else if cell^.ContentType = cctUTF8String then begin
|
|
if (cell^.UTF8StringValue = '')
|
|
then Result := StringResult('b')
|
|
else Result := StringResult('l');
|
|
end else
|
|
Result := StringResult('v');
|
|
end else
|
|
if stype = 'width' then
|
|
Result := FloatResult(Args[1].Worksheet.GetColWidth(c1))
|
|
else
|
|
Result := ErrorResult(errWrongType);
|
|
end;
|
|
|
|
procedure fpsISBLANK(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISBLANK( value )
|
|
// Checks for blank or null values.
|
|
// "value" is the value that you want to test.
|
|
// If "value" is blank, this function will return TRUE.
|
|
// If "value" is not blank, the function will return FALSE.
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
case Args[0].ResultType of
|
|
rtEmpty : Result := BooleanResult(true);
|
|
rtString: Result := BooleanResult(Result.ResString = '');
|
|
rtCell : begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell = nil) or (cell^.ContentType = cctEmpty) then
|
|
Result := BooleanResult(true)
|
|
else
|
|
Result := BooleanResult(false);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure fpsISERR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISERR( value )
|
|
// If "value" is an error value (except #N/A), this function will return TRUE.
|
|
// Otherwise, it will return FALSE.
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := BooleanResult(false);
|
|
if (Args[0].ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell <> nil) and (cell^.ContentType = cctError) and (cell^.ErrorValue <> errArgError)
|
|
then Result := BooleanResult(true);
|
|
end else
|
|
if (Args[0].ResultType = rtError) and (Args[0].ResError <> errArgError) then
|
|
Result := BooleanResult(true);
|
|
end;
|
|
|
|
procedure fpsISERROR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISERROR( value )
|
|
// If "value" is an error value (#N/A, #VALUE!, #REF!, #DIV/0!, #NUM!, #NAME?
|
|
// or #NULL), this function will return TRUE. Otherwise, it will return FALSE.
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := BooleanResult(false);
|
|
if (Args[0].ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell <> nil) and (cell^.ContentType = cctError) and (cell^.ErrorValue <= errArgError)
|
|
then Result := BooleanResult(true);
|
|
end else
|
|
if (Args[0].ResultType = rtError) then
|
|
Result := BooleanResult(true);
|
|
end;
|
|
|
|
procedure fpsISLOGICAL(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISLOGICAL( value )
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := BooleanResult(false);
|
|
if (Args[0].ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell <> nil) and (cell^.ContentType = cctBool) then
|
|
Result := BooleanResult(true);
|
|
end else
|
|
if (Args[0].ResultType = rtBoolean) then
|
|
Result := BooleanResult(true);
|
|
end;
|
|
|
|
procedure fpsISNA(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISNA( value )
|
|
// If "value" is a #N/A error value , this function will return TRUE.
|
|
// Otherwise, it will return FALSE.
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := BooleanResult(false);
|
|
if (Args[0].ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell <> nil) and (cell^.ContentType = cctError) and (cell^.ErrorValue = errArgError)
|
|
then Result := BooleanResult(true);
|
|
end else
|
|
if (Args[0].ResultType = rtError) and (Args[0].ResError = errArgError) then
|
|
Result := BooleanResult(true);
|
|
end;
|
|
|
|
procedure fpsISNONTEXT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISNONTEXT( value )
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := BooleanResult(false);
|
|
if (Args[0].ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell = nil) or ((cell <> nil) and (cell^.ContentType <> cctUTF8String)) then
|
|
Result := BooleanResult(true);
|
|
end else
|
|
if (Args[0].ResultType <> rtString) then
|
|
Result := BooleanResult(true);
|
|
end;
|
|
|
|
procedure fpsISNUMBER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISNUMBER( value )
|
|
// Tests "value" for a number (or date/time - checked with Excel).
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := BooleanResult(false);
|
|
if (Args[0].ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
|
|
Result := BooleanResult(true);
|
|
end else
|
|
if (Args[0].ResultType in [rtFloat, rtInteger, rtDateTime]) then
|
|
Result := BooleanResult(true);
|
|
end;
|
|
|
|
procedure fpsISREF(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISREF( value )
|
|
begin
|
|
Result := BooleanResult(Args[0].ResultType in [rtCell, rtCellRange]);
|
|
end;
|
|
|
|
procedure fpsISTEXT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
// ISTEXT( value )
|
|
var
|
|
cell: PCell;
|
|
begin
|
|
Result := BooleanResult(false);
|
|
if (Args[0].ResultType = rtCell) then
|
|
begin
|
|
cell := ArgToCell(Args[0]);
|
|
if (cell <> nil) and (cell^.ContentType = cctUTF8String) then
|
|
Result := BooleanResult(true);
|
|
end else
|
|
if (Args[0].ResultType = rtString) then
|
|
Result := BooleanResult(true);
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{@@
|
|
Registers a non-built-in function:
|
|
|
|
@param AName Name of the function as used for calling it in the spreadsheet
|
|
@param AResultType A character classifying the data type of the function result:
|
|
'I' integer
|
|
'F' floating point number
|
|
'D' date/time value
|
|
'S' string
|
|
'B' boolean value (TRUE/FALSE)
|
|
'R' cell range, can also be used for functions requiring
|
|
a cell "reference", like "CELL(..)"
|
|
@param AParamTypes A string with result type symbols for each parameter of the
|
|
function. Symbols as used for "ResultType" with these
|
|
additions:
|
|
- Use a lower-case character if a parameter is optional.
|
|
(must be at the end of the string)
|
|
- Add "+" if the last parameter type is valid for a variable
|
|
parameter count (Excel does pose a limit of 30, though).
|
|
- Use "?" if the data type should not be checked.
|
|
@param AExcelCode ID of the function needed in the xls biff file. Please see
|
|
the "OpenOffice Documentation of Microsoft Excel File Format"
|
|
section 3.11.
|
|
@param ACallBack Address of the procedure called when the formula is
|
|
calculated.
|
|
}
|
|
{------------------------------------------------------------------------------}
|
|
procedure RegisterFunction(const AName: ShortString; const AResultType: Char;
|
|
const AParamTypes: String; const AExcelCode: Integer; ACallback: TsExprFunctionCallBack);
|
|
begin
|
|
with BuiltinIdentifiers do
|
|
AddFunction(bcUser, AName, AResultType, AParamTypes, AExcelCode, ACallBack);
|
|
end;
|
|
|
|
{@@
|
|
Registers the built-in functions. Called automatically.
|
|
}
|
|
procedure RegisterStdBuiltins(AManager : TsBuiltInExpressionManager);
|
|
var
|
|
cat: TsBuiltInExprCategory;
|
|
begin
|
|
with AManager do
|
|
begin
|
|
// Math functions
|
|
cat := bcMath;
|
|
AddFunction(cat, 'ABS', 'F', 'F', INT_EXCEL_SHEET_FUNC_ABS, @fpsABS);
|
|
AddFunction(cat, 'ACOS', 'F', 'F', INT_EXCEL_SHEET_FUNC_ACOS, @fpsACOS);
|
|
AddFunction(cat, 'ACOSH', 'F', 'F', INT_EXCEL_SHEET_FUNC_ACOSH, @fpsACOSH);
|
|
AddFunction(cat, 'ASIN', 'F', 'F', INT_EXCEL_SHEET_FUNC_ASIN, @fpsASIN);
|
|
AddFunction(cat, 'ASINH', 'F', 'F', INT_EXCEL_SHEET_FUNC_ASINH, @fpsASINH);
|
|
AddFunction(cat, 'ATAN', 'F', 'F', INT_EXCEL_SHEET_FUNC_ATAN, @fpsATAN);
|
|
AddFunction(cat, 'ATANH', 'F', 'F', INT_EXCEL_SHEET_FUNC_ATANH, @fpsATANH);
|
|
AddFunction(cat, 'COS', 'F', 'F', INT_EXCEL_SHEET_FUNC_COS, @fpsCOS);
|
|
AddFunction(cat, 'COSH', 'F', 'F', INT_EXCEL_SHEET_FUNC_COSH, @fpsCOSH);
|
|
AddFunction(cat, 'DEGREES', 'F', 'F', INT_EXCEL_SHEET_FUNC_DEGREES, @fpsDEGREES);
|
|
AddFunction(cat, 'EXP', 'F', 'F', INT_EXCEL_SHEET_FUNC_EXP, @fpsEXP);
|
|
AddFunction(cat, 'INT', 'I', 'F', INT_EXCEL_SHEET_FUNC_INT, @fpsINT);
|
|
AddFunction(cat, 'LN', 'F', 'F', INT_EXCEL_SHEET_FUNC_LN, @fpsLN);
|
|
AddFunction(cat, 'LOG', 'F', 'Ff', INT_EXCEL_SHEET_FUNC_LOG, @fpsLOG);
|
|
AddFunction(cat, 'LOG10', 'F', 'F', INT_EXCEL_SHEET_FUNC_LOG10, @fpsLOG10);
|
|
AddFunction(cat, 'PI', 'F', '', INT_EXCEL_SHEET_FUNC_PI, @fpsPI);
|
|
AddFunction(cat, 'POWER', 'F', 'FF', INT_EXCEL_SHEET_FUNC_POWER, @fpsPOWER);
|
|
AddFunction(cat, 'RADIANS', 'F', 'F', INT_EXCEL_SHEET_FUNC_RADIANS, @fpsRADIANS);
|
|
AddFunction(cat, 'RAND', 'F', '', INT_EXCEL_SHEET_FUNC_RAND, @fpsRAND);
|
|
AddFunction(cat, 'ROUND', 'F', 'FF', INT_EXCEL_SHEET_FUNC_ROUND, @fpsROUND);
|
|
AddFunction(cat, 'SIGN', 'F', 'F', INT_EXCEL_SHEET_FUNC_SIGN, @fpsSIGN);
|
|
AddFunction(cat, 'SIN', 'F', 'F', INT_EXCEL_SHEET_FUNC_SIN, @fpsSIN);
|
|
AddFunction(cat, 'SINH', 'F', 'F', INT_EXCEL_SHEET_FUNC_SINH, @fpsSINH);
|
|
AddFunction(cat, 'SQRT', 'F', 'F', INT_EXCEL_SHEET_FUNC_SQRT, @fpsSQRT);
|
|
AddFunction(cat, 'TAN', 'F', 'F', INT_EXCEL_SHEET_FUNC_TAN, @fpsTAN);
|
|
AddFunction(cat, 'TANH', 'F', 'F', INT_EXCEL_SHEET_FUNC_TANH, @fpsTANH);
|
|
|
|
// Date/time
|
|
cat := bcDateTime;
|
|
AddFunction(cat, 'DATE', 'D', 'III', INT_EXCEL_SHEET_FUNC_DATE, @fpsDATE);
|
|
AddFunction(cat, 'DATEDIF', 'F', 'DDS', INT_EXCEL_SHEET_FUNC_DATEDIF, @fpsDATEDIF);
|
|
AddFunction(cat, 'DATEVALUE', 'D', 'S', INT_EXCEL_SHEET_FUNC_DATEVALUE, @fpsDATEVALUE);
|
|
AddFunction(cat, 'DAY', 'I', '?', INT_EXCEL_SHEET_FUNC_DAY, @fpsDAY);
|
|
AddFunction(cat, 'HOUR', 'I', '?', INT_EXCEL_SHEET_FUNC_HOUR, @fpsHOUR);
|
|
AddFunction(cat, 'MINUTE', 'I', '?', INT_EXCEL_SHEET_FUNC_MINUTE, @fpsMINUTE);
|
|
AddFunction(cat, 'MONTH', 'I', '?', INT_EXCEL_SHEET_FUNC_MONTH, @fpsMONTH);
|
|
AddFunction(cat, 'NOW', 'D', '', INT_EXCEL_SHEET_FUNC_NOW, @fpsNOW);
|
|
AddFunction(cat, 'SECOND', 'I', '?', INT_EXCEL_SHEET_FUNC_SECOND, @fpsSECOND);
|
|
AddFunction(cat, 'TIME' , 'D', 'III', INT_EXCEL_SHEET_FUNC_TIME, @fpsTIME);
|
|
AddFunction(cat, 'TIMEVALUE', 'D', 'S', INT_EXCEL_SHEET_FUNC_TIMEVALUE, @fpsTIMEVALUE);
|
|
AddFunction(cat, 'TODAY', 'D', '', INT_EXCEL_SHEET_FUNC_TODAY, @fpsTODAY);
|
|
AddFunction(cat, 'WEEKDAY', 'I', '?i', INT_EXCEL_SHEET_FUNC_WEEKDAY, @fpsWEEKDAY);
|
|
AddFunction(cat, 'YEAR', 'I', '?', INT_EXCEL_SHEET_FUNC_YEAR, @fpsYEAR);
|
|
|
|
// Strings
|
|
cat := bcStrings;
|
|
AddFunction(cat, 'CHAR', 'S', 'I', INT_EXCEL_SHEET_FUNC_CHAR, @fpsCHAR);
|
|
AddFunction(cat, 'CODE', 'I', 'S', INT_EXCEL_SHEET_FUNC_CODE, @fpsCODE);
|
|
AddFunction(cat, 'CONCATENATE','S','S+', INT_EXCEL_SHEET_FUNC_CONCATENATE,@fpsCONCATENATE);
|
|
AddFunction(cat, 'LEFT', 'S', 'Si', INT_EXCEL_SHEET_FUNC_LEFT, @fpsLEFT);
|
|
AddFunction(cat, 'LEN', 'I', 'S', INT_EXCEL_SHEET_FUNC_LEN, @fpsLEN);
|
|
AddFunction(cat, 'LOWER', 'S', 'S', INT_EXCEL_SHEET_FUNC_LOWER, @fpsLOWER);
|
|
AddFunction(cat, 'MID', 'S', 'SII', INT_EXCEL_SHEET_FUNC_MID, @fpsMID);
|
|
AddFunction(cat, 'REPLACE', 'S', 'SIIS', INT_EXCEL_SHEET_FUNC_REPLACE, @fpsREPLACE);
|
|
AddFunction(cat, 'RIGHT', 'S', 'Si', INT_EXCEL_SHEET_FUNC_RIGHT, @fpsRIGHT);
|
|
AddFunction(cat, 'SUBSTITUTE','S', 'SSSi', INT_EXCEL_SHEET_FUNC_SUBSTITUTE, @fpsSUBSTITUTE);
|
|
AddFunction(cat, 'TRIM', 'S', 'S', INT_EXCEL_SHEET_FUNC_TRIM, @fpsTRIM);
|
|
AddFunction(cat, 'UPPER', 'S', 'S', INT_EXCEL_SHEET_FUNC_UPPER, @fpsUPPER);
|
|
AddFunction(cat, 'VALUE', 'F', 'S', INT_EXCEL_SHEET_FUNC_VALUE, @fpsVALUE);
|
|
|
|
// Logical
|
|
cat := bcLogical;
|
|
AddFunction(cat, 'AND', 'B', 'B+', INT_EXCEL_SHEET_FUNC_AND, @fpsAND);
|
|
AddFunction(cat, 'FALSE', 'B', '', INT_EXCEL_SHEET_FUNC_FALSE, @fpsFALSE);
|
|
AddFunction(cat, 'IF', 'B', 'B?+', INT_EXCEL_SHEET_FUNC_IF, @fpsIF);
|
|
AddFunction(cat, 'NOT', 'B', 'B', INT_EXCEL_SHEET_FUNC_NOT, @fpsNOT);
|
|
AddFunction(cat, 'OR', 'B', 'B+', INT_EXCEL_SHEET_FUNC_OR, @fpsOR);
|
|
AddFunction(cat, 'TRUE', 'B', '', INT_EXCEL_SHEET_FUNC_TRUE , @fpsTRUE);
|
|
|
|
// Statistical
|
|
cat := bcStatistics;
|
|
AddFunction(cat, 'AVEDEV', 'F', '?+', INT_EXCEL_SHEET_FUNC_AVEDEV, @fpsAVEDEV);
|
|
AddFunction(cat, 'AVERAGE', 'F', '?+', INT_EXCEL_SHEET_FUNC_AVERAGE, @fpsAVERAGE);
|
|
AddFunction(cat, 'COUNT', 'I', '?+', INT_EXCEL_SHEET_FUNC_COUNT, @fpsCOUNT);
|
|
AddFunction(cat, 'COUNTA', 'I', '?+', INT_EXCEL_SHEET_FUNC_COUNTA, @fpsCOUNTA);
|
|
AddFunction(cat, 'COUNTBLANK','I', 'R', INT_EXCEL_SHEET_FUNC_COUNTBLANK, @fpsCOUNTBLANK);
|
|
AddFunction(cat, 'MAX', 'F', '?+', INT_EXCEL_SHEET_FUNC_MAX, @fpsMAX);
|
|
AddFunction(cat, 'MIN', 'F', '?+', INT_EXCEL_SHEET_FUNC_MIN, @fpsMIN);
|
|
AddFunction(cat, 'PRODUCT', 'F', '?+', INT_EXCEL_SHEET_FUNC_PRODUCT, @fpsPRODUCT);
|
|
AddFunction(cat, 'STDEV', 'F', '?+', INT_EXCEL_SHEET_FUNC_STDEV, @fpsSTDEV);
|
|
AddFunction(cat, 'STDEVP', 'F', '?+', INT_EXCEL_SHEET_FUNC_STDEVP, @fpsSTDEVP);
|
|
AddFunction(cat, 'SUM', 'F', '?+', INT_EXCEL_SHEET_FUNC_SUM, @fpsSUM);
|
|
AddFunction(cat, 'SUMSQ', 'F', '?+', INT_EXCEL_SHEET_FUNC_SUMSQ, @fpsSUMSQ);
|
|
AddFunction(cat, 'VAR', 'F', '?+', INT_EXCEL_SHEET_FUNC_VAR, @fpsVAR);
|
|
AddFunction(cat, 'VARP', 'F', '?+', INT_EXCEL_SHEET_FUNC_VARP, @fpsVARP);
|
|
// to do: CountIF, SUMIF
|
|
|
|
// Info functions
|
|
cat := bcInfo;
|
|
AddFunction(cat, 'CELL', '?', 'Sr', INT_EXCEL_SHEET_FUNC_CELL, @fpsCELL);
|
|
AddFunction(cat, 'ISBLANK', 'B', '?', INT_EXCEL_SHEET_FUNC_ISBLANK, @fpsISBLANK);
|
|
AddFunction(cat, 'ISERR', 'B', '?', INT_EXCEL_SHEET_FUNC_ISERR, @fpsISERR);
|
|
AddFunction(cat, 'ISERROR', 'B', '?', INT_EXCEL_SHEET_FUNC_ISERROR, @fpsISERROR);
|
|
AddFunction(cat, 'ISLOGICAL', 'B', '?', INT_EXCEL_SHEET_FUNC_ISLOGICAL, @fpsISLOGICAL);
|
|
AddFunction(cat, 'ISNA', 'B', '?', INT_EXCEL_SHEET_FUNC_ISNA, @fpsISNA);
|
|
AddFunction(cat, 'ISNONTEXT', 'B', '?', INT_EXCEL_SHEET_FUNC_ISNONTEXT, @fpsISNONTEXT);
|
|
AddFunction(cat, 'ISNUMBER', 'B', '?', INT_EXCEL_SHEET_FUNC_ISNUMBER, @fpsISNUMBER);
|
|
AddFunction(cat, 'ISREF', 'B', '?', INT_EXCEL_SHEET_FUNC_ISREF, @fpsISREF);
|
|
AddFunction(cat, 'ISTEXT', 'B', '?', INT_EXCEL_SHEET_FUNC_ISTEXT, @fpsISTEXT);
|
|
|
|
(*
|
|
// Lookup / reference functions
|
|
cat := bcLookup;
|
|
AddFunction(cat, 'COLUMN', 'I', 'R', INT_EXCEL_SHEET_FUNC_COLUMN, @fpsCOLUMN);
|
|
*)
|
|
|
|
end;
|
|
end;
|
|
|
|
{ TsBuiltInExprIdentifierDef }
|
|
|
|
procedure TsBuiltInExprIdentifierDef.Assign(Source: TPersistent);
|
|
begin
|
|
inherited Assign(Source);
|
|
if Source is TsBuiltInExprIdentifierDef then
|
|
FCategory := (Source as TsBuiltInExprIdentifierDef).Category;
|
|
end;
|
|
|
|
initialization
|
|
ExprFormatSettings := DefaultFormatSettings;
|
|
ExprFormatSettings.DecimalSeparator := '.';
|
|
ExprFormatSettings.ListSeparator := ',';
|
|
|
|
RegisterStdBuiltins(BuiltinIdentifiers);
|
|
|
|
finalization
|
|
FreeBuiltins;
|
|
end.
|