hwexpr.pas

用于Delphi程序中嵌入公式解析

function TRelationalOp.ExprType: TExprType;
begin
        Result:= ttBoolean
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TObjectProperty
  >>>>   Description : 对象属性
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
{ DONE -oCharmer -c表达式解析与运算 :
添加对非Published的属性和方法的访问支持。
通过指定一个访问方法或函数完成这件事 }
constructor TObjectProperty.Create(aObj : IValue; const PropName : string);
begin
        inherited Create;
        Obj     := aObj.AsObject;
        PropInfo:= GetPropInfo(PTypeInfo(Obj.ClassInfo), PropName);
        if not Assigned(PropInfo) then
            raise EExpression.CreateFmt('%s 不是 %s 的Published属性',
                [PropName, aObj.AsObject.ClassName]);
        case PropInfo.PropType^^.Kind of
            tkClass: PropType:= ttObject;
            tkEnumeration:
                if PropInfo.PropType^^.Name = 'Boolean' then
                    PropType:= ttBoolean
                else
                    PropType:= ttEnumerated;
                tkInteger, tkChar: PropType         := ttInteger;
            tkFloat: PropType                       := ttFloat;
            tkString, tkLString, tkWString: PropType:= ttString;
        else
            raise EExpression.CreateFmt('不支持属性 %s 的数据类型', [PropName]);
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.AsBoolean   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.AsBoolean: boolean;
begin
        if PropType = ttBoolean then
            Result:= longbool(GetOrdProp(Obj, PropInfo))
        else
            Result:= inherited AsBoolean
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.AsFloat   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.AsFloat: double;
begin
        if PropType = ttFloat then
            Result:= GetFloatProp(Obj, PropInfo)
        else
            Result:= inherited AsFloat
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.AsDateTime   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.AsDateTime: TDateTime;
begin
        if PropType = ttDateTime then
            Result := GetFloatProp(Obj, PropInfo)
        else
            Result := inherited AsDateTime;
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.AsInteger   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.AsInteger: integer;
begin
        case PropType of
            ttInteger, ttEnumerated:
                Result:= GetOrdProp(Obj, PropInfo)
                else
                    Result:= inherited AsInteger;
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.AsObject   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.AsObject: TObject;
begin
        if PropType = ttObject then
            Result:= TObject(GetOrdProp(Obj, PropInfo))
        else
            Result:= inherited AsObject
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.AsString   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.AsString: string;
begin
        case PropType of
            ttString: Result    := GetStrProp(Obj, PropInfo);
            ttEnumerated: Result:= GetEnumName(PropInfo.PropType^, AsInteger);
            else
                Result:= inherited AsString
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.ExprType   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.ExprType: TExprType;
begin
        Result:= PropType
end;
{-----------------------------------------------------------------------------
     >>>>  TObjectProperty.TypeInfo   <<<<  Begin
-----------------------------------------------------------------------------}
function TObjectProperty.TypeInfo: PTypeInfo;
begin
        Result:= PropInfo.PropType^
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TParameterList
  >>>>   Description :
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
{-----------------------------------------------------------------------------
     >>>>  TParameterList.Destroy   <<<<  Begin
-----------------------------------------------------------------------------}
destructor TParameterList.Destroy;
var
        i: integer;
begin
        for i:= 0 to (Count - 1) do
            IValue(Items[i])._Release;
        inherited Destroy
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.AddExpression   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.AddExpression(e : IValue): integer;
begin
        Result:= Add(Pointer(e));
        e._AddRef
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetAsBoolean   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetAsBoolean(i : integer): boolean;
begin
        Result:= Param[i].AsBoolean
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetAsFloat   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetAsFloat(i : integer): double;
begin
        Result:= Param[i].AsFloat
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetAsDateTime   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetAsDateTime(i : Integer): TDateTime;
begin
        Result := Param[i].AsDateTime;
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetAsInteger   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetAsInteger(i : integer): integer;
begin
        Result:= Param[i].AsInteger
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetAsObject   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetAsObject(i : integer): TObject;
begin
        Result:= Param[i].AsObject
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetAsString   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetAsString(i : integer): string;
begin
        Result:= Param[i].AsString
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetExprType   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetExprType(i : integer): TExprType;
begin
        Result:= Param[i].ExprType
end;
{-----------------------------------------------------------------------------
     >>>>  TParameterList.GetParam   <<<<  Begin
-----------------------------------------------------------------------------}
function TParameterList.GetParam(i : integer): IValue;
begin
        Result:= IValue(Items[i])
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TFunction
  >>>>   Description : 函数的爸爸类
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TFunction.Create(aParameterList : TParameterList);
begin
        inherited Create;
        FParameterList:= aParameterList
end;
{-----------------------------------------------------------------------------
     >>>>  TFunction.Destroy   <<<<  Begin
-----------------------------------------------------------------------------}
destructor TFunction.Destroy;
begin
        FParameterList.Free;
        inherited Destroy
end;
{-----------------------------------------------------------------------------
     >>>>  TFunction.GetParam   <<<<  Begin
-----------------------------------------------------------------------------}
function TFunction.GetParam(n : integer): IValue;
begin
        Result:= FParameterList.Param[n]
end;
{-----------------------------------------------------------------------------
     >>>>  TFunction.ParameterCount   <<<<  Begin
-----------------------------------------------------------------------------}
function TFunction.ParameterCount: integer;
begin
        if Assigned(FParameterList) then
            ParameterCount:= FParameterList.Count
        else
            ParameterCount:= 0
end;

{-----------------------------------------------------------------------------
 =============================================================================
 五个内置函数类型：TypeCast, Conditional, Math, String, DateTime
-----------------------------------------------------------------------------}
type
        { 类型转换函数 }
        TTypeCast = class (TFunction)
        Private
            OperandType: TExprType;
            Operator: TExprType;
        Protected
            function TestParameters: boolean; Override;
        Public
            constructor Create(aParameterList : TParameterList; aOperator : TExprType);
            function AsBoolean: boolean; Override;
            function AsFloat: double; Override;
            function AsInteger: integer; Override;
            function AsObject: TObject; Override;
            function AsString: string; Override;
            function AsDateTime: TDateTime; Override;
            function ExprType: TExprType; Override;
        end;

        TMF =
            (mfTrunc, mfRound, mfAbs, mfArcTan, mfCos, mfExp, mfFrac, mfInt,
            mfLn, mfPi, mfSin, mfSqr, mfSqrt, mfPower);

        { 数学函数 }
        TMathExpression = class (TFunction)
        Private
            Operator: TMF;
        Protected
            function TestParameters: boolean; Override;
        Public
            constructor Create(aParameterList : TParameterList; aOperator : TMF);
            function AsFloat: double; Override;
            function AsInteger: integer; Override;
            function ExprType: TExprType; Override;
        end;

        TSF =
            (sfUpper, sfLower, sfCopy, sfPos, sfLength);
        { 字符串函数 }
        TStringExpression = class (TFunction)
        Private
            Operator: TSF;
        Protected
            function TestParameters: boolean; Override;
        Public
            constructor Create(aParameterList : TParameterList; aOperator : TSF);
            function AsInteger: integer; Override;
            function AsString: string; Override;
            function ExprType: TExprType; Override;
        end;

        { 日期时间类型函数 }
        TDF = (dfNow, dfDate, dfTime, dfDayOfWeek, dfDateToStr,
               dfTimeToStr, dfDateTimeToStr, dfEncodeTime, dfEncodeDate, dfIncMonth,
               dfStrToDate, dfStrToTime, dfStrToDateTime, dfIsLeapYear, dfFormatDateTime,
               dfYear, dfMonth, dfDay, dfHour, dfMinute, dfSecond);

        TDateTimeExpression = class(TFunction)
        Private
            Operator: TDF;
        Protected
            function TestParameters: boolean; override;
        Public
            constructor Create(aParameterList: TParameterList; aOperator : TDF);
            function AsDateTime: TDateTime; Override;
            function AsString: string; Override;
            function AsInteger: integer; override;
            function AsBoolean: Boolean; override;
            function ExprType: TExprType; override;
        end;

        { IF函数 }
        TConditional = class (TFunction)
        Private
            CommonType: TExprType;
            function Rex: IValue;
        Protected
            function TestParameters: boolean; Override;
        Public
            constructor Create(aParameterList : TParameterList);
            function AsBoolean: boolean; Override;
            function AsFloat: double; Override;
            function AsInteger: integer; Override;
            function AsString: string; Override;
            function ExprType: TExprType; Override;
        end;

        { DONE -oCharmer -c表达式解析与运算 : 添加比较函数 }

const
        NTypeCast: array[TExprType] of PChar =
            ('OBJECT', 'STRING', 'DATETIME', 'FLOAT', 'INTEGER',
             'ENUMERATED', 'BOOLEAN');
        NMF: array[TMF] of PChar =
            ('TRUNC', 'ROUND', 'ABS', 'ARCTAN', 'COS', 'EXP', 'FRAC', 'INT',
            'LN', 'PI', 'SIN', 'SQR', 'SQRT', 'POWER');
        NSF: array[TSF] of PChar = ('UPPER', 'LOWER', 'COPY', 'POS', 'LENGTH');