eztable.pas

很管用的GIS控件

Function TEzTable.GetSourceRecNo: Integer;
Begin
  UpdateCursorPos;
  Result := 0;
  If ( FCurRec < 0 ) Or ( FCurRec > FRecordCount - 1 ) Then Exit;
  result := FRecords[FCurRec];
End;

Function TEzTable.IsDeleted: boolean;
Begin
  UpdateCursorPos;
  result := FLayer.RecIsDeleted;
End;

Procedure TEzTable.SetRecNo( Value: Integer );
Begin
  CheckBrowseMode;
  If ( Value > 0 ) And ( Value <= FRecordCount ) Then
  Begin
    FCurRec := Value - 1;
    FLayer.Recno := FRecords[FCurRec];
    FLayer.Synchronize;
    Resync( [] );
    DoAfterScroll;
  End;
End;

Procedure TEzTable.SetGIS( Const Value: TEzBaseGIS );
Begin
{$IFDEF LEVEL5}
  if Assigned( FGis ) then FGis.RemoveFreeNotification( Self );
{$ENDIF}
  If Value <> Nil Then
  Begin
    Value.FreeNotification( Self );
  End;
  FGIS := Value;
End;

Procedure TEzTable.DoBeforeSetFieldValue( Inserting: Boolean );
Begin
  If Inserting Then
    DatabaseError( SInsertNotAllowed );
End;

Function TEzTable.GetCanModify: Boolean;
Begin
  Result := Not FReadOnly;
End;

Procedure TEzTable.Notification( AComponent: TComponent;
  Operation: toperation );
Begin
  Inherited Notification( AComponent, Operation );
  If ( Operation = opRemove ) And ( AComponent = FGIS ) Then
    FGIS := Nil;
End;

Procedure TEzTable.SetFiltered( Value: Boolean );
Begin
  If IsOpen Then
  Begin
    CheckBrowseMode;
    If Filtered <> Value Then
    Begin
      Inherited SetFiltered( Value );
      If Value Then
        SetFilterData( Filter );
    End;
    First;
  End
  Else
    Inherited SetFiltered( Value );
End;

Procedure TEzTable.SetFilterText( Const Value: String );
Begin
  SetFilterData( Value );
End;

Function TEzTable.IsSequenced: Boolean;
Begin
  Result := Not Filtered;
End;

Procedure TEzTable.SetReadOnly( Value: Boolean );
Begin
  If Value <> FReadOnly Then
  Begin
    If Active Then
      DatabaseError( SWrongReadOnly );
    FReadOnly := Value;
  End;
End;

Procedure TEzTable.CreateFilterExpr( Const Text: String );
Begin
  If Assigned( FFilterExpr ) Then
    FreeAndNil( FFilterExpr );
  If Length( Text ) > 0 Then
  Begin
    FFilterExpr := TEzMainExpr.Create( FGIS, FLayer );
    Try
      FFilterExpr.ParseExpression( Text );
    Except
      FreeAndNil( FFilterExpr );
      Raise;
    End;
  End;
End;

Procedure TEzTable.SetFilterData( Const Text: String );
Begin
  If IsOpen And Filtered And (Length(Text) > 0) Then 
  Begin
    CheckBrowseMode;
    CreateFilterExpr( Text );
    First;
  End;
  Inherited SetFilterText( Text );
End;

Function TEzTable.FilterRecord( Buffer: PChar ): Boolean;
Var
  SaveState: TDatasetState;
Begin
  Result := True;
  If Not Filtered Then
    exit;
  If Not ( Assigned( FFilterExpr ) Or Assigned( OnFilterRecord ) ) Then
    Exit;
  SaveState := SetTempState( dsFilter );
  If Assigned( OnFilterRecord ) Then
    OnFilterRecord( Self, Result );
  If Assigned( FFilterExpr ) And Result Then
  Begin
    FLayer.Recno := FRecords[FCurRec];
    FLayer.Synchronize;
    Result := FFilterExpr.Expression.AsBoolean;
  End;
  RestoreState( SaveState );
End;

Function TEzTable.GetRecordCount: Integer;
Var
  SaveState: TDataSetState;
  SavePosition: integer;
  TempBuffer: PChar;
Begin
  CheckActive;
  If Not Filtered Then
    Result := FRecordCount
  Else
  Begin
    Result := 0;
    SaveState := SetTempState( dsBrowse );
    SavePosition := FCurRec;
    Try
      TempBuffer := AllocRecordBuffer;
      InternalFirst;
      While GetRecord( TempBuffer, gmNext, True ) = grOk Do
        Inc( Result );
    Finally
      RestoreState( SaveState );
      FCurRec := SavePosition;
      FreeRecordBuffer( TempBuffer );
    End;
  End;
End;

Procedure TEzTable.Recall;
Begin
  CheckActive;
  If State In [dsInsert, dsSetKey] Then
    Cancel
  Else
  Begin
    If ( FCurRec < 0 ) Or ( FCurRec >= FRecordCount ) Or
      ( RecordCount = 0 ) Then
      Exit;
    DataEvent( deCheckBrowseMode, 0 );
    DoBeforeScroll;
    UpdateCursorPos;
    FLayer.RecNo := FRecords[FCurRec];
    FLayer.Recall;
    FreeFieldBuffers;
    SetState( dsBrowse );
    Resync( [] );
    DoAfterScroll;
  End;
End;

Procedure TEzTable.OrderBy( Const Expression: String; Descending: Boolean );
Var
  IndexObj: TEzMainExpr;
  Recnum, n, I: Integer;
  SortList: TStringList;
Begin
  If FRecordCount < 2 Then Exit;
  IndexObj := TEzMainExpr.Create( FGIS, Self.FLayer );
  SortList := TStringList.Create;
  DisableControls;
  Try
    IndexObj.ParseExpression( Expression );
    For I := 0 To FRecords.Count - 1 Do
    Begin
      n := FRecords[I];
      FLayer.Recno := n;
      If Not FUseDeleted And FLayer.RecIsDeleted Then Continue;
      FLayer.Synchronize;
      SortList.AddObject( IndexObj.Expression.AsString, Pointer( n ) )
    End;
    SortList.Sort;
    { Now recreate the recno list }
    FRecords.Clear;
    FRecords.Capacity := FRecordCount;
    For I := 0 To SortList.Count - 1 Do
    Begin
      If Descending Then
        Recnum := Integer( SortList.Objects[SortList.Count - I - 1] )
      Else
        Recnum := Integer( SortList.Objects[I] );
      FRecords.Add( Recnum );
    End;
  Finally
    SortList.Free;
    IndexObj.Free;
    First;
    EnableControls;
  End;
End;

Procedure TEzTable.SetLayerName( Const Value: String );
Begin
  InternalClose;
  FLayerName := Value;
  FLayer := Nil;
  FMapFields.Clear;
End;

Procedure TEzTable.InternalRefresh;
Begin
  InternalClose;
  InternalOpen;
End;

Procedure TEzTable.UnSort;
Begin
  RebuildRecordList;
  First;
End;

Procedure TEzTable.DoBeforeGetFieldValue;
Var
  n: Integer;
Begin
  n := FRecords[FCurRec];
  FLayer.Recno := n;
  FLayer.Synchronize;
End;

Procedure TEzTable.BufferFilter( Buffer: TEzEntity;
  Operator: TEzGraphicOperator; Const QueryExpression: String; CurvePoints: Integer;
  Const Distance: Double; ClearBefore: Boolean );
Begin
  SetBaseLayer;
  If ( FLayer = Nil ) Or ( FGIS = Nil ) Then
    Exit;
  FGIS.QueryBuffer( Buffer, FLayer.Name, QueryExpression, Operator, 0,
    CurvePoints, Distance, FGraphicFilterList, ClearBefore );
End;

Procedure TEzTable.ScopeFilter( Const Scope: String; ClearBefore: Boolean );
Begin
  SetBaseLayer;
  If ( FLayer = Nil ) Or ( FGIS = Nil ) Then Exit;
  FGIS.QueryExpression( FLayer.Name, Scope, 0, FGraphicFilterList, ClearBefore );
  FGraphicFiltered := True;
End;

Procedure TEzTable.PolygonFilter( Polygon: TEzEntity;
  Operator: TEzGraphicOperator; Const QueryExpression: String; ClearBefore: Boolean );
Begin
  SetBaseLayer;
  If ( FLayer = Nil ) Or ( FGIS = Nil ) Then Exit;
  FGIS.QueryPolygon( Polygon, FLayer.Name, QueryExpression, Operator, 0,
    FGraphicFilterList, ClearBefore );
  FGraphicFiltered := True;
End;

Procedure TEzTable.RectangleFilter( Const AxMin, AyMin, AxMax, AyMax: Double;
  Operator: TEzGraphicOperator; Const QueryExpression: String; ClearBefore: Boolean );
Begin
  SetBaseLayer;
  If ( FLayer = Nil ) Or ( FGIS = Nil ) Then
    Exit;
  FGIS.QueryRectangle( Axmin, Aymin, Axmax, Aymax, FLayer.Name, QueryExpression,
    Operator, 0, FGraphicFilterList, ClearBefore );
  FGraphicFiltered := True;
End;

Procedure TEzTable.PolylineIntersects( Polyline: TEzEntity;
  Const QueryExpression: String; ClearBefore: Boolean );
Begin
  SetBaseLayer;
  If ( FLayer = Nil ) Or ( FGIS = Nil ) Then Exit;
  FGIS.QueryPolyline( Polyline, FLayer.Name, QueryExpression, 0,
    FGraphicFilterList, ClearBefore );
  FGraphicFiltered := True;
End;

Procedure TEzTable.FilterFromLayer( SourceLayer: TEzBaseLayer;
  Const QueryExpression: String; Operator: TEzGraphicOperator; ClearBefore: Boolean );
Var
  E: TEzEntity;
  WasInit: Boolean;
  DoClearBefore: Boolean;
Begin
  If Sourcelayer = Nil Then
    Exit;
  WasInit := false;
  SourceLayer.First;
  While Not SourceLayer.Eof Do
  Begin
    If SourceLayer.RecIsDeleted Then
    Begin
      SourceLayer.Next;
      Continue;
    End;
    E := SourceLayer.LoadEntityWithRecno( SourceLayer.Recno );
    If E = Nil Then
    Begin
      Sourcelayer.Next;
      Continue;
    End;
    Try
      Try
        If Not ( E.EntityID In [idPolyline,
          idPolygon,
            idArc,
            idEllipse,
            idSpline] ) Then
        Begin
          Sourcelayer.Next;
          Continue;
        End;
        If Not WasInit Then
        Begin
          DoClearBefore := ClearBefore;
          WasInit := true;
        End
        Else
          DoClearBefore := false;
        If E.IsClosed Then
          FGIS.QueryPolygon( E,
            Sourcelayer.Name,
            QueryExpression,
            Operator,
            0,
            FGraphicFilterList,
            DoClearBefore )
        Else
          FGIS.QueryPolyline( E,
            Sourcelayer.Name,
            QueryExpression,
            0,
            FGraphicFilterList,
            DoClearBefore );
      Finally
        E.Free;
      End;
    Finally
      Sourcelayer.Next;
    End;
  End;
  FGraphicFiltered := True;
End;

Procedure TEzTable.AllocateBLOBPointer( Field: TField; Var P: Pointer );
Begin
  // save the source recno in the blob field
  P := Pointer( GetSourceRecNo );
End;

Procedure TEzTable.FreeBLOBPointer( Field: TField; Var P: Pointer );
Begin
  // nothing to do here
End;

Procedure TEzTable.SelectionFilter( Selection: TEzSelection; ClearBefore: Boolean );
Var
  SelIndex: Integer;
  SelLayer: TEzSelectionLayer;
  Layer: TEzBaseLayer;
Begin
  If FGIS = Nil Then Exit;
  Layer:= FGis.Layers.LayerByName( FLayerName );
  if Layer = Nil then Exit;
  SelIndex := Selection.IndexOf( Layer );
  If SelIndex < 0 Then
  begin
    FGraphicFiltered:= true;
    FGraphicFilterList.Clear;
    Exit;
  end;
  SelLayer := Selection[SelIndex];
  If ClearBefore Then
    FGraphicFilterList.Clear;
  FGraphicFilterList.Assign( SelLayer.SelList );
End;

Procedure TEzTable.DoSelect( Selection: TEzSelection );
Var
  I: Integer;
Begin
  If ( FGIS = Nil ) Or ( FLayer = Nil ) Then
    Exit;
  For I := 0 To FRecords.Count - 1 Do
    Selection.Add( Layer, FRecords[I] );
End;

procedure TEzTable.GetBlobField(Field: TField; Stream: TStream);
begin
end;

procedure TEzTable.SetBlobField(Field: TField; Stream: TStream);
begin
end;


{$IFDEF BCB}
function TEzTable.GetGIS: TEzBaseGIS;
begin
  Result := FGis;
end;

function TEzTable.GetLayer: TEzBaseLayer;
begin
  Result := FLayer;
end;

function TEzTable.GetLayerName: String;
begin
  Result := FLayerName;
end;

function TEzTable.GetMapFields: TEzGISFields;
begin
  Result := FMapFields;
end;

function TEzTable.GetMaxRecords: Longint;
begin
  Result := FMaxRecords;
end;

function TEzTa