📄 ezbaseexpr.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
Function TExpression.GetAsFloat: Double;
Begin
  Result := 0;
  Case ExprType Of
    // Allow cast expression to string... why not? (actually I need this)
    ttString:
      try
        Result := StrToFloat (AsString);
      except
        on EConvertError do
          Result := StrToDateTime (AsString);
      end;
    ttFloat:
      Raise EExpression.CreateFmt( SEXPR_CANNOTCASTTOFLOAT, [NExprType[ExprType]] );
    ttInteger, ttBoolean: Result := AsInteger;
  End;
End;

Function TExpression.GetAsInteger: Integer;
Begin
  Result := 0;
  Case ExprType Of
    // Allow cast expression to string 
    ttString : Result := StrToInt (AsString);
    //ttFloat : Result := FloatToStr (AsFloat);
    ttFloat, ttInteger: raise EExpression.CreateFmt(SEXPR_CANNOTCASTTOINTEGER,
                               [NExprType[ExprType]]);
    ttBoolean: Result:= Integer(AsBoolean);
  End;
End;

Function TExpression.GetAsBoolean: Boolean;
Begin
  Raise EExpression.CreateFmt( SEXPR_CANNOTCASTTOBOOLEAN,
    [NExprType[ExprType]] )
End;

Function TExpression.CanReadAs( aExprType: TExprType ): Boolean;
Begin
  Result := Ord( ExprType ) >= Ord( aExprType )
End;

Function TStringLiteral.GetAsString: String;
Begin
  Result := FAsString
End;

Function TStringLiteral.GetExprType: TExprType;
Begin
  Result := ttString
End;

Constructor TStringLiteral.Create( const aAsString: String );
Begin
  Inherited Create;
  FAsString := aAsString
End;

Function TFloatLiteral.GetAsString: String;
Begin
  Result := FloatToStr( FAsFloat )
End;

Function TFloatLiteral.GetAsFloat: Double;
Begin
  Result := FAsFloat
End;

Function TFloatLiteral.GetExprType: TExprType;
Begin
  Result := ttFloat
End;

Constructor TFloatLiteral.Create( aAsFloat: Double );
Begin
  Inherited Create;
  FAsFloat := aAsFloat
End;

Function TIntegerLiteral.GetAsString: String;
Begin
  Result := FloatToStr( FAsInteger )
End;

Function TIntegerLiteral.GetAsFloat: Double;
Begin
  Result := FAsInteger
End;

Function TIntegerLiteral.GetAsInteger: Integer;
Begin
  Result := FAsInteger
End;

Function TIntegerLiteral.GetExprType: TExprType;
Begin
  Result := ttInteger
End;

Constructor TIntegerLiteral.Create( aAsInteger: Integer );
Begin
  Inherited Create;
  FAsInteger := aAsInteger
End;

Function TBooleanLiteral.GetAsString: String;
Begin
  Result := NBoolean[FAsBoolean]
End;

Function TBooleanLiteral.GetAsFloat: Double;
Begin
  Result := GetAsInteger
End;

Function TBooleanLiteral.GetAsInteger: Integer;
Begin
  Result := Integer( FAsBoolean )
End;

Function TBooleanLiteral.GetAsBoolean: Boolean;
Begin
  Result := FAsBoolean
End;

Function TBooleanLiteral.GetExprType: TExprType;
Begin
  Result := ttBoolean
End;

Constructor TBooleanLiteral.Create( aAsBoolean: Boolean );
Begin
  Inherited Create;
  FAsBoolean := aAsBoolean
End;

Function TUnaryOp.GetAsFloat: Double;
Begin
  Case Operator Of
    opMinus: Result := -Operand.AsFloat;
    opPlus: Result := Operand.AsFloat;
  Else
    Result := Inherited GetAsFloat;
  End
End;

Function TUnaryOp.GetAsInteger: 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 GetAsInteger;
  End
End;

Function TUnaryOp.GetAsBoolean: Boolean;
Begin
  Case Operator Of
    opNot: Result := Not ( Operand.AsBoolean )
  Else
    Result := Inherited GetAsBoolean;
  End
End;

Function TUnaryOp.GetExprType: TExprType;
Begin
  Result := ResultType( Operator, OperandType )
End;

Constructor TUnaryOp.Create( aOperator: TOperator; aOperand: TExpression );
Begin
  Inherited Create;
  Operand := aOperand;
  Operator := aOperator;
  OperandType := Operand.ExprType;
  If Not ( Operator In [opNot, opPlus, opMinus] ) Then
    Raise EExpression.CreateFmt( SEXPR_WRONGUNARYOP,
      [NOperator[Operator]] )
End;

Destructor TUnaryOp.Destroy;
Begin
  Operand.Free;
  Inherited Destroy
End;

Function TBinaryOp.GetAsString: 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];
  End
End;

Function TBinaryOp.GetAsFloat: 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;
    ttInteger:
      Result := AsInteger;
    ttBoolean:
      Result := Integer( AsBoolean );
  End
End;

Function TBinaryOp.GetAsInteger: 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( GetAsBoolean );
  End
End;

Function TBinaryOp.GetAsBoolean: 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.GetExprType: TExprType;
Begin
  GetExprType := ResultType( Operator, OperandType )
End;

Constructor TBinaryOp.Create( aOperator: TOperator; aOperand1, aOperand2: TExpression );
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( SEXPR_WRONGBINARYOP, [NOperator[Operator]] );
End;

Destructor TBinaryOp.Destroy;
Begin
  Operand1.Free;
  Operand2.Free;
  Inherited Destroy
End;

Function TRelationalOp.GetAsString: String;
Begin
  Result := NBoolean[AsBoolean]
End;

Function TRelationalOp.GetAsFloat: Double;
Begin
  Result := Integer( AsBoolean )
End;

Function TRelationalOp.GetAsInteger: Integer;
Begin
  Result := Integer( AsBoolean )
End;

Function TRelationalOp.GetAsBoolean: Boolean;
Begin
  Result := false;
  Case CommonType( Operand1.ExprType, Operand2.ExprType ) Of
    ttBoolean:
      Case Operator Of
        opEQ: Result := Operand1.AsBoolean = Operand2.AsBoolean;
        opNEQ: Result := Operand1.AsBoolean <> Operand2.AsBoolean;
      Else
        Raise EExpression.CreateFmt( SEXPR_WRONGBOOLEANOP,
          [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;

    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.GetExprType: TExprType;
Begin
  Result := ttBoolean
End;

Constructor TRelationalOp.Create( aOperator: TOperator; aOperand1, aOperand2: TExpression );
Begin
  Inherited Create;
  Operator := aOperator;
  Operand1 := aOperand1;
  Operand2 := aOperand2;
  If Not ( Operator In RelationalOperators ) Then
    Raise EExpression.CreateFmt( SEXPR_WRONGRELATIONALOP,
      [NOperator[Operator]] )
End;

Destructor TRelationalOp.Destroy;
Begin
  Operand1.Free;
  Operand2.Free;
  Inherited Destroy
End;

Function TParameterList.GetAsString( i: Integer ): String;
Begin
  Result := Param[i].AsString
End;

Function TParameterList.GetAsFloat( i: Integer ): Double;
Begin
  Result := Param[i].AsFloat
End;

Function TParameterList.GetAsInteger( i: Integer ): Integer;
Begin
  Result := Param[i].AsInteger
End;

Function TParameterList.GetAsBoolean( i: Integer ): Boolean;
Begin
  Result := Param[i].AsBoolean
End;

Function TParameterList.GetExprType( i: Integer ): TExprType;
Begin
  Result := Param[i].ExprType
End;

Function TParameterList.GetParam( i: Integer ): TExpression;
Begin
  Result := TExpression( Items[i] )
End;

Destructor TParameterList.Destroy;
Var
  i: Integer;
Begin
  For i := 0 To ( Count - 1 ) Do
    TObject( Items[i] ).Free;
  Inherited Destroy
End;

{ TFunction }

Function TFunction.GetParam( n: Integer ): TExpression;
Begin
  Result := FParameterList.Param[n]
End;

Function TFunction.ParameterCount: Integer;
Begin
  If ( FParameterList <> Nil ) Then
    ParameterCount := FParameterList.Count
  Else
    ParameterCount := 0
End;

Constructor TFunction.Create( aParameterList: TParameterList );
Begin
  Inherited Create;
  FParameterList := aParameterList
End;

Destructor TFunction.Destroy;
Begin
  FParameterList.Free;
  Inherited Destroy
End;

{$IFDEF BCB} (*_*)
function TFunction.GetParameterList: TParameterList;
begin
  Result := FParameterList;
end;
{$ENDIF}

Const
  NTypeCast: Array[TExprType] Of PChar =
  ( 'STRING', 'FLOAT', 'Integer', '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', 'LTRIM', 'RTRIM', 'TRIM' );

Function TStringExpression.GetMaxString: String;
Begin
  CheckParameters;
  Case Operator Of
    sfUpper, sfLower, sfLTrim, sfRTrim, sfTrim: Result := Param[0].MaxString;
    sfCopy: Result := Copy( Param[0].MaxString, Param[1].AsInteger, Param[2].AsInteger );
  Else
    Result := Inherited GetAsString;
  End
End;

Function TStringExpression.GetAsString: String;
Begin
  CheckParameters;
  Case Operator Of
    sfUpper: Result := AnsiUpperCase( Param[0].AsString );
    sfLower: Result := AnsiLowerCase( Param[0].AsString );
    sfCopy: Result := Copy( Param[0].AsString, Param[1].AsInteger, Param[2].AsInteger );
    sfLTrim: Result := TrimLeft( Param[0].AsString );
    sfRTrim: Result := TrimRight( Param[0].AsString );
    sfTrim: Result := Trim( Param[0].AsString );
  Else
    Result := Inherited GetAsString;
  End
End;

Function TStringExpression.GetAsInteger: Integer;
Begin
  CheckParameters;
  Case Operator Of
    sfPos: Result := AnsiPos( Param[0].AsString, Param[1].AsString );
    sfLength: Result := Length( Param[0].AsString );
  Else
    Result := Inherited GetAsInteger
  End
End;

Function TStringExpression.GetExprType: TExprType;
Begin
  Case Operator Of
    sfUpper, sfLower, sfCopy, sfLTrim, sfRTrim, sfTrim: Result := ttString;
  Else
    Result := ttInteger;
  End
End;

Procedure TStringExpression.CheckParameters;
Var
  OK: Boolean;
Begin
  OK := false;
  Case Operator Of
    sfUpper, sfLower, sfLength, sfLTrim, sfRTrim, sfTrim:
      OK := ( ParameterCount = 1 ) And
        ( Param[0].ExprType >= ttString );
    sfCopy:
      OK := ( ParameterCount = 3 ) And
        ( Param[0].ExprType >= ttString ) And
        ( Param[1].ExprType >= ttInteger ) And
        ( Param[2].ExprType >= ttInteger );
    sfPos:
      OK := ( ParameterCount = 2 ) And
        ( Param[0].ExprType >= ttString ) And
        ( Param[1].ExprType >= ttString );
  End;
  If Not OK Then
    Raise EExpression.CreateFmt( SEXPR_WRONGPARAMETER,
      [NSF[Operator]] )
End;

Constructor TStringExpression.Create( aParameterList: TParameterList;
  aOperator: TSF );
💿 文件大小 1389 K
👤 上传用户 dasdasdc
📂 所属分类人工智能/神经网络
🏷️ 相关标签

#GIS #控件
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -