⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ezctrls.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
Unit EzCtrls;

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

{$I EZ_FLAG.PAS}
Interface

Uses
  SysUtils, Classes, Windows, StdCtrls, Controls, Graphics, Printers, ExtCtrls,
  Forms, EzBaseExpr, EzLib, EzSystem, EzBase, EzRtree, EzBaseGIS, EzEntities,
  Db, EzBasicCtrls;

Type

  {------------------------------------------------------------------------------}
  //            TEzLayerInfo
  {------------------------------------------------------------------------------}

  { Entities index info ( file .EZX ) }
{$IFNDEF SWAPPED_FORMAT}
  PEzxData = ^TEzxData;
  TEzxData = Packed Record
    Case Integer Of
      // the header
      0: (
        HeaderID: smallint;
        VersionNumber: SmallInt;
        RecordCount: Integer;
        MaxRecSize: Integer );
      // the info
      1: (
        Offset: Longint; // Offset in file .ent
        EntityID: TEzEntityID; // kind of entity
        Extension: TEzRect; // max, min extension of entity
        IsDeleted: Boolean ); // is deleted?
  End;
{$ELSE}
  PEzxData = ^TEzxData;
  TEzxData = Packed Record
    Case Integer Of
      // the header
      0: (
        MaxRecSize: Integer;
        RecordCount: Integer;
        VersionNumber: SmallInt;
        HeaderID: smallint );
      // the info
      1: (
        IsDeleted: Boolean; // is deleted?
        Extension: TEzRect; // max, min extension of entity
        EntityID: TEzEntityID; // kind of entity
        Offset: Longint ); // Offset in file .ent
  End;
{$ENDIF}

  TEzLayerInfo = 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;
    Function GetLocked: Boolean; Override;
    Procedure SetLocked( Value: Boolean ); Override;
  End;

  {------------------------------------------------------------------------------}
  //            TEzLayer
  {------------------------------------------------------------------------------}

  TEzLayer = Class( TEzBaseLayer )
  Private
    { to open .EZD and .EZX files }
    FHeader: TEzLayerHeader;
    FEzDStream: TStream;
    FEzXStream: TStream;
    FDBTable: TEzBaseTable;
    FUpdateRtree: Boolean;
    FCurrentLoaded: integer;

    { current record information }
    FRecno: Integer;
    FEofCrack: Boolean;
    ol: TIntegerList;
    FFilterRecno: Integer;
    FFiltered: boolean;
    { follows the data that will be read in buffering}
    FEzxData: TEzxData;
    { buffering }
    FBuffEnx, FBuffEnt: TEzBufferedRead;

    FProposedID: Integer; { FProposedID = internal use }

    Procedure ReReadEntHeader;
    Procedure DoPack( ShowMessages: Boolean );
    Function InternalLoadEntity( EntityID: TEzEntityID; Stream: TStream ): TEzEntity;
    Procedure UpdateMapExtension( Const R: TEzRect );
    Function BuffEnt: TStream;
  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;
    Function DeleteLayerFiles: Boolean; 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 GetExtensionForRecords( List: TIntegerList ): TEzRect; Override;

  End;

  {-----------------------------------------------------------------------------}
  //                   TEzDataSetProvider
  {-----------------------------------------------------------------------------}

  TEzOpenTableEvent = Procedure( Sender: TObject; const FileName: string; ReadWrite, Shared: Boolean;
	  var Dataset: TDataSet; var AutoDispose: Boolean ) Of Object;
  TEzTableFileEvent = Procedure( Sender: TObject; const FileName: string ) Of Object;
  TEzRenameTableEvent = Procedure( Sender: TObject; const SourceFileName, TargetFileName: string ) Of Object;
  TEzQueryTableExistsEvent = Procedure( Sender: TObject; const FileName: string; var Exists: Boolean )Of Object;
  TEzCreateTableEvent = Procedure( Sender: TObject; const FileName: string; FieldList: TStrings ) Of Object;
  TEzGetRecnoEvent = Procedure( Sender: TObject; DataSet: TDataSet; var Recno: Integer ) Of Object;
  TEzRecnoEvent = Procedure( Sender: TObject; Dataset: TDataset; Recno: Integer ) Of Object;
  TEzGetIsDeletedEvent = Procedure( Sender: TObject; DataSet: TDataSet; var IsDeleted: Boolean ) Of Object;
  TEzGetRecordCountEvent = Procedure( Sender: TObject; DataSet: TDataSet; var RecordCount: Integer ) Of Object;
  TEzDataSetEvent = Procedure( Sender: TObject; DataSet: TDataSet ) Of Object;

  TEzDataSetProvider = Class( TComponent )
  Private
    FOnOpenTable: TEzOpenTableEvent;
    FOnDropIndexFile: TEzTableFileEvent;
    FOnDropTable: TEzTableFileEvent;
    FOnRenameTable: TEzRenameTableEvent;
    FOnQueryTableExists: TEzQueryTableExistsEvent;
    FOnCreateTable: TEzCreateTableEvent;
    FOnGetRecno: TEzGetRecnoEvent;
    FOnSetToRecno: TEzRecnoEvent;
    FOnGetIsDeleted: TEzGetIsDeletedEvent;
    FOnAppendRecord: TEzRecnoEvent;
    FOnGetRecordCount: TEzGetRecordCountEvent;
    FOnDeleteRecord: TEzDataSetEvent;
    FOnFlushTable: TEzDataSetEvent;
    FOnPackTable: TEzDataSetEvent;
    FOnRecallRecord: TEzDataSetEvent;
    FOnZapTable: TEzDataSetEvent;
    FOnSetUseDeleted: TEzGetIsDeletedEvent;
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property OnOpenTable: TEzOpenTableEvent read FOnOpenTable write FOnOpenTable;
    Property OnDropIndexFile: TEzTableFileEvent read FOnDropIndexFile write FOnDropIndexFile;
    Property OnDropTable: TEzTableFileEvent read FOnDropTable write FOnDropTable;
    Property OnRenameTable: TEzRenameTableEvent read FOnRenameTable write FOnRenameTable;
    Property OnQueryTableExists: TEzQueryTableExistsEvent read FOnQueryTableExists write FOnQueryTableExists;
    Property OnCreateTable: TEzCreateTableEvent read FOnCreateTable write FOnCreateTable;
    Property OnGetRecno: TEzGetRecnoEvent read FOnGetRecno write FOnGetRecno;
    Property OnSetToRecno: TEzRecnoEvent read FOnSetToRecno write FOnSetToRecno;
    Property OnGetIsDeleted: TEzGetIsDeletedEvent read FOnGetIsDeleted write FOnGetIsDeleted;
    Property OnAppendRecord: TEzRecnoEvent read FOnAppendRecord write FOnAppendRecord;
    Property OnGetRecordCount: TEzGetRecordCountEvent read FOnGetRecordCount write FOnGetRecordCount;
    Property OnDeleteRecord: TEzDataSetEvent read FOnDeleteRecord write FOnDeleteRecord;
    Property OnFlushTable: TEzDataSetEvent read FOnFlushTable write FOnFlushTable;
    Property OnPackTable: TEzDataSetEvent read FOnPackTable write FOnPackTable;
    Property OnRecallRecord: TEzDataSetEvent read FOnRecallRecord write FOnRecallRecord;
    Property OnZapTable: TEzDataSetEvent read FOnZapTable write FOnZapTable;
    Property OnSetUseDeleted: TEzGetIsDeletedEvent read FOnSetUseDeleted write FOnSetUseDeleted;
  End;


  {------------------------------------------------------------------------------}
  {                  TEzGIS component                                            }
  {------------------------------------------------------------------------------}

  TEzGIS = Class( TEzBaseGIS )
  private
    FProvider: TEzDataSetProvider;
    Procedure SetAbout( Const Value: TEzAbout );
    Function GetAbout: TEzAbout;
    procedure SetProvider(const Value: TEzDataSetProvider);
  {$IFDEF BCB}
    function  GetProvider : TEzDataSetProvider;
  {$ENDIF}
  Protected
    Procedure WriteMapHeader( Const Filename: String ); Override;
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
  Public
    Constructor Create( AOwner: TComponent ); 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;
  Published
    Property Provider: TEzDataSetProvider {$IFDEF BCB} read GetProvider {$ELSE} read FProvider {$ENDIF} write SetProvider;
    Property About: TEzAbout read GetAbout write SetAbout;
  End;

  {------------------------------------------------------------------------------}
  {                  TEzGeorefImage component                                    }
  {------------------------------------------------------------------------------}

    { TEzGeoRefPtRecord }
  TEzGeoRefPt = Record
    XPixel, YPixel: Integer; // corresponding image coordinates in pixels
    XWorld, YWorld: Double; // corresponding map world coordinates
  End;

  { TEzGeoreferencedPt }
  TEzGeorefPoint = Class( TCollectionItem )
  Private
    FGeoRefPt: TEzGeoRefPt;
    Function GetXPixel: Integer;
    Function GetXWorld: Double;
    Function GetYPixel: Integer;
    Function GetYWorld: Double;
    Procedure SetXPixel( Const Value: Integer );
    Procedure SetXWorld( Const Value: Double );
    Procedure SetYPixel( Const Value: Integer );
    Procedure SetYWorld( Const Value: Double );
  Protected
    Function GetDisplayName: String; Override;
    Function GetCaption: String;
  Public
    Procedure Assign( Source: TPersistent ); Override;
    Procedure LoadFromStream( Stream: TStream );
    Procedure SaveToStream( Stream: TStream );
  Published
    Property XPixel: Integer Read GetXPixel Write SetXPixel;
    Property YPixel: Integer Read GetYPixel Write SetYPixel;
    Property XWorld: Double Read GetXWorld Write SetXWorld;
    Property YWorld: Double Read GetYWorld Write SetYWorld;
  End;

  { TEzGeorefPoints }
  TEzGeorefPoints = Class( TOwnedCollection )
  Private
    Function GetItem( Index: Integer ): TEzGeorefPoint;
    Procedure SetItem( Index: Integer; Value: TEzGeorefPoint );
  Public
    Constructor Create( AOwner: TPersistent );
    Function Add: TEzGeorefPoint;
    Procedure LoadFromStream( Stream: TStream );
    Procedure SaveToStream( Stream: TStream );

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

  { TEzGeorefImage component }
  TEzGeorefImage = Class( TComponent )
  Private
    FFileName: String;
    FImageName: String;
    FGeorefPoints: TEzGeorefPoints;
    FExtents: TEzRect;
    Procedure SetGeorefPoints( Value: TEzGeorefPoints );
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Procedure Assign( Source: TPersistent ); Override;
    Procedure Open;
    Procedure Save;
    Procedure New;

    Property Extents: TEzRect Read FExtents Write FExtents;
  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property GeorefPoints: TEzGeorefPoints Read FGeorefPoints Write SetGeorefPoints;
    Property ImageName: String Read FImageName Write FImageName;
    Property FileName: String Read FFileName Write FFileName;
  End;

Implementation

Uses
  Inifiles, Ezconsts, ezimpl, EzDGNLayer, EzExpressions, EzNetwork;

Const
  LAYER_ID = 8003;
  LAYER_IDX = 8004;

type

  {-----------------------------------------------------------------------------}
  //                    a bookmark for desktop layers
  {-----------------------------------------------------------------------------}

  TEzDesktopBookmark = class
  private
    FRecno: Integer;
    FFiltered: Boolean;
    FEofCrack: Boolean;
    FFilterRecno: Integer;
    FCurrentLoaded: Integer;
    FEzxData: TEzxData;
    FEZDPos: Integer;
    FEZXPos: Integer;
    Fol: TIntegerList;
  Public
    constructor Create;
    destructor Destroy; Override;
  end;


{ TEzDesktopBookmark }

constructor TEzDesktopBookmark.Create;
begin
  inherited Create;
  Fol:= TIntegerList.Create;
end;

destructor TEzDesktopBookmark.Destroy;
begin
  Fol.Free;
  inherited Destroy;
end;


Procedure ExchangeDBRecord( Layer: TEzBaseLayer; SourceRecno, DestRecno: Integer );
Var
  cnt: Integer;
  SrcFieldValues, DstFieldValues: TStringList;
Begin
  With TEzLayer( Layer ) Do
  Begin
    If ( BaseTableClass = Nil ) Or Not FHeader.UseAttachedDB Or ( DBTable = Nil ) Or
      Not ( DBTable.Active ) Then Exit;

    //TmpDataSet:= BaseTableClass.Create(Layer.Filename,'', true,true);
    SrcFieldValues := TStringList.create;
    DstFieldValues := TStringList.create;
    Try
      (* preserve the record sort order *)
      If Layer.DBTable.IndexCount <> 0 Then
        Layer.DBTable.Index( Layer.Name, '' );
      Layer.DBTable.Recno:= SourceRecno;
      For cnt := 1 To Layer.DBTable.FieldCount Do
      Begin
        SrcFieldValues.Add( Layer.DBTable.FieldGetN( cnt ) );
      End;
      Layer.DBTable.Recno:= DestRecno;
      For cnt := 1 To Layer.DBTable.FieldCount Do
      Begin
        DstFieldValues.Add( Layer.DBTable.FieldGetN( cnt ) );
      End;
      { exchange with source }
      Layer.DBTable.Recno:= SourceRecno;
      Layer.DBTable.Edit;
      For cnt := 1 To Layer.DBTable.FieldCount Do

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -