ezexpressions.pas

很管用的GIS控件

unit EzExpressions;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}
interface

Uses
  SysUtils, Windows, Classes, Graphics, Controls, StdCtrls, Forms,
  EzBaseGIS, EzBase, EzBaseExpr, EzLib, EzEntities, IniFiles;

Type

  {----------------------------------------------------------------------------}
  {                  Expression evaluator section                              }
  {----------------------------------------------------------------------------}

  { TEzMainExpr }
  TEzMainExpr = Class
  Private
    FDefaultLayer: TEzBaseLayer;
    FGIS: TEzBaseGIS;
    FHasUDFs: Boolean;
    FCheckStr: String;
    FOrderByList: TList;
    FDescending: TBits;
    FClosestMax: Integer;
    Procedure IDFunc( Sender: TObject; Const Group, Identifier: String;
      ParameterList: TParameterList; Var ReturnExpr: TExpression );
    Procedure ClearOrderBy;
    function GetOrderBy(Index: Integer): TExpression;
    function GetDescending(Index: Integer): Boolean;
  Public
    Expression: TExpression;
    Constructor Create( GIS: TEzBaseGIS; Layer: TEzBaseLayer );
    Destructor Destroy; Override;
    Procedure ParseExpression( Const s: String );
    Function CheckExpression( Const s, CheckforThis: String ): Boolean;
    Function OrderByCount: Integer;

    Property HasUDFs: Boolean Read FHasUDFs;
    Property Gis: TEzBaseGis Read FGis;
    Property DefaultLayer: TEzBaseLayer Read FDefaultLayer;
    Property OrderByList[Index: Integer]: TExpression read GetOrderBy;
    Property OrderDescending[Index: Integer]: Boolean read GetDescending;
    Property ClosestMax: Integer read FClosestMax write FClosestMax;
  End;

  TEzExprList = Class
  Private
    FItems: TList;
    Function GetItem( Index: Integer ): TEzMainExpr;
  Public
    Constructor Create;
    Destructor destroy; Override;
    Procedure Add( Value: TEzMainExpr );
    Function Count: Integer;

    { properties }
    Property Items[Index: Integer]: TEzMainExpr Read GetItem; Default;
  End;

  TEntExpr = Class( TFunction )
  Private
    FGIS: TEzBaseGIS;
    FLayer: TEzBaseLayer;
  Protected
    Function GetAsString: String; Override;
    Function GetExprType: TExprType; Override;
    Function GetMaxString: String; Override;
  Public
    Constructor Create( ParameterList: TParameterList;
      GIS: TEzBaseGIS; Layer: TEzBaseLayer );
  End;

  { This is for the following syntax;
    VECTOR( [ (10,10),(20,20),(30,30),(40,40),(50,50),(10,10) ] )
    and is used mainly to be passed as parameters to other special syntax
    this function will be of type ttBoolean and will return
    true if the vector consist of 1 or more points and false otherwise }

  TEzVectorType = (vtUndefined, vtPolyline, vtPolygon, vtBuffer);

  TEzVectorExpr = Class( TFunction )
  Private
    FVector: TEzVector;
    FVectorType: TEzVectorType;
    FBufferWidth: Double;
  {$IFDEF BCB}
    function GetVector: TEzVector;
  {$ENDIF}
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList; Vector: TEzVector;
      VectorType: TEzVectorType; const BufferWidth: Double );
    Destructor Destroy; Override;
    property Vector: TEzVector {$IFDEF BCB} read GetVector {$ELSE} read FVector {$ENDIF};
  End;

  { this is used as a parameter for other expressions and return the following
    an integer that can be typecasted the following way

    case TEzGraphicOperator(xx.AsInteger) }

  TEzGraphicOperatorExpr = Class( Tfunction )
  Private
    FGraphicOperator: TEzGraphicOperator;
  Protected
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList;
      GraphicOperator: TEzGraphicOperator );
  End;

  { This is required for supporting the following syntax :
    CITIES_.ENT graphic_operator VECTOR([(10,10),(20,20),(30,30),(40,40),(50,50),(10,10)])
  }
  TEzQueryVectorExpr = Class( TFunction )
  Private
    FMainExpr: TEzMainExpr;
    FRecordList: TBits;
    FMinRecno: Integer;
    FMaxRecno: Integer;
    FPrimaryLayer: TEzBaseLayer;
  {$IFDEF BCB}
    function GetPrimaryLayer: TEzBaseLayer;
  {$ENDIF}
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList;
      MainExpr: TEzMainExpr );
    Destructor destroy; Override;
    Property PrimaryLayer: TEzBaseLayer {$IFDEF BCB} read GetPrimaryLayer {$ELSE} read FPrimaryLayer {$ENDIF};
  End;

  { This is for the following syntax :
    CITIES_.ENT graphic_operator STATES_.ENT SCOPE ("STATES_.NAME LIKE 'A%'") }

  TEzQueryScopeExpr = Class( TFunction )
  Private
    FMainExpr: TEzMainExpr;
    FRecordList: TBits;
    FMinRecno: Integer;
    FMaxRecno: Integer;
    FPrimaryLayer: TEzBaseLayer;
  {$IFDEF BCB}
    function GetPrimaryLayer: TEzBaseLayer;
  {$ENDIF}
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList;
      MainExpr: TEzMainExpr );
    Destructor Destroy; Override;
    Property PrimaryLayer: TEzBaseLayer {$IFDEF BCB} read GetPrimaryLayer {$ELSE} read FPrimaryLayer {$ENDIF};
  End;

  { This is required for supporting the following syntax :
    CITIES_.ENT ENTIRELY WITHIN STATES_.ENT SCOPE (STATES_.STATE_NAME IN ("Oklahoma", "Washington") ) AND CITIES_.CITY_NAME > 'C'"
    STATES_.ENT ENTIRELY WITHIN VECTOR ( [
      (-122.55, 49.56), (-125.27, 49.22), (-125.32, 46.86), (-125.09, 45.23), (-124.20, 44.12), (-122.49, 44.48),
      (-122.11, 45.30), (-120.41, 45.70), (-118.88, 45.99), (-120.70, 47.46), (-119.34, 48.00), (-120.35, 49.07),
      (-121.89, 49.15) , (-122.55, 49.56) ] )

    and the list of integers are the list of records against to compare
    if no record number listed, then all the records in the layer are used
  }

  TEzQueryLayerExpr = Class( TFunction )
  Private
    FMainExpr: TEzMainExpr;
    FRecordList: TBits;
    FMinRecno: Integer;
    FMaxRecno: Integer;
    FPrimaryLayer: TEzBaseLayer;
  {$IFDEF BCB}
    function GetPrimaryLayer: TEzBaseLayer;
  {$ENDIF}
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList; MainExpr: TEzMainExpr );
    Destructor Destroy; Override;
    Property PrimaryLayer: TEzBaseLayer {$IFDEF BCB} read GetPrimaryLayer {$ELSE} read FPrimaryLayer {$ENDIF};
  End;

implementation

Uses
  EzExprLex, EzExprYacc, EzLexLib, EzYaccLib, EzConsts, Ezpolyclip,
  EzGraphics, ezrtree, EzSystem;


{ TEzExprList }

Constructor TEzExprList.Create;
Begin
  Inherited Create;
  FItems := TList.Create;
End;

Destructor TEzExprList.Destroy;
Var
  I: Integer;
Begin
  For I := 0 To FItems.Count - 1 Do
    TEzMainExpr( FItems[I] ).Free;
  FItems.Free;
  Inherited Destroy;
End;

Procedure TEzExprList.Add( Value: TEzMainExpr );
Begin
  FItems.Add( Value );
End;

Function TEzExprList.Count: Integer;
Begin
  result := FItems.Count;
End;

Function TEzExprList.GetItem( Index: Integer ): TEzMainExpr;
Begin
  result := FItems[Index];
End;

{-------------------------------------------------------------------------------}
{ Start of section of expression evaluator                                      }
{-------------------------------------------------------------------------------}

  (* These are the classes derived from EzBaseExpr.TFunction that will be used
     in EzGis... *)

  (* --- This is used to solve an external reference ---
    In this, you can evaluate all kind of expression because in event
    TEzBaseGIS.FunctionSolve will be passed the Layer and the
    requested parameters. The main purpose is to extract information
    you need to show (labels) or reflect (thematic maps) in the maps.
    The source of this info can be a Client/Server SQL or whatever.
    Also can be used to add functions not included like ATAN(VALUE),
    or some other entity functions (example: a summary of some field) *)
Type

  TUDFExpr = Class( TFunction )
  Private
    FLayer: TEzBaseLayer;
    FGIS: TEzBaseGIS;
    FIdentifier: String;
    FDataType: TExprType;
    FMaxLen: Integer;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
    Function GetMaxString: String; Override;
  Public
    Constructor Create( ParameterList: TParameterList;
      GIS: TEzBaseGIS; Layer: TEzBaseLayer; Const Identifier: String;
      DataType: TExprType; MaxLen: Integer );
  End;

  { Extract the value from a field in the native table
  Note: the "native" table is the DB file that is attached to
  a layer. Example: in layer "MYLAYER" exists files: MYLAYER.ENT,
  MYLAYER.ENX, and MYLAYER.DBF, then "native" table refers to file MYLAYER.DBF}
  TNativeExpr = Class( TFunction )
  Private
    fLayer: TEzBaseLayer;
    fField: Integer; {the field that the expression refers to}
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
    Function GetMaxString: String; Override;
  Public
    Constructor Create( ParameterList: TParameterList;
      Layer: TEzBaseLayer; F: Integer );
  End;

  (* This class extract information about entities like: area, perimeter
     max extents, centroid, color, fillcolor, etc.
     First and only parameter must be an expresion of type TEntExpr *)
  TEntityOperator =
    ( opArea, opPerimeter, opMaxExtentX, opMaxExtentY,
    opMinExtentX, opMinExtentY, opCentroidX, opCentroidY, opType, opColor,
    opFillColor, opText, opLayerName, opPointsList );

  TEntityOpExpr = Class( TFunction )
  Private
    FGIS: TEzBaseGIS; // copied verbatim from parameter TEntExpr
    FLayer: TEzBaseLayer;
    FOperator: TEntityOperator;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList; Operator: TEntityOperator );
  End;

  // given red,green and blue return the TColor
  TRGBExpr = Class( TFunction )
  Protected
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  End;

  TDistanceExpr = Class( TFunction )
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprType: TExprType; Override;
  End;

  TNowExpr = Class( TFunction )
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprType: TExprType; Override;
  End;

  TToDateExpr = Class( TFunction )
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprType: TExprType; Override;
  End;

  TToNumExpr = Class( TFunction )
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprType: TExprType; Override;
  End;

  { returns if an expression is selected
    will only be valid for first viewport}
  TIsSelectedExpr = Class( TFunction )
  Private
    FLayer: TEzBaseLayer;
    FGIS: TEzBaseGIS;
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList );
  End;

  TRecNoExpr = Class( TFunction )
  Private
    FLayer: TEzBaseLayer;
  Protected
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList; Layer: TEzBaseLayer );
  End;

{ TEzGraphicOperatorExpr }

Constructor TEzGraphicOperatorExpr.Create( ParameterList: TParameterList;
  GraphicOperator: TEzGraphicOperator );
Begin
  Inherited Create( ParameterList );
  FGraphicOperator := GraphicOperator;
End;

Function TEzGraphicOperatorExpr.GetAsInteger: Integer;
Begin
  result := Ord( FGraphicOperator );
End;

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

{ TEzVectorExpr }

Constructor TEzVectorExpr.Create( ParameterList: TParameterList; Vector: TEzVector;
  VectorType: TEzVectorType; const BufferWidth: Double );
Begin
  Inherited Create( ParameterList );
  FVector := TEzVector.Create( Vector.Count );
  FVector.Assign( Vector );
  FVectorType:= VectorType;
  FBufferWidth:= BufferWidth;
End;

Destructor TEzVectorExpr.Destroy;
Begin
  FVector.free;
  Inherited destroy;
End;

Function TEzVectorExpr.GetAsBoolean: Boolean;
Begin
  result := FVector.Count > 0;
End;

Function TEzVectorExpr.GetExprType: TExprType;
Begin
  result := ttBoolean;
End;

{ TEzQueryLayerExprCreate }

type

  TEzQueryLayerKind = ( qlkFixedRecords, qlkAllRecords, qlkQueryVector,
    qlkQueryScope, qlkQueryLayer, qlkComplexExpression );


Constructor TEzQueryLayerExpr.Create( ParameterList: TParameterList;
  MainExpr: TEzMainExpr );
Var
  QueryLayerKind: TEzQueryLayerKind;
  I, MaxRec, MinRec: Integer;
  TestEntity: TEzEntity;
  Operator: TEzGraphicOperator;
  TestLayer: TEzBaseLayer;
  TheRecordList: TBits;
  TheRecno: Integer;
  ErrorFound: Boolean;

  Procedure DoQuery;
  Var
    EntityToQuery: TEzEntity;
    Passed: Boolean;
  Begin
    { set filter for the source layer and for this entity
      in order to optimize speed }
    FPrimaryLayer.SetGraphicFilter( stOverlap, TestEntity.FBox );
    FPrimaryLayer.First;
    Try
      While Not FPrimaryLayer.eof Do
      Begin
        Try
          If FPrimaryLayer.RecIsDeleted Then
          Begin
            Continue;
          End;
          EntityToQuery := FPrimaryLayer.RecLoadEntity;
          If EntityToQuery = Nil Then
            Continue;
          Try
            Passed := EntityToQuery.CompareAgainst( TestEntity, Operator );
            If Passed Then
            Begin