ezindygis.pas

很管用的GIS控件

Unit EzIndyGIS;

{$I EZ_FLAG.PAS}
{$DEFINE TRANSPORT_COMPRESSED} //uncomment if you want to compress entity when transporting
{$DEFINE MW_TRIAL_VERSION}
Interface

Uses
  SysUtils, Windows, Classes, Graphics, Controls, db, Forms,
  EzBaseGIS, ezbase, ezlib, ezprojections, ezrtree, ezbaseexpr, EzCtrls,
  idTCPClient;

Type

  TEzIndyLayer = Class;
  TEzIndyClientGIS = Class;
  TMWSparseList = Class;

  TEzIndyLayerInfo = Class( TEzBaseLayerInfo )
  Private
    Function GetTCPClient: TIdTCPClient;
    Function IsBuffered: Boolean;
    Function BufferGIS: TEzGIS;
  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;
  End;


  { TEzIndyTable - class used for accessing to the attached table }

  TEzIndyTable = Class(TEzBaseTable)
  Private
    FLayer: TEzIndyLayer;
    FLastSetRecno: Integer;
  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;
    Procedure DatePut( Const FieldName: String; value: TDateTime ); Override;
    Procedure DatePutN( FieldNo: integer; value: TDateTime ); Override;
    Procedure Delete; Override;
    Procedure Edit; Override;
    Procedure FieldPut( Const FieldName, Value: String ); Override;
    Procedure FieldPutN( FieldNo: integer; Const Value: String ); Override;
    Procedure First; Override;
    Procedure FloatPut( Const FieldName: String; Const Value: Double ); Override;
    Procedure FloatPutN( FieldNo: integer; Const Value: Double ); Override;
    Procedure FlushDB; Override;
    Procedure Go( n: Integer ); Override;
    Procedure IndexOn( Const IName, tag, keyexp, forexp: String;
      uniq: TEzIndexUnique; ascnd: TEzSortStatus ); Override;
    Procedure IntegerPut( Const FieldName: String; Value: Integer ); Override;
    Procedure IntegerPutN( FieldNo: integer; Value: Integer ); Override;
    Procedure Last; Override;
    Procedure LogicPut( Const FieldName: String; value: Boolean ); Override;
    Procedure LogicPutN( fieldno: integer; value: Boolean ); Override;
    Procedure MemoLoad( Const FieldName: String; Stream: TStream ); Override;
    Procedure MemoLoadN( fieldno: integer; Stream: TStream ); Override;
    Procedure Next; Override;
    Procedure Pack; Override;
    Procedure Post; Override;
    Procedure Prior; Override;
    Procedure Recall; Override;

    Procedure Refresh; Override;
    Procedure Reindex; Override;
    Procedure SetTagTo( Const TName: String ); Override;
    Procedure SetUseDeleted( tf: Boolean ); Override;
    Procedure StringPut( Const FieldName, value: String ); Override;
    Procedure StringPutN( fieldno: integer; Const value: String ); Override;
    Procedure Zap; Override;
    Function DBCreateTable( Const fname: String; AFieldList: TStringList ): boolean; Override;
    Function DBTableExists( const TableName: string ): Boolean; Override;
    Function DBDropTable( const TableName: string): Boolean; Override;
    Function DBDropIndex( const TableName: string): Boolean; Override;
    Function DBRenameTable( const Source, Target: string): Boolean; Override;

    Property Layer: TEzIndyLayer read FLayer write FLayer;
  End;


  { TEzIndyLayer - class definition }

  TEzIndyLayer = Class( TEzBaseLayer )
  Private
    FDBTable: TEzBaseTable;
    { FOR BUFFERING SetGraphicFilter method }
    FBufferList: TEzEntityList;
    FBufferCurrent: Integer;
    FRecnoList: TIntegerList;   // used for detecting last record numbers ON THE BUFFER that were readen from server when TEzIndyClientGIS.TransportBufferSize > 0
    { For linking to a temporary local layer }
    FMWSparseList: TMWSparseList;  // the link of one record on the server to one record on the local computer
    FServerRecordCount: Integer;  // presumably the no. of records on the server. Initialized when created the local TEzIndyGIS.FBufferGIS
    FClientHasAllData: Boolean;
    Procedure TransportImage(AEntity: TEzEntity);
    Function GetLocalRecno( ServerRecno: Integer ): Integer;
    Procedure SetLocalRecno( ServerRecno, Value: Integer );
    {Function GetLocalDataExists( ServerRecno: Integer ): Boolean;
    Procedure SetLocalDataExists( ServerRecno: Integer; Value: Boolean );}
    Function LocalLayer: TEzBaseLayer;
    Function GetTCPClient: TIdTCPClient;
    Procedure GetNextBuffer;
  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 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;

    { invalidating a record will cause the entity to be re-read from the server }
    Procedure InvalidateRecord(Index: Integer);

    Property LocalRecno[ServerRecno: Integer]: Integer read GetLocalRecno Write SetLocalRecno;
    //Property LocalDataExists[ServerRecno: Integer]: Boolean read GetLocalDataExists Write SetLocalDataExists;
  End;

  { TEzIndyLayers - class definition }

  TEzIndyLayers = 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;

  { TMapInfo used in desktop }
  TEzIndyMapInfo = Class( TEzBaseMapInfo )
  Private
    Function GetTCPClient: TIdTCPClient;
    Function BufferGIS: TEzGIS;
    Function IsBuffered: Boolean;
  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;

  TEzIndyClientGIS = Class(TEzBaseGIS)
  Private
    { the connection }
    FTCPClient: TIdTCPClient;
    FTransportBufferSize: Integer;
    FLogin: string;
    FPassword: string;
    FLoginPrompt: Boolean;
    { this is the buffer GIS used. All data coming from TCP/IP will be stored
      temporary on a subdirectory defined by property
      TEzIndyClientGIS.LayersSubdir: string;
      The file will be automatically overwritten when opening / closing the connexion
      Also, ClientDataBuffered property must be set to true
    }
    FBufferGIS: TEzGIS;
    FClientBuffered: Boolean;
    FDataBuffered: Boolean;
    FPersistentClientBuffered: Boolean;
    FNonBufferedLayers: TStrings;
    FTransportImages: TEzTransportImages;
    Procedure SetGISVersion( Const Value: TEzAbout );
    Function GetGISVersion: TEzAbout;
    Procedure SetIdTCPClient(Value: TIdTCPClient);
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Function CreateLayer( Const LayerName: String; LayerType: TEzLayerType ): TEzBaseLayer; Override;
    Procedure Open; 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 UpdateInfoFromServer;
    { This method forces invalidates the layers to force to be read from the server
      next time an entity on that layer is needed. If LayerName ='' all
      layers are forced }
    Procedure InvalidateClientBuffer( const LayerName: string );
    { This method read all the entities from the server to the client.
     If LayerName = '', all layers are loaded to local buffer map }
    Procedure LoadFullLayerToBuffer( const LayerName: string );
    Procedure LoadSymbolsFromServer;
    Procedure LoadVectorialFontsFromServer;
    Procedure LoadLineTypesFromServer;
    Procedure Connect;
    Procedure Disconnect;

  Published
    Property About: TEzAbout read GetGisVersion write SetGisVersion;
    Property TCPClient: TIdTCPClient read FTCPClient write SetIdTCPClient;
    Property Login: string read FLogin write FLogin;
    Property Password: string read FPassword write FPassword;
    Property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
    { this data defines the number of entities read from the server when a
      graphic filter is set or when repainting the drawbox }
    Property TransportBufferSize: Integer read FTransportBufferSize write FTransportBufferSize default 1000;
    // this property defines if a local buffer is used for buffering entities from the server
    Property ClientBuffered: Boolean read FClientBuffered write FClientBuffered default False;
    // if this property set to true, the database information is bring also to the client (Layer.DBTable information)
    Property DataBuffered: Boolean read FDataBuffered write FDataBuffered default False;
    // This property defines if the local buffered are mantained in the local subdirectory
    // between every open and close for the map
    Property PersistentClientBuffered: Boolean read FPersistentClientBuffered write FPersistentClientBuffered default False;
    // This property defines the name of the layers that always will be read from
    // the server when the drawbox is repainted
    Property NonBufferedLayers: TStrings Read FNonBufferedLayers;
    // this property defines what to do with raster images for entities on the server
    // none action, the raster image can be transparted if non existing locally, or always overwrite ever if exists
    Property TransportImages: TEzTransportImages read FTransportImages write FTransportImages;
  End;

  { A sparse list array }

  PPointer = ^Pointer;

  TSPAApply = Function( TheIndex: Integer; TheItem: Pointer ): Integer;

  TSecDir = Array[0..4095] Of Pointer;
  PSecDir = ^TSecDir;
  TSPAQuantum = ( SPASmall, SPALarge );

  TSparsePointerArray = Class( TObject )
  Private
    secDir: PSecDir;
    slotsInDir: Word;
    indexMask, secShift: Word;
    FHighBound: Integer;
    FSectionSize: Word;
    cachedIndex: Integer;
    cachedPointer: Pointer;
    Function GetAt( Index: Integer ): Pointer;
    Function MakeAt( Index: Integer ): PPointer;
    Procedure PutAt( Index: Integer; Item: Pointer );
  Public
    Constructor Create( Quantum: TSPAQuantum );
    Destructor Destroy; Override;

    Function ForAll( ApplyFunction: Pointer {TSPAApply} ): Integer;

    Procedure ResetHighBound;

    Property HighBound: Integer Read FHighBound;
    Property SectionSize: Word Read FSectionSize;
    Property Items[Index: Integer]: Pointer Read GetAt Write PutAt; Default;
  End;

  { TSparseList class }

  TSparseList = Class( TObject )
  Private
    FList: TSparsePointerArray;
    FCount: Integer;
    FQuantum: TSPAQuantum;
    Procedure NewList( Quantum: TSPAQuantum );
  Protected
    Procedure Error; Virtual;
    Function Get( Index: Integer ): Pointer;
    Procedure Put( Index: Integer; Item: Pointer );
  Public
    Constructor Create( Quantum: TSPAQuantum );
    Destructor Destroy; Override;
    Function Add( Item: Pointer ): Integer;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Procedure Exchange( Index1, Index2: Integer );
    Function First: Pointer;
    Function ForAll( ApplyFunction: Pointer {TSPAApply} ): Integer;
    Function IndexOf( Item: Pointer ): Integer;
    Procedure Insert( Index: Integer; Item: Pointer );
    Function Last: Pointer;
    Procedure Move( CurIndex, NewIndex: Integer );
    Procedure Pack;
    Function Remove( Item: Pointer ): Integer;
    Property Count: Integer Read FCount;
    Property Items[Index: Integer]: Pointer Read Get Write Put; Default;
  End;

  { TMWSparseList class }

  TMWSparseList = Class
  Private
    FList: TSparseList;
  Protected
    Function Get( Index: Integer ): Integer;
    //Function GetDataExists( Index: Integer ): Boolean;
    Procedure Put( Index: Integer; Value: Integer );
    //Procedure PutDataExists( Index: Integer; Value: Boolean );
    Procedure Error;
  Public
    Constructor Create( Capacity: Integer );
    Destructor Destroy; Override;
    Function HasData( Index: Integer ): Boolean;
    Procedure Delete( Index: Integer );
    Procedure Exchange( Index1, Index2: Integer );
    Procedure Insert( Index: Integer; Const Value: Integer );
    Procedure Clear;

    Property LocalRecno[Index: Integer]: Integer Read Get Write Put;
    //Property DataExists[Index: Integer]: Boolean Read GetDataExists Write PutDataExists;
  End;

Implementation

Uses
  Inifiles, ezsystem, ezconsts, ezentities,
  ezbasicctrls, ezimpl, EzGisTiff
{$IFDEF TRANSPORT_COMPRESSED}
  , EzZLibUtil
{$ENDIF}
{$IFDEF LEVEL6}
  , Variants
{$ENDIF}
  ;