ezexpressions.pas

很管用的GIS控件

End;

function TEzMainExpr.GetDescending(Index: Integer): Boolean;
begin
  Result:= FDescending[Index];
end;

Procedure TEzMainExpr.IDFunc( Sender: TObject; Const Group, Identifier: String;
  ParameterList: TParameterList; Var ReturnExpr: TExpression );
Const
  Colors: Array[0..15] Of TIdentMapEntry = (
    ( Value: clBlack; Name: 'BLACK' ),
    ( Value: clMaroon; Name: 'MAROON' ),
    ( Value: clGreen; Name: 'GREEN' ),
    ( Value: clOlive; Name: 'OLIVE' ),
    ( Value: clNavy; Name: 'NAVY' ),
    ( Value: clPurple; Name: 'PURPLE' ),
    ( Value: clTeal; Name: 'TEAL' ),
    ( Value: clGray; Name: 'GRAY' ),
    ( Value: clSilver; Name: 'SILVER' ),
    ( Value: clRed; Name: 'RED' ),
    ( Value: clLime; Name: 'LIME' ),
    ( Value: clYellow; Name: 'YELLOW' ),
    ( Value: clBlue; Name: 'BLUE' ),
    ( Value: clFuchsia; Name: 'FUCHSIA' ),
    ( Value: clAqua; Name: 'AQUA' ),
    ( Value: clWhite; Name: 'WHITE' ) );

Var
  Work, LayerName: String;
  I, MaxLen, NumError: Integer;
  Layer: TEzBaseLayer;
  DataType: TExprType;
  GIS: TEzBaseGIS;
  Accept: Boolean;

  Procedure LookupInLayerInfo;
  Var
    F: Integer;
  Begin
    If ReturnExpr = Nil Then
    Begin
      If ( Work = 'ENT' ) Or ( Work = 'ENTITY' ) Then
      Begin
        If ParameterList = Nil Then
          ReturnExpr := TEntExpr.Create( ParameterList, GIS, Layer )
        Else
          NumError := 1;
      End
      Else If Work = 'RECNO' Then
      Begin
        If ParameterList = Nil Then
          ReturnExpr := TRecNoExpr.Create( ParameterList, Layer )
        Else
          NumError := 1;
      End;

      If ( ReturnExpr = Nil ) And Assigned(Layer) And
         ( Layer.DBTable <> Nil ) Then
      Begin
        F := Layer.DBTable.FieldNo( Work );
        if F <= 0 then F := Layer.DBTable.FieldNoFromAlias( Work );
        If F > 0 Then
        Begin
          If ParameterList = Nil Then
          Begin
            ReturnExpr := TNativeExpr.Create( ParameterList, Layer, F );
          End Else
            Raise EExpression.CreateFmt( SCannotContainParams, [Work] );
        End;
      End;
    End;
  End;

Begin
  ReturnExpr := Nil;
  GIS := FGIS As TEzBaseGIS;
  NumError := 0;
  Layer := FDefaultLayer;
  LayerName := Group;
  Work := Identifier;
  If Length( LayerName ) > 0 Then
  Begin
    Layer := GIS.Layers.LayerByName( LayerName );
    If Layer = Nil Then
      Raise EExpression.Create( Format( SWrongLayername, [LayerName] ) );
    LookupInLayerInfo;
  End Else If Work = 'DISTANCE' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 4 ) Then
    Begin
      For I := 0 To 3 Do
        If Not ( ParameterList.ExprType[I] In [ttFloat, ttInteger] ) Then
        Begin
          NumError := 1;
          Break;
        End;
      If NumError = 0 Then
        ReturnExpr := TDistanceExpr.Create( ParameterList );
    End
    Else
      NumError := 1;
  End
  Else If Work = 'TO_DATE' Then
  Begin
    if ParameterList = Nil then
      ReturnExpr := TNowExpr.Create( ParameterList )
    else
      NumError := 1;
  End
  Else If Work = 'TO_DATE' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.ExprType[0] = ttString ) Then
      ReturnExpr := TToDateExpr.Create( ParameterList )
    Else
      NumError := 1;
  End
  Else If Work = 'TO_NUM' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.ExprType[0] = ttString ) Then
      ReturnExpr := TToNumExpr.Create( ParameterList )
    Else
      NumError := 1;
  End
  Else If Work = 'CRLF' Then
  Begin
    If ( ParameterList = Nil ) Then
      ReturnExpr := TStringLiteral.Create( EzConsts.CrLf )
    Else
      NumError := 1;
  End
  Else If Work = 'ISSELECTED' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TIsSelectedExpr.Create( ParameterList )
    Else
      NumError := 1;
  End
  Else If Work = 'AREA' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opArea )
    Else
      NumError := 1;
  End
  Else If Work = 'PERIMETER' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opPerimeter )
    Else
      NumError := 1;
  End
  Else If Work = 'MAXEXTENTX' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opMaxExtentX )
    Else
      NumError := 1;
  End
  Else If Work = 'MAXEXTENTY' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opMaxExtentY )
    Else
      NumError := 1;
  End
  Else If Work = 'MINEXTENTX' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opMinExtentX )
    Else
      NumError := 1;
  End
  Else If Work = 'MINEXTENTY' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opMinExtentY )
    Else
      NumError := 1;
  End
  Else If Work = 'CENTROIDX' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opCentroidX )
    Else
      NumError := 1;
  End
  Else If Work = 'CENTROIDY' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
       ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opCentroidY )
    Else
      NumError := 1;
  End
  Else If Work = 'TEXT' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opText )
    Else
      NumError := 1;
  End
  Else If Work = 'LAYERNAME' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opLayerName )
    Else
      NumError := 1;
  End
  Else If Work = 'COLOR' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opColor )
    Else
      NumError := 1;
  End
  Else If Work = 'FILLCOLOR' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opFillColor )
    Else
      NumError := 1;
  End
  Else If Work = 'TYPE' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opType )
    Else
      NumError := 1;
  End Else If Work = 'POINTS' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 1 ) And
      ( ParameterList.Param[0] Is TEntExpr ) Then
      ReturnExpr := TEntityOpExpr.Create( ParameterList, opPointsList )
    Else
      NumError := 1;
  End
  Else If Work = 'RGB' Then
  Begin
    If ( ParameterList <> Nil ) And ( ParameterList.Count = 3 ) Then
      ReturnExpr := TRGBExpr.Create( ParameterList )
    Else
      NumError := 1;
  End;
  // check for a color
  If ( NumError = 0 ) And ( ReturnExpr = Nil ) Then
  Begin
    // look for color
    For I := Low( Colors ) To High( Colors ) Do
      If Work = Colors[I].Name Then
      Begin
        If ParameterList = Nil Then
        Begin
          ReturnExpr := TIntegerLiteral.Create( Colors[I].Value );
          Break;
        End
        Else
        Begin
          NumError := 1;
          Break;
        End;
      End;
  End;
  // check for a custom global function
  If ( NumError = 0 ) And ( ReturnExpr = Nil ) And Assigned( GIS.OnUDFSolve )
    And Assigned( GIS.OnUDFCheck ) Then
  begin
    If Length( LayerName ) > 0 Then
    begin
      Layer:= FGis.Layers.LayerByName( LayerName );
      if Layer = Nil then
        Raise EExpression.Create( Format( SWrongLayername, [LayerName] ) );
    End ;
    DataType:= ttString;
    Accept := False;
    MaxLen:= 0;
    GIS.OnUDFCheck( GIS, Layer.Name, Identifier, ParameterList, DataType, MaxLen, Accept );
    If Accept Then
    Begin
      ReturnExpr := TUDFExpr.Create( ParameterList, GIS, Layer, Work, DataType, MaxLen );
      FHasUDFs := True;
    End;
  End;

  If ( ReturnExpr = Nil ) And Assigned(Layer) And ( Length( LayerName ) = 0 ) Then
  Begin
    LookupInLayerInfo;
  End;

  If NumError = 1 Then
  Begin
    Raise EExpression.CreateFmt( SWrongParameters, [Work] );
  End;

End;

Procedure TEzMainExpr.ParseExpression( Const s: String );
Var
  ExprStr: String;
  OrderByStrings: TStrings;
  I: Integer;

  Function DoParse( const ParseStr: string; OrderList: TStrings ): TExpression;
  Var
    lexer: TCustomLexer;
    parser: TCustomParser;
    outputStream: TMemoryStream;
    errorStream: TMemoryStream;
    stream: TMemoryStream;
    ErrLine, ErrCol: Integer;
    ErrMsg, Errtxt: String;
  Begin
    Result:= Nil;
    stream := TMemoryStream.create;
    stream.write( ParseStr[1], Length( ParseStr ) );
    stream.seek( 0, 0 );
    outputStream := TMemoryStream.create;
    errorStream := TMemoryStream.create;
    lexer := TExprLexer.Create;
    lexer.yyinput := Stream;
    lexer.yyoutput := outputStream;
    lexer.yyerrorfile := errorStream;
    parser := TExprParser.Create( self );
    // link to the identifier function
    TExprParser( parser ).OnIdentifierFunction := IDFunc;
    parser.yyLexer := lexer; // lexer and parser linked
    Try
      If parser.yyparse = 1 Then
      Begin
        ErrLine := lexer.yylineno;
        ErrCol:= lexer.yycolno - Lexer.yyTextLen - 1;
        ErrMsg := parser.yyerrormsg;
        lexer.GetyyText (Errtxt);
        Raise EExpression.CreateFmt( SExprParserError, [ ErrMsg, ErrLine, ErrCol, ErrTxt ] );
      End;
      Result := TExprParser( parser ).GetExpression;
      if Assigned( OrderList ) then
      begin
        OrderList.Assign( TExprParser( parser ).OrderBy );
      end;
    Finally
      stream.free;
      lexer.free;
      parser.free;
      outputstream.free;
      errorstream.free;
    End;
  End;

Begin
  Self.FCheckStr := ''; // reset to empty
  ExprStr := s;
  If Expression <> Nil Then
    FreeAndNil( Expression );
  ClearOrderBy;
  Try
    If Length( ExprStr ) > 0 Then
    Begin
      OrderByStrings:= TStringList.Create;
      Try
        Expression:= DoParse( ExprStr, OrderByStrings );
        { does it have order by list ?}
        if OrderByStrings.Count > 0 then
        begin
          for I:= 0 to OrderByStrings.Count-1 do
          begin
            FOrderByList.Add( DoParse( OrderByStrings[I], Nil ) );
            { the descending is stored as a value <> nil in the TStrings.Objects }
            FDescending[I] := OrderByStrings.Objects[I] <> Nil;
          end;
        end;
      Finally
        OrderByStrings.Free;
      End;
    End;
  Except
    On E: Exception Do
    Begin
      Expression := Nil;
      ClearOrderBy;
      //MessageToUser(E.Message, smsgerror,MB_ICONERROR);
      Raise;
    End;
  End;
End;

Function TEzMainExpr.CheckExpression( Const s, CheckforThis: String ): Boolean;
Var
  ExprStr: String;
  lexer: TCustomLexer;
  parser: TCustomParser;
  outputStream: TMemoryStream;
  errorStream: TMemoryStream;
  stream: TMemoryStream;
  ErrLine, ErrCol: Integer;
  ErrMsg, Errtxt: String;
Begin
  Result := False;
  FCheckStr := CheckforThis;
  ExprStr := s;
  If Expression <> Nil Then
    FreeAndNil( Expression );
  Try
    If Length( ExprStr ) > 0 Then
    Begin
      stream := TMemoryStream.create;
      stream.write( ExprStr[1], Length( ExprStr ) );
      stream.seek( 0, 0 );
      outputStream := TMemoryStream.create;
      errorStream := TMemoryStream.create;
      lexer := TExprLexer.Create;
      lexer.yyinput := Stream;
      lexer.yyoutput := outputStream;
      lexer.yyerrorfile := errorStream;
      parser := TExprParser.Create( self );
      // link to the identifier function
      TExprParser( parser ).OnIdentifierFunction := IDFunc;
      parser.yyLexer := lexer; // lexer and parser linked
      Try
        If parser.yyparse = 1 Then
        Begin
          ErrLine := lexer.yylineno;
          ErrCol := lexer.yycolno - lexer.yytextLen - 1;
          ErrMsg := parser.yyerrormsg;
          lexer.GetyyText( ErrTxt );
          Raise EExpression.CreateFmt( SExprParserError, [ErrMsg, ErrLine, ErrCol, ErrTxt] );
        End;
        Expression := TExprParser( parser ).GetExpression;
        Result := ( Expression <> Nil ) And ( Length( FCheckStr ) > 0 );
      Finally
        stream.free;
        lexer.free;
        parser.free;
        outputstream.free;
        errorstream.free;
      End;
    End;
  Finally
    If Expression <> Nil Then
      FreeAndNil( Expression );
  End;
End;


end.