eztable.pas

很管用的GIS控件

Unit EzTable;

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

{$I EZ_FLAG.PAS}
Interface

Uses
  Classes, SysUtils, Windows, Forms, DB, EzSystem, EzBaseGIS, EzBase,
  EzBaseExpr, EzLib, EzExpressions
{$IFDEF LEVEL6}
  , Variants
{$ENDIF}
  ;

Type
  {-------------------------------------------------------------------------------}
  //                  TGXBaseDataset
  {-------------------------------------------------------------------------------}

  TEzBaseDataset = Class( TDataset )
  Private
    FisOpen: Boolean;
    FStartCalculated: Integer;
    FBufferMap: TStringList;
    FRecordSize: Integer; // full buffer size
    FDataSize: Integer; // from bull buffer, only the data size
    //FInternalBookmarkSize: Integer;
    Procedure FillBufferMap;
    Procedure AllocateBLOBPointers( Buffer: PChar );
    Procedure FreeBlobPointers( Buffer: PChar );
  Protected {My simplified methods to override}
    Function DoOpen: Boolean; Virtual; Abstract;
    Procedure DoClose; Virtual; Abstract;
    Procedure DoDeleteRecord; Virtual;
    Procedure DoCreateFieldDefs; Virtual; Abstract;
    Function GetFieldValue( Field: TField ): Variant; Virtual; Abstract;
    Procedure SetFieldValue( Field: TField; Const Value: Variant ); Virtual; Abstract;
    Procedure GetBlobField( Field: TField; Stream: TStream ); Virtual; Abstract;
    Procedure SetBlobField( Field: TField; Stream: TStream ); Virtual; Abstract;
    //Called before and after getting a set of field values
    Procedure DoBeforeGetFieldValue; Virtual;
    Procedure DoAfterGetFieldValue; Virtual;
    Procedure DoBeforeSetFieldValue( Inserting: Boolean ); Virtual;
    Procedure DoAfterSetFieldValue( Inserting: Boolean ); Virtual;
    //Handle buffer ID
    Function AllocateRecordID: Pointer; Virtual; Abstract;
    Procedure DisposeRecordID( Value: Pointer ); Virtual; Abstract;
    Procedure GotoRecordID( Value: Pointer ); Virtual; Abstract;
    //BookMark functions
    Function GetBookMarkSize: Integer; Virtual;  //******
    Procedure DoGotoBookmark( Bookmark: Pointer ); Virtual; Abstract;  //********
    Procedure AllocateBookMark( RecordID: Pointer; Bookmark: Pointer ); Virtual; Abstract;
    //Navigation methods
    Procedure DoFirst; Virtual; Abstract;
    Procedure DoLast; Virtual; Abstract;
    Function Navigate( Buffer: PChar; GetMode: TGetMode; doCheck: Boolean ): TGetResult; Virtual; Abstract;
    //Internal isOpen property
    Property isOpen: Boolean Read FisOpen;
    Function FilterRecord( Buffer: PChar ): Boolean; Virtual;
    Function DoBookmarkValid( Bookmark: TBookmark ): boolean; Virtual; Abstract;
    Function DoCompareBookmarks( Bookmark1, Bookmark2: TBookmark ): Integer; Virtual; Abstract;
  Protected {TEzBaseDataset Internal functions that can be overriden if needed}
    Procedure AllocateBLOBPointer( Field: TField; Var P: Pointer ); Virtual;
    Procedure FreeBLOBPointer( Field: TField; Var P: Pointer ); Virtual;
    Procedure FreeRecordPointers( Buffer: PChar ); Virtual;
    Function GetDataSize: Integer; Virtual;
    Procedure BufferToRecord( Buffer: PChar ); Virtual;
    Procedure RecordToBuffer( Buffer: PChar ); Virtual;
  Protected
    Function AllocRecordBuffer: PChar; Override;
    Procedure FreeRecordBuffer( Var Buffer: PChar ); Override;
    Function GetRecord( Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean ): TGetResult; Override;
    Function GetRecordSize: Word; Override;
    Procedure InternalInsert; Override;
    Procedure InternalClose; Override;
    Procedure InternalDelete; Override;
    Procedure InternalFirst; Override;
    Procedure InternalEdit; Override;
    Procedure InternalHandleException; Override;
    Procedure InternalInitFieldDefs; Override;
    Procedure InternalInitRecord( Buffer: PChar ); Override;
    Procedure InternalLast; Override;
    Procedure InternalOpen; Override;
    Procedure InternalPost; Override;
    Procedure InternalSetToRecord( Buffer: PChar ); Override;
    Procedure InternalAddRecord( Buffer: Pointer; Append: Boolean ); Override;
    Function IsCursorOpen: Boolean; Override;
    Function GetCanModify: Boolean; Override;
    Procedure ClearCalcFields( Buffer: PChar ); Override;
    Function GetActiveRecordBuffer: PChar; Virtual;
    Procedure SetFieldData( Field: TField; Buffer: Pointer ); Override;
    Procedure GetBookmarkData( Buffer: PChar; Data: Pointer ); Override;
    Function GetBookmarkFlag( Buffer: PChar ): TBookmarkFlag; Override;
    Procedure SetBookmarkFlag( Buffer: PChar; Value: TBookmarkFlag ); Override;
    Procedure SetBookmarkData( Buffer: PChar; Data: Pointer ); Override;
    Procedure InternalGotoBookmark( Bookmark: Pointer ); Override;

    Function BCDToCurr( BCD: Pointer; Var Curr: Currency ): Boolean;
{$IFNDEF LEVEL5} Override;
{$ENDIF}
    Function CurrToBCD( Const Curr: Currency; BCD: Pointer; Precision, Decimals: Integer ): Boolean;
{$IFNDEF LEVEL5} Override;
{$ENDIF}
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Function GetFieldData( Field: TField; Buffer: Pointer ): Boolean; Override;
    Function BookmarkValid( Bookmark: TBookmark ): boolean; Override;
    Function CompareBookmarks( Bookmark1, Bookmark2: TBookmark ): Integer; Override;
    //function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
{$IFDEF LEVEL4}
    Procedure SetBlockReadSize( Value: Integer ); Override;
{$ENDIF}
  Published
    { inherited events }
    Property BeforeOpen;
    Property AfterOpen;
    Property BeforeClose;
    Property AfterClose;
    Property BeforeInsert;
    Property AfterInsert;
    Property BeforeEdit;
    Property AfterEdit;
    Property BeforePost;
    Property AfterPost;
    Property BeforeCancel;
    Property AfterCancel;
    Property BeforeDelete;
    Property AfterDelete;
    Property BeforeScroll;
    Property AfterScroll;
    Property OnCalcFields;
    Property OnDeleteError;
    Property OnEditError;
    Property OnFilterRecord;
    Property OnNewRecord;
    Property OnPostError;
  End;

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

    { for browse one layer }
  TEzGISField = Class( TCollectionItem )
  Private
    FExpression: String;
    FFieldName: String; // used as the TField.FieldName when IsExpression=true
    FIsExpression: Boolean;
    SourceField: Integer; // runtime only
    FResolver: TEzMainExpr; // runtime only
    Procedure SetExpression( Const Value: String ); // used only when FIsExpresion=true
  Protected
    Function GetDisplayName: String; Override;
    Function GetCaption: String;
  Public
    Destructor Destroy; Override;
    Procedure Assign( Source: TPersistent ); Override;

    Property Resolver: TEzMainExpr Read FResolver Write FResolver;
  Published
    Property Expression: String Read FExpression Write SetExpression;
    Property FieldName: String Read FFieldName Write FFieldName;
    Property IsExpression: Boolean Read FIsExpression Write FIsExpression;
  End;

  TEzTable = Class;

  TEzGISFields = Class( TOwnedCollection )
  Private
    FOwner: TEzTable;
    Function GetItem( Index: Integer ): TEzGISField;
    Procedure SetItem( Index: Integer; Value: TEzGISField );
  Public
    Constructor Create( AOwner: TEzTable );
    Function Add: TEzGISField;
    Procedure PopulateFromLayer( Const Layer: TEzBaseLayer );
{$IFDEF LEVEL5}
    Procedure Move( FromIndex, ToIndex: Integer );
{$ENDIF}

    Property Items[Index: Integer]: TEzGISField Read GetItem Write SetItem; Default;
  End;

  TEzTable = Class( TEzBaseDataset )
  Private
    FGIS: TEzBaseGIS;
    FMapFields: TEzGISFields;
    FLayer: TEzBaseLayer;
    FRecords: TIntegerList;
    FFindExpr: TEzMainExpr;
    FFilterExpr: TEzMainExpr;
    FUseDeleted: Boolean;
    FRecordCount: Integer;
    FMaxRecords: Integer;
    FCurRec: Integer;
    FReadOnly: Boolean;
    FFindRow: Integer;
    FLayerName: String;
    { for filtering graphically the database }
    FGraphicFilterList: TIntegerList;
    FGraphicFiltered: Boolean;
    Procedure AddFieldDesc( FieldNo: Word );
    Procedure SetBaseLayer;
    Procedure CreateFilterExpr( Const Text: String );
    Procedure RebuildRecordList;
    Function GetSourceRecNo: Integer;
    Procedure SetGIS( Const Value: TEzBaseGIS );
    Procedure SetReadOnly( Value: Boolean );
    Procedure SetFilterData( Const Text: String );
    Function DoFindFirst: Boolean;
    Procedure SetLayerName( Const Value: String );
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  {$IFDEF BCB}
    function GetGIS: TEzBaseGIS;
    function GetLayer: TEzBaseLayer;
    function GetLayerName: String;
    function GetMapFields: TEzGISFields;
    function GetMaxRecords: Longint;
    function GetReadOnly: Boolean;
    function GetUseDeleted: Boolean;
    procedure SetLayer(const Value: TEzBaseLayer);
    procedure SetMaxRecords(const Value: Longint);
    procedure SetUseDeleted(const Value: Boolean);
  {$ENDIF}
  Protected
    Function FilterRecord( Buffer: PChar ): Boolean; Override;
    Procedure InternalRefresh; Override;
    Function DoOpen: Boolean; Override;
    Procedure DoClose; Override;
    Procedure DoDeleteRecord; Override;
    Procedure DoCreateFieldDefs; Override;
    Function GetFieldValue( Field: TField ): Variant; Override;
    Procedure SetFieldValue( Field: TField; Const Value: Variant ); Override;
    //Handle buffer ID
    Function AllocateRecordID: Pointer; Override;
    Procedure DisposeRecordID( Value: Pointer ); Override;
    Procedure GotoRecordID( Value: Pointer ); Override;
    //BookMark functions
    Function GetBookMarkSize: Integer; Override;
    Procedure DoGotoBookmark( Bookmark: Pointer ); Override;
    Procedure AllocateBookMark( RecordID: Pointer; Bookmark: Pointer ); Override;
    Function DoBookmarkValid( Bookmark: TBookmark ): boolean; Override;
    Function DoCompareBookmarks( Bookmark1, Bookmark2: TBookmark ): Integer; Override;
    Procedure DoBeforeGetFieldValue; Override;
    //Navigation methods
    Procedure DoFirst; Override;
    Procedure DoLast; Override;
    Function Navigate( Buffer: PChar; GetMode: TGetMode; doCheck: Boolean ): TGetResult; Override;
    Procedure AllocateBLOBPointer( Field: TField; Var P: Pointer ); Override;
    Procedure FreeBLOBPointer( Field: TField; Var P: Pointer ); Override;
    //Called before and after getting a set of field values
    //procedure DoBeforeGetFieldValue; override;
    //procedure DoAfterGetFieldValue; override;
    Procedure DoBeforeSetFieldValue( Inserting: Boolean ); Override;
    //procedure DoAfterSetFieldValue(Inserting: Boolean); override;
    // other
    Function GetRecordCount: Integer; Override;
    Procedure SetRecNo( Value: Integer ); Override;
    Function GetRecNo: Integer; Override;
    Procedure Notification( AComponent: TComponent; Operation: toperation ); Override;
    Procedure SetFilterText( Const Value: String ); Override;
    Procedure SetFiltered( Value: Boolean ); Override;
    Function GetCanModify: Boolean; Override;
    Procedure GetBlobField( Field: TField; Stream: TStream ); Override;
    Procedure SetBlobField( Field: TField; Stream: TStream ); Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Function IsSequenced: Boolean; Override;
    Function Locate( Const KeyFields: String; Const KeyValues: Variant;
      Options: TLocateOptions ): Boolean; Override;
    Function Lookup( Const KeyFields: String;
      Const KeyValues: Variant; Const ResultFields: String ): Variant; Override;

    Function CreateBlobStream( Field: TField; Mode: TBlobStreamMode ): TStream; Override;
    Function Find( Const Expression: String; Direction: TEzDirection; Origin: TEzOrigin ): Boolean;
    Function FindNext: Boolean;
    Procedure OrderBy( Const Expression: String; Descending: Boolean );
    Procedure UnSort;
    Function IsDeleted: boolean;
    Procedure Recall;
    Procedure SelectionFilter( Selection: TEzSelection; ClearBefore: Boolean );
    Procedure ScopeFilter( Const Scope: String; ClearBefore: Boolean );
    Procedure PolygonFilter( Polygon: TEzEntity; Operator: TEzGraphicOperator;
      Const QueryExpression: String; ClearBefore: Boolean );
    Procedure RectangleFilter( Const AxMin, AyMin, AxMax, AyMax: Double;
      Operator: TEzGraphicOperator; Const QueryExpression: String;
      ClearBefore: Boolean );
    Procedure BufferFilter( Buffer: TEzEntity; Operator: TEzGraphicOperator;
      Const QueryExpression: String; CurvePoints: Integer;
      Const Distance: Double; ClearBefore: Boolean );
    Procedure PolylineIntersects( Polyline: TEzEntity;
      Const QueryExpression: String; ClearBefore: Boolean );
    Procedure FilterFromLayer( SourceLayer: TEzBaseLayer;
      Const QueryExpression: String; Operator: TEzGraphicOperator; ClearBefore: Boolean );
    Procedure DoSelect( Selection: TEzSelection );

    Property SourceRecNo: Integer Read GetSourceRecNo;
    Property Layer: TEzBaseLayer {$IFDEF BCB} Read GetLayer Write SetLayer {$ELSE} Read FLayer Write FLayer {$ENDIF};
  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property ReadOnly: Boolean {$IFDEF BCB} Read GetReadOnly {$ELSE} Read FReadOnly {$ENDIF} Write SetReadOnly Default False;
    Property MaxRecords: Longint {$IFDEF BCB} Read GetMaxRecords Write SetMaxRecords {$ELSE} Read FMaxRecords Write FMaxRecords {$ENDIF};
    Property GIS: TEzBaseGIS {$IFDEF BCB} Read GetGIS {$ELSE} Read FGIS {$ENDIF} Write SetGIS;
    Property UseDeleted: Boolean {$IFDEF BCB} Read GetUseDeleted Write SetUseDeleted {$ELSE} Read FUseDeleted Write FUseDeleted {$ENDIF} Default True;
    Property MapFields: TEzGISFields {$IFDEF BCB} Read GetMapFields {$ELSE} Read FMapFields {$ENDIF};
    Property LayerName: String {$IFDEF BCB} Read GetLayerName {$ELSE} Read FLayerName {$ENDIF} Write SetLayerName;

    { inherited properties }
    Property Filter;
    Property Filtered;

  End;

  { TDesignTable - a dataset used for editing fields when restructuring }
  TEzDesignTable = Class( TEzBaseDataset )
  Private
    FNameColumn: TStringList;
    FAliasColumn: TStringList;
    FTypeColumn: TStringList;
    FSizeColumn: TIntegerList;
    FDecColumn: TIntegerList;
    FOrigFieldNoColumn: TIntegerList;
    FRecordCount: Integer;
    FCurRec: Integer;
    FModified: Boolean;
  Protected
    Procedure InternalRefresh; Override;
    Function DoOpen: Boolean; Override;
    Procedure DoClose; Override;
    Procedure DoDeleteRecord; Override;
    Procedure DoCreateFieldDefs; Override;
    Function GetFieldValue( Field: TField ): Variant; Override;
    Procedure SetFieldValue( Field: TField; Const Value: Variant ); Override;
    //Handle buffer ID
    Function AllocateRecordID: Pointer; Override;
    Procedure DisposeRecordID( Value: Pointer ); Override;
    Procedure GotoRecordID( Value: Pointer ); Override;
    //BookMark functions
    Function GetBookMarkSize: Integer; Override;
    Procedure DoGotoBookmark( Bookmark: Pointer ); Override;
    Procedure AllocateBookMark( RecordID: Pointer; Bookmark: Pointer ); Override;
    Function DoBookmarkValid( Bookmark: TBookmark ): boolean; Override;
    Function DoCompareBookmarks( Bookmark1, Bookmark2: TBookmark ): Integer; Override;
    //Navigation methods
    Procedure DoFirst; Override;
    Procedure DoLast; Override;
    Function Navigate( Buffer: PChar; GetMode: TGetMode; doCheck: Boolean ): TGetResult; Override;
    //Called before and after getting a set of field values
    procedure DoBeforeGetFieldValue; override;
    procedure DoAfterGetFieldValue; override;
    Procedure DoBeforeSetFieldValue( Inserting: Boolean ); Override;
    procedure DoAfterSetFieldValue(Inserting: Boolean); override;
    Procedure GetBlobField( Field: TField; Stream: TStream ); Override;
    Procedure SetBlobField( Field: TField; Stream: TStream ); Override;
    // other
    Function GetRecordCount: Integer; Override;
    Procedure SetRecNo( Value: Integer ); Override;
    Function GetRecNo: Integer; Override;
    Function GetCanModify: Boolean; Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Function IsSequenced: Boolean; Override;
  End;

Implementation

Uses
  EzConsts;

type

  PRecordInfo = ^TRecordInfo;
  TRecordInfo = Record
    RecordID: Pointer;
    Bookmark: Pointer;
    BookMarkFlag: TBookmarkFlag;
  End;


{-------------------------------------------------------------------------------}
//                  TEzBaseDataset
{-------------------------------------------------------------------------------}

Constructor TEzBaseDataset.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FBufferMap := TStringList.Create;
End;

Destructor TEzBaseDataset.Destroy;
Begin
  If Active Then
    Close;
  FBufferMap.Free;
  Inherited Destroy;
End;

Procedure TEzBaseDataset.FillBufferMap;
Var
  Index, Offset: Integer;
Begin
  FBufferMap.Clear;
  Offset := 0;
  For Index := 0 To FieldCount - 1 Do
  Begin
    FBufferMap.AddObject( Fields[Index].FieldName, Pointer( Offset ) );
    Case FieldbyName( FBufferMap[Index] ).DataType Of
      ftString: inc( Offset, FieldbyName( FBufferMap[Index] ).Size + 1 );
      ftInteger, ftSmallInt, ftDate, ftTime: inc( Offset, sizeof( Integer ) );
      ftDateTime, ftFloat, ftBCD, ftCurrency: inc( Offset, sizeof( Double ) );
      ftBoolean: inc( Offset, sizeof( WordBool ) );
      ftGraphic, ftMemo: inc( Offset, sizeof( Pointer ) );
    End;
  End;
End;

Procedure TEzBaseDataset.InternalOpen;
Begin
  If DoOpen Then
  Begin
    BookmarkSize := GetBookMarkSize; //Bookmarks not supported
    InternalInitFieldDefs;
    If DefaultFields Then
      CreateFields;
    BindFields( True );
    FisOpen := True;
    FillBufferMap;
    FRecordSize := GetRecordSize;
  End;
End;

Function TEzBaseDataset.AllocRecordBuffer: PChar;
Begin
  GetMem( Result, FRecordSize );
  FillChar( Result^, FRecordSize, 0 );
  AllocateBlobPointers( Result );
End;

Procedure TEzBaseDataset.FreeRecordBuffer( Var Buffer: PChar );
Begin
  FreeRecordPointers( Buffer );
  FreeMem( Buffer, FRecordSize );
End;

Procedure TEzBaseDataset.FreeRecordPointers( Buffer: PChar );
Begin
  FreeBlobPointers( Buffer );
  DisposeRecordID( PRecordInfo( Buffer + FDataSize ).RecordID );
  If PRecordInfo( Buffer + FDataSize )^.BookMark <> Nil Then
  Begin