hwexpr.pas

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

        end
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TDateTimeLiteral
  >>>>   Description :
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TDateTimeLiteral.Create(aDateTimeValue: TDateTime);
begin
        inherited Create(aDateTimeValue);
end;

function TDateTimeLiteral.AsDateTime: TDateTime;
begin
        Result := TDateTime(AsFloat);
end;

function TDateTimeLiteral.ExprType: TExprType;
begin
        Result := ttDateTime;
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TObjectRef
  >>>>   Description :
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }

constructor TObjectRef.Create(aObject : TObject; aClassRef: TClass = nil);
begin
        inherited Create;
        FObject:= aObject;
        if aClassRef <> nil then FClassRef := aClassRef
        else FClassRef := FObject.ClassType;
end;

function TObjectRef.AsObject: TObject;
begin
        Result:= FObject
end;

function TObjectRef.ExprType: TExprType;
begin
        Result:= ttObject
end;

function TObjectRef.TypeInfo: PTypeInfo;
begin
        if Assigned(FObject) then
            Result:= FObject.ClassInfo
        else
            Result:= TObject.ClassInfo
end;

function TObjectRef.ClassRef: TClass;
begin
        Result := FClassRef;
end;
{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TUnaryOp
  >>>>   Description : 一元操作符
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
  
constructor TUnaryOp.Create(aOperator : TOperator; aOperand : IValue);
begin
        inherited Create;
        Operand    := aOperand;
        Operator   := aOperator;
        OperandType:= Operand.ExprType;
        if not (Operator in [opNot, opPlus, opMinus]) then
            raise EExpression.CreateFmt('%s 不是一元操作符',
                [NOperator[Operator]])
end;

function TUnaryOp.AsBoolean: boolean;
begin
        case Operator of
            opNot: Result:= not(Operand.AsBoolean)
                else
                    Result:= inherited AsBoolean;
        end
end;

function TUnaryOp.AsFloat: double;
begin
        case Operator of
            opMinus: Result:= -Operand.AsFloat;
            opPlus: Result := Operand.AsFloat;
            else
                Result:= inherited AsFloat;
        end
end;

function TUnaryOp.AsInteger: integer;
begin
        Result:= 0;
        case Operator of
            opMinus: Result:= -Operand.AsInteger;
            opPlus: Result := Operand.AsInteger;
            opNot:
                case OperandType of
                    ttInteger: Result:= not Operand.AsInteger;
                    ttBoolean: Result:= integer(AsBoolean);
                    else
                        Internal(6);
                end;
            else
                Result:= inherited AsInteger;
        end
end;

function TUnaryOp.ExprType: TExprType;
begin
        Result:= ResultType(Operator, OperandType)
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TBinaryOp
  >>>>   Description : 二元操作符
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TBinaryOp.Create(aOperator : TOperator;
        aOperand1, aOperand2 :         IValue);
begin
        inherited Create;

        Operator   := aOperator;
        Operand1   := aOperand1;
        Operand2   := aOperand2;
        OperandType:= CommonType(Operand1.ExprType, Operand2.ExprType);
        if not (Operator in [opExp, opMult..opXor]) then
            raise EExpression.CreateFmt('%s 不是两元操作符',
                [NOperator[Operator]])
end;

function TBinaryOp.AsBoolean: boolean;
begin
        Result:= False;
        case Operator of
            opAnd: Result:= Operand1.AsBoolean and Operand2.AsBoolean;
            opOr: Result := Operand1.AsBoolean or Operand2.AsBoolean;
            opXor: Result:= Operand1.AsBoolean xor Operand2.AsBoolean;
        else
                Internal(13);
        end
end;

function TBinaryOp.AsFloat: double;
begin
        Result:= 0;
        case ExprType of
            ttFloat:
                case Operator of
                    opExp: Result   := Exp(Operand2.AsFloat * Ln(Operand1.AsFloat));
                    opPlus: Result  := Operand1.AsFloat + Operand2.AsFloat;
                    opMinus: Result := Operand1.AsFloat - Operand2.AsFloat;
                    opMult: Result  := Operand1.AsFloat * Operand2.AsFloat;
                    opDivide: Result:= Operand1.AsFloat / Operand2.AsFloat;
                else
                    Internal(11);
                end;
            ttDateTime:
                Result := AsDateTime;
            ttInteger:
                Result:= AsInteger;
            ttBoolean:
                Result:= integer(AsBoolean);
        end
end;

function TBinaryOp.AsDateTime: TDateTime;
begin
        Result := 0;
        case ExprType of        //
            ttDateTime, ttFloat :
                case Operator of
                    opPlus: Result  := Operand1.AsFloat + Operand2.AsFloat;
                    opMinus: Result := Operand1.AsFloat - Operand2.AsFloat;
                    opMult: Result  := Operand1.AsFloat * Operand2.AsFloat;
                    opDivide: Result:= Operand1.AsFloat / Operand2.AsFloat;
                else
                    Internal(11);
                end;
            ttInteger : Result := AsInteger;
            ttBoolean : Result := Integer(AsBoolean);
        end;        // case
end;

function TBinaryOp.AsInteger: integer;
begin
        Result:= 0;
        case ExprType of
            ttInteger:
                case Operator of
                    opPlus: Result := Operand1.AsInteger + Operand2.AsInteger;
                    opMinus: Result:= Operand1.AsInteger - Operand2.AsInteger;
                    opMult: Result := Operand1.AsInteger * Operand2.AsInteger;
                    opDiv: Result  := Operand1.AsInteger div Operand2.AsInteger;
                    opMod: Result  := Operand1.AsInteger mod Operand2.AsInteger;
                    opShl: Result  := Operand1.AsInteger shl Operand2.AsInteger;
                    opShr: Result  := Operand1.AsInteger shr Operand2.AsInteger;
                    opAnd: Result  := Operand1.AsInteger and Operand2.AsInteger;
                    opOr: Result   := Operand1.AsInteger or Operand2.AsInteger;
                    opXor: Result  := Operand1.AsInteger xor Operand2.AsInteger;
                else
                        Internal(12);
                end;
            ttBoolean:
                Result:= integer(AsBoolean);
        end
end;

function TBinaryOp.AsString: string;
begin
        Result:= '';
        case ExprType of
            ttString:
                case Operator of
                    opPlus: Result:= Operand1.AsString + Operand2.AsString;
                else
                    Internal(10);
                end;
            ttFloat:
                Result:= FloatToStr(AsFloat);
            ttInteger:
                Result:= IntToStr(AsInteger);
            ttBoolean:
                Result:= NBoolean[AsBoolean];
            ttDateTime:
                Result := DateTimeToStr(AsDateTime);
        end
end;

function TBinaryOp.ExprType: TExprType;
begin
        Result:= ResultType(Operator, OperandType)
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TRelationalOp
  >>>>   Description : 比较操作
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TRelationalOp.Create(aOperator : TOperator;
        aOperand1, aOperand2 :         IValue);
begin
        inherited Create;
        Operator   := aOperator;
        Operand1   := aOperand1;
        Operand2   := aOperand2;
        OperandType:= CommonType(Operand1.ExprType, Operand2.ExprType);
        if not (Operator in RelationalOperators) then
            raise EExpression.CreateFmt('%s 不是比较操作符',
                [NOperator[Operator]])
end;

function TRelationalOp.AsBoolean: boolean;
begin
        Result:= False;
        case OperandType of
            ttBoolean:
                case Operator of
                    opEq: Result := Operand1.AsBoolean = Operand2.AsBoolean;
                    opNEq: Result:= Operand1.AsBoolean <> Operand2.AsBoolean;
                else
                    raise EExpression.CreateFmt('逻辑型数据不支持 %s 操作',
                        [NOperator[Operator]]);
                end;
  
            ttInteger:
                case Operator of
                    opLT: Result := Operand1.AsInteger < Operand2.AsInteger;
                    opLTE: Result:= Operand1.AsInteger <= Operand2.AsInteger;
                    opGT: Result := Operand1.AsInteger > Operand2.AsInteger;
                    opGTE: Result:= Operand1.AsInteger >= Operand2.AsInteger;
                    opEq: Result := Operand1.AsInteger = Operand2.AsInteger;
                    opNEq: Result:= Operand1.AsInteger <> Operand2.AsInteger;
                end;
  
            ttFloat:
                case Operator of
                    opLT: Result := Operand1.AsFloat < Operand2.AsFloat;
                    opLTE: Result:= Operand1.AsFloat <= Operand2.AsFloat;
                    opGT: Result := Operand1.AsFloat > Operand2.AsFloat;
                    opGTE: Result:= Operand1.AsFloat >= Operand2.AsFloat;
                    opEq: Result := Operand1.AsFloat = Operand2.AsFloat;
                    opNEq: Result:= Operand1.AsFloat <> Operand2.AsFloat;
                end;

            ttDateTime:
                case Operator of
                    opLT: Result := Operand1.AsDateTime < Operand2.AsDateTime;
                    opLTE: Result:= Operand1.AsDateTime <= Operand2.AsDateTime;
                    opGT: Result := Operand1.AsDateTime > Operand2.AsDateTime;
                    opGTE: Result:= Operand1.AsDateTime >= Operand2.AsDateTime;
                    opEq: Result := Operand1.AsDateTime = Operand2.AsDateTime;
                    opNEq: Result:= Operand1.AsDateTime <> Operand2.AsDateTime;
                end;

            ttString:
                case Operator of
                    opLT: Result := Operand1.AsString < Operand2.AsString;
                    opLTE: Result:= Operand1.AsString <= Operand2.AsString;
                    opGT: Result := Operand1.AsString > Operand2.AsString;
                    opGTE: Result:= Operand1.AsString >= Operand2.AsString;
                    opEq: Result := Operand1.AsString = Operand2.AsString;
                    opNEq: Result:= Operand1.AsString <> Operand2.AsString;
                end;
        end
end;

function TRelationalOp.AsFloat: double;
begin
        Result:= integer(AsBoolean)
end;

function TRelationalOp.AsInteger: integer;
begin
        Result:= integer(AsBoolean)
end;

function TRelationalOp.AsString: string;
begin
        Result:= NBoolean[AsBoolean]
end;

function TRelationalOp.AsDateTime: TDateTime;
begin
        Result := AsFloat;
end;