ezflashfilergis.pas

很管用的GIS控件

{------------------------------------------------------------------------------}
{                                                                              }
{            FlashFiler support unit for EzSoft's GIS library EzGIS            }
{                                                                              }
{         Copyright Stefan Paege, Elektronik-Labor Carls, 2002 - 2003          }
{                                                                              }
{------------------------------------------------------------------------------}

unit EZFlashFilerGIS;

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

{.$DEFINE CACHED_TABLE}
interface

uses
  SysUtils, Windows, Classes, Graphics, Controls, Db, Forms,
  EzBaseGis, EzBase, EzLib, EzProjections, EzRTree, EzBaseExpr,
  FFDb
  {$IFDEF CACHED_TABLE}
  , uffCachedTable // A cached TffTable descendent speeding up sequential reads
  {$ENDIF}
  , EzCtrls;

type

  { The following class declarations make it easy to replace basic FF
    components with more sophisticated classes like for example TffCachedTable }

  {$IFDEF CACHED_TABLE}
  TffGisTable = class(TffCachedTable)
  end;

  TffGisQuery = class(TffCachedQuery)
  end;
  {$ELSE}
  TffGisTable = class(TffTable)
  end;

  TffGisQuery = class(TffQuery)
  end;
  {$ENDIF}

  TMWSparseList = Class;

  TEzFlashFilerLayerInfo = class(TEzBaseLayerInfo)
  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;


  { TEzFlashFilerLayer - class definition }

  TEzFlashFilerLayer = class(TEzBaseLayer)
  private
    { For common access to Fields }
    FDBTable: TEzBaseTable;
    { For the layer Header }
    FFlashFilerHeader: TffGisTable;
    { For the entities  }
    FFlashFilerEntities: TffGisTable;
    { For filtering }
    FOl: TIntegerList;
    FFilterRecNo: Integer;
    { Used only when filtering}
    FEofCrack: Boolean;
    FFiltered: Boolean;
    FIsOpen: Boolean;
    FBatchUpdate: Boolean;

    { For caching the R-Tree }
    FCachedRT: TRTree;
    { 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 TEzFlashFilerGIS.FBufferGIS
    FClientHasAllData: Boolean;
    FModifiedList: TMWSparseList;
    Function GetLocalRecno( ServerRecno: Integer ): Integer;
    Procedure SetLocalRecno( ServerRecno, Value: Integer );
    {Function GetLocalDataExists( ServerRecno: Integer ): Boolean;
    Procedure SetLocalDataExists( ServerRecno: Integer; Value: Boolean );}
    Procedure TransportImage(AEntity: TEzEntity);
    Function LocalLayer: TEzBaseLayer;

    procedure BuildRTreeInMemory(var RT: TRTree);
    procedure UpdateMapExtension(const R: TEzRect);
    function InternalLoadEntity: TEzEntity;
    Function IsClientBuffered: Boolean;
    function IsCachedSpatialIndex: Boolean;
  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;
    Function IsCurrentRecordBuffered(ARecno: Integer): Boolean;

    { Specific functions }
    procedure UpdateCachedTree;

    Procedure InvalidateRecord(Index: Integer);

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

    { For the entities  }
    property FlashFilerEntities: TffGisTable Read FFlashFilerEntities;
  end;


  { TEzFlashFilerLayers - class definition }

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


  { TEzFlashFilerMapInfo used in desktop }
  TEzFlashFilerMapInfo = 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;

  { TEzFlashFilerGis main component }

  TEzFlashFilerGis = class(TEzBaseGis)
  private
    { This is a pointer only. you must place one of this in a form or data module }
    FFlashFilerDatabase: TffDatabase;
    { The map header information }
    FFlashFilerHeader: TffGisTable;
    FWithTransactions: Boolean;
    FIsOpen: Boolean;
    FCachedSpatialIndex: Boolean;

    FBufferGIS: TEzGIS;
    FClientBuffered: Boolean;
    FTransportImages: TEzTransportImages;
    procedure SetGISVersion(const Value: TEzAbout);
    function GetGISVersion: TEzAbout;
    procedure DropFlashFilerTable(const aTableName: string);
    Function CreateFlashFilerTable: TffGisTable;
    function CreateFlashFilerQuery: TffGisQuery;
    procedure SetFlashFilerDatabase(Value: TffDatabase);
  protected
    procedure WriteMapHeader(const Filename: string); override;
    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 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 ClearLayerInformation;
    function TableExists(const TableName: string): Boolean;
    { Specific functions }
    procedure UpdateCachedTree;

    { 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 DeleteClientBuffer( 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;

    property WithTransactions: Boolean read FWithTransactions Write FWithTransactions;
    property FlashFilerHeader: TffGisTable Read FFlashFilerHeader;
  published
    property FlashFilerDatabase: TffDatabase read FFlashFilerDatabase Write SetFlashFilerDatabase;
    property About: TEzAbout read GetGisVersion Write SetGisVersion;
    property CachedSpatialIndex: Boolean read FCachedSpatialIndex Write FCachedSpatialIndex;
    // this property defines if a local buffer is used for buffering entities from the server
    property ClientBuffered: Boolean read FClientBuffered write FClientBuffered default False;
    // 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;

  { The R-Tree implementation for FlashFiler }
  TEzFlashFilerRTNode = class(TRTNode)
  public
    procedure Read(NId: Integer); override;
    procedure Write; override;
    procedure AddNodeToFile; override;
    procedure DeleteNodeFromFile; override;
  end;

  TEzFlashFilerRTree = class(TRTree)
  private
    FFlashFilerRTree: TffGisTable;
    IdxOpened: Boolean;
    FTickStart: DWord;
  public
    Constructor Create( Layer: TObject; t: TTreeType; Mode: Word ); Override;
    Destructor Destroy; override;
    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;
    procedure CheckSearchCanceled; Override;
    Procedure StartSearch; Override;
  end;


  { For GetDBTable method }
  TEzFlashFilerDataset = class(TEzBaseTable)
  private
    { A pointer for the layer }
    FLayer: TEzFlashFilerLayer;
    function Dataset: TffGisTable;
  protected
    function GetActive: Boolean; override;
    procedure SetActive(Value: Boolean); override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;
  public
    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 DBTableExists(const TableName: string): Boolean; Override;

  end;

  { A sparse list array }