ezibgis.pas

很管用的GIS控件

Unit EzIBGIS;

{$I EZ_FLAG.PAS}
//{$DEFINE IBTRIAL_VERSION}
//{$DEFINE COMPRESSED_ENTITY} //uncomment if you want to compress entity when saving
Interface

Uses
  SysUtils, Windows, Classes, Graphics, Controls, forms, db,
  IBSQL, IBDatabase, ezbasegis, ezbase, ezlib, ezprojections,
  ezrtree, ezbaseexpr;

// this constant delimits how many records to pass right in the sql by converting
// integer values to string format, instead of using a temporary table
// increase if Interbase can support more records in a IN() clause
const
  MAX_RECORDS_SQL_IN_CLAUSE = 1500;

Type

  TEzIBField = Class;

  { we have here the information needed by the client local configuration
    in order to avoid having the server updated with configuration needed at that
    moment by the client }

  TEzIBLayerClientData = Class
  Private
    CoordsUnits: TEzCoordsUnits;
    CoordsUnits_init: Boolean;
    CoordSystem: TEzCoordSystem;
    CoordSystem_init: Boolean;
    Visible: Boolean;
    Visible_init: Boolean;
    Selectable: Boolean;
    Selectable_init: Boolean;
    TextHasShadow: Boolean;
    TextHasShadow_init: Boolean;
    TextFixedSize: Byte;
    TextFixedSize_init: Boolean;
    OverlappedTextAction: TEzOverlappedTextAction;
    OverlappedTextAction_init: Boolean;
    OverlappedTextColor: TColor;
    OverlappedTextColor_init: Boolean;
    RecCount: Integer;
    RecCount_init: Boolean;
  Public
    Procedure Invalidate;
  End;

  TEzIBLayerInfo = Class( TEzBaseLayerInfo )
  Private
    FClientData: TEzIBLayerClientData;
  {$IFDEF BCB} (*_*)
    function GetClientData: TEzIBLayerClientData;
  {$ENDIF}
  Protected
    Function GetOverlappedTextAction: TEzOverlappedTextAction; Override;
    Procedure SetOverlappedTextAction( Value: TEzOverlappedTextAction ); Override;
    Function GetOverlappedTextColor: TColor; Override;
    Procedure SetOverlappedTextColor( Value: TColor ); Override;
    Function GetTextHasShadow: Boolean; Override;
    Procedure SetTextHasShadow( Value: Boolean ); Override;
    Function GetTextFixedSize: Byte; Override;
    Procedure SetTextFixedSize( Value: Byte ); Override;
    Function GetVisible: Boolean; Override;
    Procedure SetVisible( Value: Boolean ); Override;
    Function GetSelectable: Boolean; Override;
    Procedure SetSelectable( Value: Boolean ); Override;
    Function GetIsCosmethic: Boolean; Override;
    Procedure SetIsCosmethic( value: Boolean ); Override;
    Function GetExtension: TEzRect; Override;
    Procedure SetExtension( Const Value: TEzRect ); Override;
    Function GetIDCounter: integer; Override;
    Procedure SetIDCounter( Value: integer ); Override;
    Function GetIsAnimationLayer: Boolean; Override;
    Procedure SetIsAnimationLayer( Value: Boolean ); Override;
    Function GetIsIndexed: Boolean; Override;
    Procedure SetIsIndexed( Value: Boolean ); Override;
    Function GetCoordsUnits: TEzCoordsUnits; Override;
    Procedure SetCoordsUnits( Value: TEzCoordsUnits ); Override;
    Function GetCoordSystem: TEzCoordSystem; Override;
    Procedure SetCoordSystem( Value: TEzCoordSystem ); Override;
    Function GetUseAttachedDB: Boolean; Override;
    Procedure SetUseAttachedDB( Value: Boolean ); Override;
  Public
    Constructor Create( Layer: TEzBaseLayer ); Override;
    Destructor Destroy; Override;

    Property ClientData: TEzIBLayerClientData
      read {$IFDEF BCB} GetClientData {$ELSE} FClientData {$ENDIF}; (*_*)
  End;


  { TEzIBLayer - class definition }

  TEzIBLayer = Class( TEzBaseLayer )
  Private
    FDBTable: TEzBaseTable;
    { for the layer Header }
    FIBHeader: TIBSQL;
    FIBField: TEzIBField;           // read/write fields from the header of the layer
    { for the entities  }
    FIBEntities: TIBSQL;
    FFiltered: Boolean;
    FIsOpen: Boolean;
    FUpdateRtree: Boolean;
    FBatchUpdate: Boolean;
    Procedure BuildRTreeInMemory(var rt: TRTree);
    Procedure UpdateMapExtension( Const R: TEzRect );
    Function InternalLoadEntity( IBSQL: TIBSQL ): TEzEntity;
    Function DataSet: TIBSQL;
  {$IFDEF BCB} (*_*)
    function GetIBEntities: TIBSQL;
  {$ENDIF}
  Protected
    Function GetRecno: Integer; Override;
    Procedure SetRecno( Value: Integer ); Override;
    Function GetRecordCount: Integer; Override;
    Function GetDBTable: TEzBaseTable; Override;
    Function GetActive: Boolean; Override;
    Procedure SetActive( Value: Boolean ); Override;
  Public
    Constructor Create( Layers: TEzBaseLayers; Const AFileName: String ); Override;
    Destructor Destroy; Override;
    Procedure InitializeOnCreate( Const FileName: String;
      AttachedDB, IsAnimation: Boolean; CoordSystem: TEzCoordSystem;
      CoordsUnits: TEzCoordsUnits; FieldList: TStrings ); Override;
    Procedure Assign( Source: TEzBaseLayer ); Override;
    Procedure Open; Override;
    Procedure Close; Override;
    Procedure ForceOpened; Override;
    Procedure WriteHeaders( FlushFiles: Boolean ); Override;
    Function AddEntity( Entity: TEzEntity ): Integer; Override;
    Procedure DeleteEntity( RecNo: Integer ); Override;
    Procedure UnDeleteEntity( RecNo: Integer ); Override;
    Function UpdateExtension: TEzRect; Override;
    Function QuickUpdateExtension: TEzRect; Override;
    Function LoadEntityWithRecNo( RecNo: Longint ): TEzEntity; Override;
    Procedure UpdateEntity( RecNo: Integer; Entity2D: TEzEntity ); Override;
    Procedure Pack( ShowMessages: Boolean ); Override;
    Procedure Zap; Override;

    Procedure First; Override;
    Procedure Last; Override;
    Procedure Next; Override;
    Function Eof: Boolean; Override;
    Procedure Synchronize; Override;
    Procedure StartBuffering; Override;
    Procedure EndBuffering; Override;
    Procedure SetGraphicFilter( s: TSearchType; Const visualWindow: TEzRect ); Override;
    Procedure CancelFilter; Override;
    Function ContainsDeleted: Boolean; Override;
    Procedure Recall; Override;

    Function GetBookmark: Pointer; Override;
    Procedure GotoBookmark( Bookmark: Pointer ); Override;
    Procedure FreeBookmark( Bookmark: Pointer ); Override;

    Function SendEntityToBack( ARecno: Integer ): Integer; Override;
    Function BringEntityToFront( ARecno: Integer ): Integer; Override;
    Function RecIsDeleted: Boolean; Override;
    Procedure RecLoadEntity2( Entity: TEzEntity ); Override;
    Function RecLoadEntity: TEzEntity; Override;
    Function RecExtension: TEzRect; Override;
    Function RecEntityID: TEzEntityID; Override;
    Procedure StartBatchInsert; Override;
    Procedure CancelBatchInsert; Override;
    Procedure FinishBatchInsert; Override;
    Procedure GetFieldList( Strings: TStrings ); Override;

    Procedure RebuildTree; Override;

    Procedure CopyRecord( SourceRecno, DestRecno: Integer ); Override;
    Function DefineScope( Const Scope: String ): Boolean; Override;
    Function DefinePolygonScope( Polygon: TEzEntity; Const Scope: String;
      Operator: TEzGraphicOperator ): Boolean; Override;
    Function IsClientServer: Boolean; Override;
    Function DeleteLayerFiles: Boolean; Override;
    function GetExtensionForRecords( List: TIntegerList ): TEzRect; Override;

    { for the entities  }
    Property IBEntities: TIBSQL Read {$IFDEF BCB} GetIBEntities {$ELSE} FIBEntities {$ENDIF}; (*_*)
  End;


  { TEzIBLayers - class definition }

  TEzIBLayers = Class( TEzBaseLayers )
  Public
    Function Add( Const FileName: String; LayerType: TEzLayerType ): Integer; Override;
    Function CreateNew( Const FileName: String; FieldList: TStrings = Nil): TEzBaseLayer; Override;
    Function CreateNewEx( Const FileName: String;
                          CoordSystem: TEzCoordSystem;
                          CoordsUnits: TEzCoordsUnits;
                          FieldList: TStrings = Nil ): TEzBaseLayer; Override;
    Function CreateNewCosmethic( Const FileName: String ): TEzBaseLayer; Override;
    Function CreateNewAnimation( Const FileName: String ): TEzBaseLayer; Override;
    Function Delete( Const LayerName: String; DeleteFiles: Boolean ): Boolean; Override;
    Function IsClientServer: Boolean; Override;
  End;


  { TEzIBField - this class is used for reading info from tables that contains
    only one record, like the header on the layer or the map header }

  TEzIBField = Class
  Private
    FTableName: String;
    FIBSQL: TIBSQL;
    Procedure OpenIBSQL( Const ASQL: String );
    Procedure ExecuteIBSQL( Const Asql: String );
    Function GetAsBoolean( Const FieldName: String ): Boolean;
    Function GetAsDateTime( Const FieldName: String ): TDateTime;
    Function GetAsFloat( Const FieldName: String ): Double;
    Function GetAsInteger( Const FieldName: String ): Integer;
    Function GetAsString( Const FieldName: String ): String;
    Procedure SetAsBoolean( Const FieldName: String; Const Value: Boolean );
    Procedure SetAsDateTime( Const FieldName: String; Const Value: TDateTime );
    Procedure SetAsFloat( Const FieldName: String; Const Value: Double );
    Procedure SetAsInteger( Const FieldName: String; Const Value: Integer );
    Procedure SetAsString( Const FieldName, Value: String );
    Function GetIsNull( Const FieldName: String ): Boolean;
  Public
    Constructor Create( Const TableName: String; IBSQL: TIBSQL );
    Procedure ReadBlob( Const FieldName: String; stream: TStream );
    Procedure WriteBlob( Const FieldName: String; stream: TStream );
    Procedure SetAsNull( Const FieldName: String );

    Property AsString[Const FieldName: String]: String Read GetAsString Write SetAsString;
    Property AsInteger[Const FieldName: String]: Integer Read GetAsInteger Write SetAsInteger;
    Property AsBoolean[Const FieldName: String]: Boolean Read GetAsBoolean Write SetAsBoolean;
    Property AsFloat[Const FieldName: String]: Double Read GetAsFloat Write SetAsFloat;
    Property AsDateTime[Const FieldName: String]: TDateTime Read GetAsDateTime Write SetAsDateTime;
    Property IsNull[Const FieldName: String]: Boolean Read GetIsNull;
  End;

  { TEzIBMapClientData }
  TEzIBMapClientData = Class
  Private
    CurrentLayer: String;
    CurrentLayer_init: Boolean;
    AerialViewLayer: String;
    AerialViewLayer_init: Boolean;
    CoordsUnits: TEzCoordsUnits;
    CoordsUnits_init: Boolean;
    CoordSystem: TEzCoordSystem;
    coordsystem_init: Boolean;
    IsAreaClipped: Boolean;
    IsAreaClipped_init: Boolean;
    AreaClipped: TEzRect;
    AreaClipped_init: Boolean;
    ClipAreaKind: TEzClipAreaKind;
    ClipAreaKind_init: Boolean;
  Public
    Procedure Invalidate;
  End;

  { TEzIBMapInfo used in desktop }
  TEzIBMapInfo = Class( TEzBaseMapInfo )
  Protected
    Function GetNumLayers: Integer; Override;
    Procedure SetNumLayers( Value: Integer ); Override;
    Function GetExtension: TEzRect; Override;
    Procedure SetExtension( Const Value: TEzRect ); Override;
    Function GetCurrentLayer: String; Override;
    Procedure SetCurrentLayer( Const Value: String ); Override;
    Function GetAerialViewLayer: String; Override;
    Procedure SetAerialViewLayer( Const Value: String ); Override;
    Function GetLastView: TEzRect; Override;
    Procedure SetLastView( Const Value: TEzRect ); Override;
    Function GetCoordsUnits: TEzCoordsUnits; Override;
    Procedure SetCoordsUnits( Value: TEzCoordsUnits ); Override;
    Function GetCoordSystem: TEzCoordSystem; Override;
    Procedure SetCoordSystem( Value: TEzCoordSystem ); Override;
    Function GetIsAreaClipped: Boolean; Override;
    Procedure SetIsAreaClipped( Value: Boolean ); Override;
    Function GetAreaClipped: TEzRect; Override;
    Procedure SetAreaClipped( Const Value: TEzRect ); Override;
    Function GetClipAreaKind: TEzClipAreaKind; Override;
    Procedure SetClipAreaKind( Value: TEzClipAreaKind ); Override;
  Public
    Procedure Initialize; Override;
    Function IsValid: Boolean; Override;
  End;

  TEzCreateIBSQLEvent = Procedure ( Sender: TObject; var IBSQL: TIBSQL ) Of Object;

  TEzIBGis = Class( TEzBaseGis )
  Private
    { the map header information }
    FIBHeader: TIBSQL;
    FIBField: TEzIBField;
    FIsOpen: Boolean;
    FClientData: TEzIBMapClientData;
    FQueryBasicFields: Boolean;
    TmpDecimalSeparator, TmpThousandSeparator: Char;

    FOnCreateIBSQL : TEzCreateIBSQLEvent;
    Procedure SetGISVersion( Const Value: TEzAbout );
    Function GetGISVersion: TEzAbout;
    Procedure SaveWindowsSeparators;
    Procedure RestoreWindowsSeparators;
  {$IFDEF BCB} (*_*)
    function GetIBHeader: TIBSQL;
    function GetOnCreateIBSQL: TEzCreateIBSQLEvent;
    function GetQueryBasicFields: Boolean;
    procedure SetOnCreateIBSQL(const Value: TEzCreateIBSQLEvent);
    procedure SetQueryBasicFields(const Value: Boolean);
  {$ENDIF}
  Protected
    Procedure WriteMapHeader( Const Filename: String ); Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Function CreateLayer( Const LayerName: String; LayerType: TEzLayerType ): TEzBaseLayer; Override;
    Procedure Open; Override;
    Procedure Close; Override;
    Procedure SaveAs( Const Filename: String ); Override;
    Procedure AddGeoref( Const LayerName, FileName: String ); Override;
    Procedure CreateNew( Const FileName: String ); Override;
    Function IsClientServer: Boolean; Override;
    Procedure InvalidateClientInfo;

    Procedure ClearLayerInformation;
    Property IBHeader: TIBSQL Read FIBHeader;
  Published
    Property About: TEzAbout read GetGisVersion write SetGisVersion;
    Property QueryBasicFields: Boolean
      read {$IFDEF BCB} GetQueryBasicFields {$ELSE} FQueryBasicFields {$ENDIF}
      write {$IFDEF BCB} SetQueryBasicFields {$ELSE} FQueryBasicFields {$ENDIF} default true; (*_*)
    { In this event all required TIBSQL datasets must be returned }
    Property OnCreateIBSQL : TEzCreateIBSQLEvent
      read {$IFDEF BCB} GetOnCreateIBSQL {$ELSE} FOnCreateIBSQL {$ENDIF}
      write {$IFDEF BCB} SetOnCreateIBSQL {$ELSE} FOnCreateIBSQL {$ENDIF} ; (*_*)
  End;

  { r-tree descendant classes }
  TIBRTNode = Class( TRTNode )
  Public
    Procedure Read( NId: Integer ); Override;
    Procedure Write; Override;
    Procedure AddNodeToFile; Override;
    Procedure DeleteNodeFromFile; Override;
  End;

  { TIBRTree used in desktop }
  TIBRTree = Class( TRTree )
  Private
    IdxOpened: Boolean;
  Public
    Function CreateNewNode: TRTNode; Override;
    Function Open( Const Name: String; Mode: Word ): integer; Override;
    Procedure Close; Override;
    Function CreateIndex( Const Name: String; Multiplier: Integer ): integer; Override;
    Procedure FlushFiles; Override;
    Procedure ReadCatalog( Var IdxInfo: TRTCatalog ); Override;
    Procedure WriteCatalog( Const IdxInfo: TRTCatalog ); Override;
    Procedure DropIndex; Override;
  End;

  { TEzIBTable - class used for accessing to the database }
  TEzIBTable = Class( TEzBaseTable )
  Private
    FLayer: TEzIBLayer;
    FCurrRecno: Integer;
    Function Dataset: TIBSQL;
    Procedure OpenIBSQL( Const ASQL: String );
    Procedure ExecuteIBSQL( Const Asql: String );
    Function TheTableName: string;
  {$IFDEF BCB} (*_*)
    function GetLayer: TEzIBLayer;
    procedure SetLayer(const Value: TEzIBLayer);
  {$ENDIF}
  Protected
    Function GetActive: Boolean; Override;
    Procedure SetActive( Value: Boolean ); Override;
    Function GetRecNo: Integer; Override;
    Procedure SetRecNo( Value: Integer ); Override;
  Public
    Procedure BeginTrans; Override;
    Procedure RollBackTrans; Override;
    Procedure EndTrans; Override;
    Procedure Append( NewRecno: Integer ); Override;
    Function Bof: Boolean; Override;
    Function Eof: Boolean; Override;
    Function DateGet( Const FieldName: String ): TDateTime; Override;
    Function DateGetN( FieldNo: integer ): TDateTime; Override;
    Function Deleted: Boolean; Override;
    Function Field( FieldNo: integer ): String; Override;
    Function FieldCount: integer; Override;
    Function FieldDec( FieldNo: integer ): integer; Override;
    Function FieldGet( Const FieldName: String ): String; Override;
    Function FieldGetN( FieldNo: integer ): String; Override;
    Function FieldLen( FieldNo: integer ): integer; Override;
    Function FieldNo( Const FieldName: String ): integer; Override;
    Function FieldType( FieldNo: integer ): char; Override;
    Function Find( Const ss: String; IsExact, IsNear: Boolean ): Boolean; Override;
    Function FloatGet( Const FieldName: String ): Double; Override;
    Function FloatGetN( FieldNo: Integer ): Double; Override;
    Function IndexCount: integer; Override;
    Function IndexAscending( Value: integer ): Boolean; Override;
    Function Index( Const INames, Tag: String ): integer; Override;
    Function IndexCurrent: String; Override;
    Function IndexUnique( Value: integer ): Boolean; Override;
    Function IndexExpression( Value: integer ): String; Override;
    Function IndexTagName( Value: integer ): String; Override;
    Function IndexFilter( Value: integer ): String; Override;
    Function IntegerGet( Const FieldName: String ): Integer; Override;
    Function IntegerGetN( FieldNo: integer ): Integer; Override;
    Function LogicGet( Const FieldName: String ): Boolean; Override;
    Function LogicGetN( FieldNo: integer ): Boolean; Override;
    Procedure MemoSave( Const FieldName: String; Stream: TStream ); Override;
    Procedure MemoSaveN( FieldNo: integer; Stream: TStream ); Override;
    Function MemoSize( Const FieldName: String ): Integer; Override;
    Function MemoSizeN( FieldNo: integer ): Integer; Override;
    Function RecordCount: Integer; Override;
    Function StringGet( Const FieldName: String ): String; Override;
    Function StringGetN( FieldNo: integer ): String; Override;