⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ezexpressions.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  if Mx = 0 then Mx := 1;
  Result:= StringOfChar( 'x', Mx );
End;

Function TUDFExpr.GetAsString: String;
Var
  Value: String;
  RecNo: Integer;
Begin
  { this expression was not created if this event doesn't exist, so don't check }
  If FLayer <> Nil Then RecNo := FLayer.RecNo Else RecNo := 0;
  FGIS.OnUDFSolve( FGIS, FIdentifier, Self.ParameterList, FLayer, RecNo, Value );
  Result := Value;
End;

Function TUDFExpr.GetAsFloat: Double;
Var
  Value: String;
  Code: Integer;
  RecNo: Integer;
Begin
  Value := FloatToStr( 0 );
  If FLayer <> Nil Then RecNo := FLayer.RecNo Else RecNo := 0;
  FGIS.OnUDFSolve( FGIS, FIdentifier, Self.ParameterList, FLayer, RecNo, Value );
  Val( Value, Result, Code );
  If Not ( Code = 0 ) Then
    Result := 0;
End;

Function TUDFExpr.GetAsInteger: Integer;
Var
  Value: String;
  Code: Integer;
  RecNo: Integer;
Begin
  Value := IntToStr( 0 );
  If FLayer <> Nil Then RecNo := FLayer.RecNo Else RecNo := 0;
  FGIS.OnUDFSolve( FGIS, FIdentifier, self.ParameterList, FLayer, RecNo, Value );
  Val( Value, Result, Code );
  If Not ( Code = 0 ) Then
    Result := 0;
End;

Function TUDFExpr.GetAsBoolean: Boolean;
Var
  Value: String;
  RecNo: Integer;
Begin
  Value := NBoolean[False];
  If FLayer <> Nil Then RecNo := FLayer.RecNo Else RecNo := 0;
  FGIS.OnUDFSolve( FGIS, FIdentifier, self.ParameterList, FLayer, RecNo, Value );
  If AnsiCompareText( Value, NBoolean[True] ) = 0 Then
    Result := True
  Else
    Result := False;
End;

{ TNativeExpr - class implementation}

Constructor TNativeExpr.Create( ParameterList: TParameterList;
  Layer: TEzBaseLayer; F: Integer);
Begin
  Inherited Create( ParameterList );
  FLayer := Layer;
  FField := F;
End;

Function TNativeExpr.GetExprType: TExprType;
Begin
  Case FLayer.DBTable.FieldType( FField ) Of
    'C': Result := ttString;
    'N', 'F', 'T': Result := ttFloat;
    'D', 'I': Result := ttInteger;
    'L': Result := ttBoolean;
  Else
    result := ttString;
  End;
End;

Function TNativeExpr.GetMaxString: String;
Var
  ASize: Integer;
Begin
  Result := '';
  If FLayer.DBTable.FieldType( FField ) = 'C' Then
  Begin
    ASize := FLayer.DBTable.FieldLen( FField );
    SetLength( Result, ASize );
    FillChar( Result[1], ASize, 'x' );
  End;
End;

Function TNativeExpr.GetAsString: String;
Begin
  Result := '';
  If Not ( FLayer.DBTable.FieldType( FField ) In ['M', 'B', 'G'] ) Then
  Begin
     Result := FLayer.DBTable.StringGetN( FField );
  End;
End;

Function TNativeExpr.GetAsFloat: Double;
Begin
  Result := FLayer.DBTable.FloatGetN( FField );
End;

Function TNativeExpr.GetAsInteger: Integer;
Begin
  Result := FLayer.DBTable.IntegerGetN( FField );
End;

Function TNativeExpr.GetAsBoolean: Boolean;
Begin
  Result := FLayer.DBTable.LogicGetN( FField );
End;

{$IFDEF BCB}
function TEzQueryScopeExpr.GetPrimaryLayer: TEzBaseLayer;
begin
  Result := FPrimaryLayer;
end;
{$ENDIF}

{ TNowExpr }

function TNowExpr.GetAsFloat: Double;
begin
  result:= Now;
end;

function TNowExpr.GetExprType: TExprType;
begin
  result:= ttFloat;
end;

// TToDateExpr class implementation

Function TToDateExpr.GetAsFloat: Double;
Begin
  Result := StrToDate( Param[0].AsString );
End;

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

// TToNumExpr class implementation

Function TToNumExpr.GetAsFloat: Double;
Begin
  Result := StrToFloat( Param[0].AsString );
End;

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

// TDistanceExpr

Function TDistanceExpr.GetAsFloat: Double;
Begin
  Result := Dist2D( Point2D( Param[0].AsFloat, Param[1].AsFloat ),
    Point2D( Param[2].AsFloat, Param[3].AsFloat ) );
End;

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

{TRGBExpr - class implementation}

Function TRGBExpr.GetAsInteger: Integer;
Begin
  Result := RGB( Param[0].AsInteger, Param[1].AsInteger, Param[2].AsInteger );
End;

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

{ TEntExpr - class implementation}

Constructor TEntExpr.Create( ParameterList: TParameterList;
  GIS: TEzBaseGIS; Layer: TEzBaseLayer );
Begin
  Inherited Create( ParameterList );
  FGIS := GIS;
  FLayer := Layer;
  if FLayer = Nil then
    Raise EExpression.Create( Format(SWrongLayername, ['']) );
End;

Function TEntExpr.GetMaxString: String;
Var
  ASize: Integer;
Begin
  Result:= '';
  ASize:= 18;
  SetLength( Result, ASize );
  FillChar( Result[1], ASize, 'x' );
End;

Function TEntExpr.GetAsString: String;
Var
  Entity: TEzEntity;
  TmpStr: String;
Begin
  Result := '';
  If FLayer.RecNo = 0 Then Exit;
  Entity := FLayer.LoadEntityWithRecNo( FLayer.Recno );
  If Entity <> Nil Then
  Begin
    Try
      TmpStr := Entity.ClassName;
      Result := '(' + Copy( TmpStr, 4, Length( TmpStr ) ) + ')';
    Finally
      Entity.Free;
    End;
  End;
End;

Function TEntExpr.GetExprType: TExprType;
Begin
  result := ttString;
End;

{TRecNoExpr - class implementation}

Constructor TRecNoExpr.Create( ParameterList: TParameterList; Layer: TEzBaseLayer );
Begin
  Inherited Create( ParameterList );
  FLayer := Layer;
End;

Function TRecNoExpr.GetAsInteger: Integer;
Begin
  Result := FLayer.RecNo;
End;

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

{TIsSelectedExpr - class implementation}

Constructor TIsSelectedExpr.Create( ParameterList: TParameterList );
Var
  Param: TExpression;
Begin
  Inherited Create( ParameterList );
  Param := ParameterList.Param[0];
  FGIS := TEntExpr( Param ).FGIS;
  FLayer := TEntExpr( Param ).FLayer;
End;

Function TIsSelectedExpr.GetAsBoolean: Boolean;
Begin
  //if FGIS.DrawBoxList.Count=0 then Exit;
  With FGIS.DrawBoxList[0] Do
    Result := Selection.IsSelected( FLayer, FLayer.RecNo );
End;

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

{ TEntityOpExpr - class implementation}

Constructor TEntityOpExpr.Create( ParameterList: TParameterList; Operator: TEntityOperator );
Var
  Param: TExpression;
Begin
  Inherited Create( ParameterList );
  FOperator := Operator;
  Param := ParameterList.Param[0];
  FGIS := TEntExpr( Param ).FGIS;
  FLayer := ( Param As TEntExpr ).FLayer;
End;

Function TEntityOpExpr.GetAsString: String;
Var
  Entity: TEzEntity;
  tmpStr: String;
Begin
  Case FOperator Of
    opType, opText, opLayerName, opPointsList:
      Begin
        If FLayer.RecNo = 0 Then Exit;
        Entity := FLayer.LoadEntityWithRecNo( FLayer.Recno );
        If ( Entity <> Nil ) Then
        Begin
          Try
            Case FOperator Of
              opType:
                Begin
                  tmpStr := Entity.ClassName;
                  Result := '(' + Copy( tmpStr, 4, Length( tmpStr ) ) + ')';
                End;
              opText:
                If Entity.EntityID = idJustifVectText Then
                  result := TEzJustifVectorText( entity ).Text
                Else If Entity.EntityID = idFittedVectText Then
                  result := TEzFittedVectorText( entity ).Text
                Else
                  Result := '';
              opLayerName:
                Result := FLayer.Name;
              opPointsList:
                Result:= Entity.Points.AsString;
            End;
          Finally
            Entity.Free;
          End;
        End;
      End;
    //opRecno: Result := IntToStr(GetAsInteger);
  Else
    Result := FloatToStr( GetAsFloat );
  End;
End;

Function TEntityOpExpr.GetAsInteger: Integer;
Begin
  Result := 0;
End;

Function TEntityOpExpr.GetAsFloat: Double;
Var
  Entity: TEzEntity;
  Emax, Emin, C: TEzPoint;

  Procedure calc_maxmin;
  Begin
    Entity.UpdateExtension;
    Emin := Entity.FBox.Emin;
    Emax := Entity.FBox.Emax;
  End;

Begin
  { Given a Recno, then read the entity}
  Result := 0;
  If FLayer.RecNo = 0 Then Exit;
  Entity := FLayer.LoadEntityWithRecNo( FLayer.Recno );
  If Entity = Nil Then Exit;
  Try
    With FGIS.DrawBoxList[0] Do
      Case FOperator Of
        opArea:
          Result := Entity.Area;
        opPerimeter:
          Result := Entity.Perimeter;
        opMaxExtentX:
          Begin
            calc_maxmin;
            Result := Emax.X;
          End;
        opMaxExtentY:
          Begin
            calc_maxmin;
            Result := Emax.Y;
          End;
        opMinExtentX:
          Begin
            calc_maxmin;
            Result := Emin.X;
          End;
        opMinExtentY:
          Begin
            calc_maxmin;
            Result := Emin.Y;
          End;
        opCentroidX:
          Begin
            Entity.Centroid( C.X, C.Y );
            Result := C.X;
          End;
        opCentroidY:
          Begin
            Entity.Centroid( C.X, C.Y );
            Result := C.Y;
          End;
        opColor:
          Begin
            Result := clBlack;
            If Entity.EntityID = idTrueTypeText Then
              Result := TEzTrueTypeText( Entity ).FontTool.Color
            Else If Entity.EntityID = idJustifVectText Then
              Result := TEzJustifVectorText( Entity ).FontColor
            Else If Entity.EntityID = idFittedVectText Then
              Result := TEzFittedVectorText( Entity ).FontColor
            Else If Entity.EntityID = idPoint Then
              Result := TEzPointEntity( Entity ).Color
            Else If Entity Is TEzOpenedEntity Then
              TEzOpenedEntity( entity ).PenTool.Color;
          End;
        opFillColor:
          If Entity Is TEzClosedEntity Then
            Result := TEzClosedEntity( Entity ).BrushTool.Color
          Else
            Result := clBlack
      End;
  Finally
    Entity.Free;
  End;
End;

Function TEntityOpExpr.GetExprType: TExprType;
Begin
  Case FOperator Of
    //opRecno: result := ttInteger;
    opType, opText, opLayerName, opPointsList: result := ttString;
  Else
    result := ttFloat;
  End;
End;

{TEzMainExpr - clas implementation}

Constructor TEzMainExpr.Create( GIS: TEzBaseGIS; Layer: TEzBaseLayer );
Begin
  Inherited Create;
  FOrderByList:= TList.Create;
  FDescending:= TBits.Create;
  FDefaultLayer := Layer;
  FGIS := GIS;
End;

Destructor TEzMainExpr.Destroy;
Begin
  Expression.Free;
  ClearOrderBy;
  FOrderByList.Free;
  FDescending.Free;
  Inherited Destroy;
End;

Procedure TEzMainExpr.ClearOrderBy;
var
  I: Integer;
begin
  for I:= 0 to FOrderByList.Count-1 do
    TExpression(FOrderByList[I]).Free;
  FOrderByList.Clear;
end;

function TEzMainExpr.GetOrderBy(Index: Integer): TExpression;
begin
  Result:= Nil;
  if (Index < 0) or (Index > FOrderByList.Count-1) then Exit;
  Result:= TExpression( FOrderByList[Index] );
end;

Function TEzMainExpr.OrderByCount: Integer;
Begin
  Result:= FOrderByList.Count;

⌨️ 快捷键说明

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