eztable.pas

很管用的GIS控件

Procedure TEzBaseDataset.SetBookmarkData( Buffer: PChar; Data: Pointer );
Begin
  If PRecordInfo( Buffer + FDataSize )^.BookMark = Nil Then
    GetMem( PRecordInfo( Buffer + FDataSize )^.BookMark, BookmarkSize );
  Move( PRecordInfo( Buffer + FDataSize ).BookMark^, Data, BookmarkSize );
End;

Procedure TEzBaseDataset.SetBookmarkFlag( Buffer: PChar; Value: TBookmarkFlag );
Begin
  PRecordInfo( Buffer + FDataSize ).BookMarkFlag := Value;
End;

Procedure TEzBaseDataset.InternalGotoBookmark( Bookmark: Pointer );
Begin
  DoGotoBookMark( BookMark );
End;

Function TEzBaseDataset.BookmarkValid( Bookmark: TBookmark ): boolean;
Begin
  result := DoBookmarkValid( Bookmark );
End;

Function TEzBaseDataset.CompareBookmarks( Bookmark1, Bookmark2: TBookmark ): Integer;
Begin
  result := DoCompareBookmarks( Bookmark1, Bookmark2 );
End;

{function TEzBaseDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
begin
  Result:=TEzBlobStream.Create(Field as TBlobField, Mode);
end; }

Procedure TEzBaseDataset.DoAfterGetFieldValue;
Begin

End;

Procedure TEzBaseDataset.DoBeforeGetFieldValue;
Begin

End;

Procedure TEzBaseDataset.DoAfterSetFieldValue( Inserting: Boolean );
Begin

End;

Procedure TEzBaseDataset.DoBeforeSetFieldValue( Inserting: Boolean );
Begin

End;

Function TEzBaseDataset.BCDToCurr( BCD: Pointer; Var Curr: Currency ): Boolean;
Begin
  Move( BCD^, Curr, SizeOf( Currency ) );
  Result := True;
End;

Function TEzBaseDataset.CurrToBCD( Const Curr: Currency; BCD: Pointer; Precision,
  Decimals: Integer ): Boolean;
Begin
  Move( Curr, BCD^, SizeOf( Currency ) );
  Result := True;
End;

Function TEzBaseDataset.FilterRecord( Buffer: PChar ): Boolean;
Begin
  result := True;
End;

{$IFDEF LEVEL4}

Procedure TEzBaseDataset.SetBlockReadSize( Value: Integer );
{$IFNDEF LEVEL5}
Var
  DoNext: Boolean;
{$ENDIF}
Begin
  If Value <> BlockReadSize Then
  Begin
    If ( Value > 0 ) Or ( Value < -1 ) Then
    Begin
      Inherited;
      BlockReadNext;
    End
    Else
    Begin
{$IFNDEF LEVEL5}
      doNext := Value = -1;
{$ENDIF}
      Value := 0;
      Inherited;

{$IFNDEF LEVEL5}
      If doNext Then
        Next
      Else
      Begin
{$ENDIF}
        CursorPosChanged;
        Resync( [] );
{$IFNDEF LEVEL5}
      End;
{$ENDIF}
    End;
  End;
End;
{$ENDIF}

//************************** TEzBlobStream ***************************************
{constructor TEzBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
Begin
  inherited Create;
  FField:=Field;
  FMode:=Mode;
  FDataSet:=FField.DataSet as TEzBaseDataset;
  if Mode<>bmWrite then LoadBlobData;
End;

destructor TEzBlobStream.Destroy;
Begin
  if FModified then SaveBlobData;
  inherited Destroy;
End;

function TEzBlobStream.Read(var Buffer; Count: Longint): Longint;
Begin
  Result:=inherited Read(Buffer,Count);
  FOpened:=True;
End;

function TEzBlobStream.Write(const Buffer; Count: Longint): Longint;
Begin
  Result:=inherited Write(Buffer,Count);
  FModified:=True;
End;

procedure TEzBlobStream.LoadBlobData;
var
  Stream: TMemoryStream;
  Offset: Integer;
  RecBuffer: PChar;
Begin
  Self.Size:=0;
  RecBuffer:=FDataset.GetActiveRecordBuffer;
  if RecBuffer<>nil then
    Begin
    Offset:=Integer(FDataset.FBufferMap.Objects[FField.FieldNo-1]);
    Move((RecBuffer+Offset)^,Pointer(Stream),sizeof(Pointer));
    Self.CopyFrom(Stream,0);
    End;
  Position:=0;
End;

procedure TEzBlobStream.SaveBlobData;
var Stream: TMemoryStream;
Offset: Integer;
RecBuffer: Pchar;
Begin
  RecBuffer:=FDataset.GetActiveRecordBuffer;
  if RecBuffer<>nil then
    Begin
    Offset:=Integer(FDataset.FBufferMap.Objects[FField.FieldNo-1]);
    Move((RecBuffer+Offset)^,Pointer(Stream),sizeof(Pointer));
    Stream.Size:=0;
    Stream.CopyFrom(Self,0);
    Stream.Position:=0;
    End;
  FModified:=False;
End; }

{-------------------------------------------------------------------------------}
//                  TEzTable
{-------------------------------------------------------------------------------}

{ TEzGISField }

Destructor TEzGISField.Destroy;
Begin
  If Assigned( FResolver ) Then
    FResolver.Free;

  Inherited Destroy;
End;

Procedure TEzGISField.Assign( Source: TPersistent );
Begin
  If Source Is TEzGISField Then
  Begin
    FExpression := TEzGISField( Source ).Expression;
    FFieldName := TEzGISField( Source ).FieldName;
    FIsExpression := TEzGISField( Source ).IsExpression;
    FreeAndNil( FResolver );
  End
  Else
    Inherited Assign( Source );
End;

Function TEzGISField.GetCaption: String;
Begin
  result := FFieldName;
End;

Function TEzGISField.GetDisplayName: String;
Begin
  result := GetCaption;
  If Result = '' Then
    Result := Inherited GetDisplayName;
End;

Procedure TEzGISField.SetExpression( Const Value: String );
Begin
  FExpression := Value;
  FFieldName := Value;
End;

{ TEzGISFields }

Constructor TEzGISFields.Create( AOwner: TEzTable );
Begin
  FOwner := AOwner;
  Inherited Create( AOwner, TEzGISField );
End;

Function TEzGISFields.Add: TEzGISField;
Begin
  Result := TEzGISField( Inherited Add );
End;

Function TEzGISFields.GetItem( Index: Integer ): TEzGISField;
Begin
  Result := TEzGISField( Inherited GetItem( Index ) );
End;

Procedure TEzGISFields.SetItem( Index: Integer; Value: TEzGISField );
Begin
  Inherited SetItem( Index, Value );
End;

{$IFDEF LEVEL5}

Procedure TEzGISFields.Move( FromIndex, ToIndex: Integer );
Var
  Moved: TEzGISField;
Begin
  Moved := TEzGISField.Create( Self );
  Moved.Assign( GetItem( FromIndex ) );
  Delete( FromIndex );
  Insert( ToIndex );
  GetItem( ToIndex ).Assign( Moved );
  Moved.Free;
End;
{$ENDIF}

Procedure TEzGISFields.PopulateFromLayer( Const Layer: TEzBaseLayer );
Var
  I: Integer;
Begin
  If ( Layer = Nil ) Or ( Layer.DBTable = Nil ) Then exit;

  Clear;
  With Add Do
  Begin
    Expression := 'TYPE(ENT)';
    IsExpression := TRUE;
  End;
  For I := 1 To Layer.DBTable.FieldCount Do
    With Add Do
    Begin
      SourceField := I;
      Expression := Layer.DBTable.Field( I );
      FieldName := Expression;
      IsExpression := False;
    End;
End;

Type

  TMapBlobStream = Class( TMemoryStream )
  Private
    FField: TBlobField;
    FDataSet: TEzTable;
    FIndex: Integer;
    Procedure ReadBlobData;
  Public
    Constructor Create( Field: TBlobField; Mode: TBlobStreamMode );
  End;

Constructor TMapBlobStream.Create( Field: TBlobField; Mode: TBlobStreamMode );
Begin
  Inherited Create;
  FField := Field;
  FIndex := FField.Index;
  FDataSet := FField.DataSet As TEzTable;
  If Mode = bmRead Then
    ReadBlobData;
  If Mode <> bmRead Then
  Begin
    If FField.ReadOnly Then
      DatabaseErrorFmt( 'Field ''%s'' cannot be modified', [FField.DisplayName] );
    If Not ( FDataSet.State In [dsEdit, dsInsert] ) Then
      DatabaseError( SBlobErrNotEditing );
  End;
  If Mode = bmWrite Then
    Clear
  Else
    ReadBlobData;
End;

Procedure TMapBlobStream.ReadBlobData;
Var
  MapField: TEzGISField;
  n: Integer;
Begin
  If FDataSet.RecNo < 1 Then
    Exit;
  MapField := TEzTable( FDataSet ).FMapFields[FIndex];
  n := FDataSet.SourceRecNo;
  With TEzTable( FDataSet ).Layer Do
  Begin
    Recno := n;
    If DBTable <> Nil Then
      DBTable.Recno := n;
    If DBTable <> Nil Then
      DBTable.MemoLoadN( MapField.SourceField, Self );
    //(MapField.SourceField as TBlobField).SaveToStream(Self);
  End;
  Self.Position := 0;
End;

{ TEzTable }

Constructor TEzTable.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FMapFields := TEzGISFields.Create( Self );
  FRecords := TIntegerList.Create;
  FGraphicFilterList := TIntegerList.Create;
  FUseDeleted := True;
End;

Destructor TEzTable.Destroy;
Begin
  Inherited Destroy;
  FMapFields.Free;
  FRecords.Free;
  If Assigned( FFilterExpr ) Then
    FFilterExpr.Free;
  If Assigned( FFindExpr ) Then
    FFindExpr.Free;
  FGraphicFilterList.Free;
End;

Function TEzTable.CreateBlobStream( Field: TField; Mode: TBlobStreamMode ): TStream;
Begin
  Result := TMapBlobStream.Create( Field As TBlobField, Mode );
End;

Procedure TEzTable.SetBaseLayer;
Begin
  If FGIS = Nil Then Exit;
  FLayer := Nil;
  If Length( FLayerName ) > 0 Then
    FLayer := FGIS.Layers.LayerByName( FLayerName );
End;

Function TEzTable.DoOpen: Boolean;
Var
  I: Integer;
Begin
  If csDesigning In ComponentState Then
    DatabaseError( SCannotOpenDesignMode );

  If FLayer = Nil Then
    SetBaseLayer;

  If ( FLayer = Nil ) Or Not ( Flayer.Active ) Then
    DatabaseError( SLayerNotAssigned );

  If FMapFields.Count = 0 Then
    FMapFields.PopulateFromLayer( FLayer )
  Else
    { check if FMapFields is defined correctly }
    For I := 0 To FMapFields.Count - 1 Do
      With FMapFields[I] Do
        If Not IsExpression Then
        Begin
          If Layer.DBTable = Nil Then
            DatabaseError( SLayerEmpty );
          If Length( FieldName ) = 0 Then
            DatabaseError( SExpressionEmpty );
          If FLayer.DBTable.FieldNo( FieldName ) = 0 Then
            DatabaseError( Format( SWrongFieldnameCol, [I] ) );
        End
        Else
        Begin
          If Length( FieldName ) = 0 Then
            DatabaseError( SExpressionEmpty );
        End;

  { create the list of records}
  If Assigned( FFilterExpr ) Then
    FreeAndNil( FFilterExpr );

  RebuildRecordList;

  FCurRec := -1;

  Result := True;

End;

Procedure TEzTable.RebuildRecordList;
Var
  I, N, Idx1, Idx2, K: Integer;
  DoFilter, Accepted: Boolean;
Begin
  DoFilter := false;
  If Filtered And ( Length( Filter ) > 0 ) Then
  Begin
    CreateFilterExpr( Filter );
    DoFilter := true;
  End;
  N := FLayer.RecordCount;
  If ( FGraphicFilterList.Count > 0 ) Or FGraphicFiltered Then
  Begin
    Idx1 := 0;
    Idx2 := FGraphicFilterList.Count - 1;
    FGraphicFiltered := true;
  End
  Else
  Begin
    Idx1 := 1;
    Idx2 := N;
    FGraphicFiltered := false;
  End;

  FRecords.Clear;
  FRecords.Capacity := N;
  For I := Idx1 To Idx2 Do
  Begin
    If FGraphicFiltered Then
      K := FGraphicFilterList[I]
    Else
      K := I;
    If Not FUseDeleted Then
    Begin
      FLayer.RecNo := K;
      If FLayer.RecIsDeleted Then
        Continue;
    End;
    Accepted := true;
    If DoFilter Then
    Begin
      FLayer.Recno := K;
      FLayer.Synchronize;
      Accepted:= True;
      if FFilterExpr.Expression <> Nil then
        Accepted := FFilterExpr.Expression.AsBoolean;