ezbaseexpr.pas

很管用的GIS控件

Begin
  Inherited Create( aParameterList );
  Operator := aOperator
End;

Function TMathExpression.GetAsFloat: Double;
Begin
  CheckParameters;
  Case Operator Of
    mfAbs: Result := Abs( Param[0].AsFloat );
    mfArcTan: Result := ArcTan( Param[0].AsFloat );
    mfCos: Result := Cos( Param[0].AsFloat );
    mfExp: Result := Exp( Param[0].AsFloat );
    mfFrac: Result := Frac( Param[0].AsFloat );
    mfInt: Result := Int( Param[0].AsFloat );
    mfLn: Result := Ln( Param[0].AsFloat );
    mfPi: Result := System.Pi;
    mfSin: Result := Sin( Param[0].AsFloat );
    mfSqr: Result := Sqr( Param[0].AsFloat );
    mfSqrt: Result := Sqrt( Param[0].AsFloat );
    mfPower: Result := Exp( Param[1].AsFloat * Ln( Param[0].AsFloat ) )
  Else
    Result := Inherited GetAsFloat;
  End
End;

Function TMathExpression.GetAsInteger: Integer;
Begin
  CheckParameters;
  Case Operator Of
    mfTrunc: Result := Trunc( Param[0].AsFloat );
    mfRound: Result := Round( Param[0].AsFloat );
    mfAbs: Result := Abs( Param[0].AsInteger );
  Else
    Result := Inherited GetAsInteger;
  End
End;

Procedure TMathExpression.CheckParameters;
Var
  OK: Boolean;
Begin
  OK := True;
  Case Operator Of
    mfTrunc, mfRound, mfArcTan, mfCos, mfExp, mfFrac, mfInt,
      mfLn, mfSin, mfSqr, mfSqrt, mfAbs:
      Begin
        OK := ( ParameterCount = 1 ) And
          ( Param[0].ExprType >= ttFloat );
      End;
    mfPower:
      Begin
        OK := ( ParameterCount = 2 ) And
          ( Param[0].ExprType >= ttFloat ) And
          ( Param[1].ExprType >= ttFloat );
      End;
  End;
  If Not OK Then
    Raise EExpression.CreateFmt( SEXPR_INVALIDPARAMETERTO, [NMF[Operator]] )
End;

Function TMathExpression.GetExprType: TExprType;
Begin
  Case Operator Of
    mfTrunc, mfRound: Result := ttInteger;
  Else
    Result := ttFloat;
  End
End;

Constructor TMathExpression.Create( aParameterList: TParameterList;
  aOperator: TMF );
Begin
  Inherited Create( aParameterList );
  Operator := aOperator
End;

Function TTypeCast.GetAsString: String;
Begin
  Result := Param[0].AsString
End;

Function TTypeCast.GetAsFloat: Double;
Begin
  If Param[0].ExprType = ttString Then
    Result := StrToFloat( Param[0].AsString )
  Else
    Result := Param[0].AsFloat
End;

Function TTypeCast.GetAsInteger: Integer;
Begin
  If Param[0].ExprType = ttString Then
    Result := StrToInt( Param[0].AsString )
  Else If Param[0].ExprType = ttFloat Then
    Result := Trunc( Param[0].AsFloat )
  Else
    Result := Param[0].AsInteger
End;

Function TTypeCast.GetAsBoolean: Boolean;
Begin
  Result := Param[0].AsBoolean
End;

Function TTypeCast.GetExprType: TExprType;
Begin
  Result := Operator
End;

Constructor TTypeCast.Create( aParameterList: TParameterList;
  aOperator: TExprType );
Begin
  Inherited Create( aParameterList );
  Operator := aOperator
End;

Function TConditional.Rex: TExpression;
Begin
  CheckParameters;
  If Param[0].AsBoolean Then
    Result := Param[1]
  Else
    Result := Param[2]
End;

Procedure TConditional.CheckParameters;
Begin
  If Not ( ( ParameterCount = 3 ) And
    ( Param[0].ExprType = ttBoolean ) ) Then
    Raise EExpression.Create( 'Invalid parameters to If' )
End;

Function TConditional.GetMaxString: String;
Begin
  If Length( Param[1].AsString ) > Length( Param[2].AsString ) Then
    Result := Param[1].AsString
  Else
    Result := Param[2].AsString;
End;

Function TConditional.GetAsString: String;
Begin
  Result := Rex.AsString;
End;

Function TConditional.GetAsFloat: Double;
Begin
  Result := Rex.AsFloat
End;

Function TConditional.GetAsInteger: Integer;
Begin
  Result := Rex.AsInteger
End;

Function TConditional.GetAsBoolean: Boolean;
Begin
  Result := Rex.AsBoolean
End;

Function TConditional.GetExprType: TExprType;
Begin
  Result := Rex.ExprType
End;

{TASCIIExpr}

Constructor TASCIIExpr.Create( ParameterList: TParameterList );
Begin
  Inherited Create( ParameterList );
  If ( ParameterList.Count <> 1 ) Or ( ParameterList.ExprType[0] <> ttString ) Then
    Raise EExpression.Create( 'ASCII: Incorrect argument' );
End;

Function TASCIIExpr.GetAsInteger: Integer;
Begin
  If Length( Param[0].AsString ) = 0 Then
    Result := 0
  Else
    Result := Ord( Param[0].AsString[1] );
End;

Function TASCIIExpr.GetExprType: TExprType;
Begin
  result := ttInteger;
End;

{ TLeftExpr }

Function TLeftExpr.GetAsString: String;
Begin
  Result := Copy( Param[0].AsString, 1, Param[1].AsInteger );
End;

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

Function imax( a, b: integer ): integer;
Begin
  If a > b Then
    result := a
  Else
    result := b;
End;

Function imin( a, b: integer ): integer;
Begin
  If a < b Then
    result := a
  Else
    result := b;
End;

{ TRightExpr }

Function TRightExpr.GetAsString: String;
Var
  p: Integer;
Begin
  p := IMax( 1, Length( Param[0].AsString ) - Param[1].AsInteger + 1 );
  Result := Copy( Param[0].AsString, p, Param[1].AsInteger );
End;

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

{ TLikeList implementaton}

Constructor TLikeList.Create;
Begin
  Inherited Create;
  fItems := TList.Create;
End;

Destructor TLikeList.Destroy;
Begin
  Clear;
  fItems.Free;
  Inherited Destroy;
End;

Function TLikeList.GetCount;
Begin
  Result := fItems.Count;
End;

Function TLikeList.GetItem( Index: Integer ): TLikeItem;
Begin
  Result := fItems[Index];
End;

Function TLikeList.Add: TLikeItem;
Begin
  Result := TLikeItem.Create;
  fItems.Add( Result );
End;

Procedure TLikeList.Clear;
Var
  I: Integer;
Begin
  For I := 0 To fItems.Count - 1 Do
    TLikeItem( fItems[I] ).Free;
  fItems.Clear;
End;

Procedure TLikeList.Delete( Index: Integer );
Begin
  TLikeItem( fItems[Index] ).Free;
  fItems.Delete( Index );
End;

{ TSQLLikeExpr implementation }

Constructor TSQLLikeExpr.Create( ParameterList: TParameterList; IsNotLike: Boolean );
Var
  s, Work: String;
  p, n: Integer;
  Previous: Char;
  EscapeChar: Char;
  Accept: Boolean;
Begin
  Inherited Create( ParameterList );
  LIKEList := TLikeList.Create;
  FIsNotLike := IsNotLike;
  If ( ParameterCount > 2 ) And ( Length( Param[2].AsString ) > 0 ) Then
    EscapeChar := Param[2].AsString[1]
  Else
    EscapeChar := #0;

  s := Param[1].AsString;
  If ( Length( s ) = 0 ) Or ( ( AnsiPos( '%', s ) = 0 ) And ( AnsiPos( '_', s ) = 0 ) ) Then
  Begin
    With LikeList.Add Do
    Begin
      LikeText := s;
      LikePos := lpNone;
    End;
  End
  Else
  Begin
    work := '';
    p := 1;
    n := 0;
    Previous := #0;
    While p <= Length( s ) Do
    Begin
      Accept := ( ( s[p] = '%' ) And ( EscapeChar = #0 ) ) Or
        ( ( s[p] = '%' ) And ( Previous <> EscapeChar ) ) Or
        ( ( s[p] = '_' ) And ( Previous <> EscapeChar ) );
      If Accept Then
      Begin
        If ( Length( Work ) > 0 ) Then
        Begin
          If n = 0 Then
          Begin
            // text must start with Work
            With LikeList.Add Do
            Begin
              LikeText := Work;
              LikePos := lpLeft;
              If s[p] = '_' Then
                LikeCode := lcSingle
              Else
                LikeCode := lcMultiple
            End;
          End
          Else
          Begin
            // el texto debe tener en medio work
            With LikeList.Add Do
            Begin
              LikeText := Work;
              LikePos := lpMiddle;
              If s[p] = '_' Then
                LikeCode := lcSingle
              Else
                LikeCode := lcMultiple
            End;
          End;
        End;
        work := '';
        inc( n );
      End
      Else
      Begin
        If ( EscapeChar = #0 ) Or Not ( s[p] = EscapeChar ) Then
          work := work + s[p];
      End;
      Previous := s[p];

      Inc( p );
    End;
    If Length( work ) > 0 Then
    Begin
      { texto deber terminar en Work }
      With LikeList.Add Do
      Begin
        LikePos := lpRight;
        LikeText := Work;
      End;
    End;
  End;
End;

Destructor TSQLLikeExpr.Destroy;
Begin
  LIKEList.Free;
  Inherited Destroy;
End;

Function TSQLLikeExpr.SQLPos( Var Start: Integer; Const Substr, Str: String ):
  Integer;
Var
  I, Pivot, NumValid, L1, L2: Integer;
  Accept: Boolean;
Begin
  Result := Low( Integer );
  L1 := Length( Str );
  L2 := Length( Substr );
  If ( L1 = 0 ) Or ( L2 = 0 ) Or ( L2 > L1 ) Then
    Exit;
  If ( Start = 1 ) And ( Pos( '_', Substr ) = 0 ) Then
  Begin
    Result := Pos( Substr, Str ); // speed up result
    If Result > 0 Then
      Inc( Start, Length( Substr ) );
  End
  Else
  Begin
    For I := Start To L1 Do
    Begin
      NumValid := 0;
      Pivot := 1;
      Accept := true;
      While Accept And ( I + Pivot - 1 <= L1 ) And ( Pivot <= L2 ) And
        ( ( Substr[Pivot] = '_' ) Or ( Str[I + Pivot - 1] = Substr[Pivot] ) ) Do
      Begin
        Inc( NumValid );
        Inc( Pivot );
      End;
      If NumValid = L2 Then
      Begin
        Inc( Start, Length( Substr ) );
        Result := I;
        Exit;
      End;
    End;
  End;
  If Result = 0 Then
    Result := Low( Integer );
End;

Procedure TSQLLikeExpr.AddToList( Like: TLikeItem );
Begin
  With LikeList.Add Do
  Begin
    LikePos := Like.LikePos;
    LikeCode := Like.LikeCode;
    LikeText := Like.LikeText;
  End;
End;

Function TSQLLikeExpr.GetAsBoolean: Boolean;
Var
  I, n, Start, p: Integer;
  Like: TLikeItem;
  s0, s1: String;
  Accept: Boolean;
Begin
  n := 0;
  s0 := Param[0].AsString;
  Start := 1;
  Accept := False; //Basri
  For I := 0 To LIKEList.Count - 1 Do
  Begin
    Like := LIKEList[I];
    s1 := Like.LikeText;
    Case Like.LikePos Of
      lpNone: Accept := ( s0 = s1 );
      lpLeft:
        Begin
          Start := 1;
          If Like.LikeCode = lcSingle Then
            s1 := s1 + '_';
          Accept := ( SQLPos( Start, s1, s0 ) = 1 );
          If Accept And ( Like.LikeCode = lcSingle ) And
            ( Length( s1 ) <> Length( s0 ) ) Then
            Accept := false;
        End;
      lpMiddle:
        Accept := ( SQLPos( Start, s1, s0 ) > 0 );
      lpRight:
        Begin
          p := Length( s0 ) - Length( s1 ) + 1;
          If Start <= p Then
          Begin
            Start := p;
            If Like.LikeCode = lcSingle Then
              s1 := '_' + s1;
            Accept := ( SQLPos( Start, s1, s0 ) = p );
            If Accept And ( Like.LikeCode = lcSingle ) And
              ( Length( s1 ) <> Length( s0 ) ) Then
              Accept := false;
          End
          Else
            Accept := False;
        End;
    End;
    If Accept Then
      Inc( n );
  End;
  Result := ( n = LIKEList.Count );
  If FIsNotLike Then
    Result := Not Result;
End;

Function TSQLLikeExpr.GetExprtype: TExprtype;
Begin
  Result := ttBoolean;
End;

{ TBetweenExpr }

Constructor TBetweenExpr.Create( ParameterList: TParameterList; IsNotBetween: Boolean );
Begin
  Inherited Create( ParameterList );
  FIsNotBetween := IsNotBetween;
End;

Function TBetweenExpr.GetAsBoolean: Boolean;
Var
  s: String;
  f: Double;
  i: Integer;
  b: Boolean;
Begin
  Result := False;
  { We'll compare expressions like
      CustNo BETWEEN 10 AND 30
  }
  Case Param[0].Exprtype Of
    ttString:
      Begin
        s := Param[0].AsString;
        result := ( s >= Param[1].AsString ) And ( s <= Param[2].AsString );
      End;
    ttFloat:
      Begin
        f := Param[0].AsFloat;
        result := ( f >= Param[1].AsFloat ) And ( f <= Param[2].AsFloat );
      End;
    ttInteger:
      Begin
        i := Param[0].AsInteger;
        result := ( i >= Param[1].AsInteger ) And ( i <= Param[2].AsInteger );
      End;
    ttBoolean:
      Begin
        b := Param[0].AsBoolean;
        result := ( b >= Param[1].AsBoolean ) And ( b <= Param[2].AsBoolean );
      End;
  End;
  If FIsNotBetween Then
    Result := Not Result;