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

📄 ezbasicctrls.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    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 QuickUpdateExtension: TEzRect; Override;
    Function UpdateExtension: TEzRect; Override;
    Function LoadEntityWithRecNo( RecNo: Longint ): TEzEntity; Override;
    Function EntityWithRecno( Recno: Integer ): TEzEntity; Override;
    Procedure UpdateEntity( RecNo: Integer; Entity2D: TEzEntity ); Override;
    Procedure Pack( ShowMessages: Boolean ); Override;
    Procedure Repair; Override;
    Procedure Zap; Override;

    Procedure First; Override;
    Procedure Last; Override;
    Procedure Next; Override;
    Function Eof: Boolean; 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 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;
    Function RecEntity: TEzEntity; Override;

    Function GetBookmark: Pointer; Override;
    Procedure GotoBookmark( Bookmark: Pointer ); Override;
    Procedure FreeBookmark( Bookmark: Pointer ); 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;

    Property ConnectLayer: TEzBaseLayer read FConnectLayer write FConnectLayer;

  End;

Procedure SortOrderList( Layer: TEzBaseLayer; Solver: TEzMainExpr; var ol: TIntegerList);
Function ReverseInteger( value: integer ): integer;
Function AddShapeLayer( GIS: TEzBaseGIS; Const Filename: String;
  RepaintViewports: Boolean ): Integer;
Function AddDGNLayer( GIS: TEzBaseGIS; Const Filename: String;
  RepaintViewports: Boolean ): Integer;
Procedure SetModifiedStatus( Layer: TEzBaseLayer );
Procedure SetGISModifiedStatus( GIS: TEzBaseGIS );
Procedure NormalizePolygon( Entity: TEzEntity );
Function AddLayerTo( GIS: TEzBaseGIS; Const FileName: String;
  IsAnimation, WithDB: Boolean; LayerType: TEzLayerType;
  CoordSystem: TEzCoordSystem; CoordsUnits: TEzCoordsUnits;
  FieldList: TStrings ): TEzBaseLayer;

Implementation

Uses
  Inifiles, EzConsts, EzCADCtrls, EzMiscelEntities, EzShpImport, EzDGNLayer;

type

  {-----------------------------------------------------------------------------}
  //                    a bookmark for memory layers
  {-----------------------------------------------------------------------------}
  TEzMemBookmark = class
  private
    FRecno: Integer;
    FFiltered: Boolean;
    FEofCrack: Boolean;
    FFilterRecno: Integer;
    Fol: TIntegerList;
  Public
    constructor Create;
    destructor Destroy; Override;
  end;

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

  TEzShapeBookmark = class
  private
    FRecno: Integer;
    FFiltered: Boolean;
    FEofCrack: Boolean;
    FFilterRecno: Integer;
    FCurrentLoaded: Integer;
    FIndexRec: TIndexRec;
    FSHPPos: Integer;
    FSHXPos: Integer;
    Fol: TIntegerList;
  Public
    constructor Create;
    destructor Destroy; Override;
  end;

{ TEzMemBookmark }

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

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

{ TEzShapeBookmark }

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

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


{ general procedures }

Procedure SetModifiedStatus( Layer: TEzBaseLayer );
Begin
  If Layer = Nil Then Exit;
  Layer.Modified := True;
  If ( Layer.Layers <> Nil ) And ( Layer.Layers.GIS <> Nil ) Then
    Layer.Layers.GIS.Modified := True;
End;

Procedure SetGISModifiedStatus( GIS: TEzBaseGIS );
Begin
  If GIS <> Nil Then
    GIS.Modified := True;
End;

{ if first point is not equal to last point, then add last point }

Procedure NormalizePolygon( Entity: TEzEntity );
Var
  n, Idx1, Idx2: integer;
  Found: boolean;
Begin
  With Entity Do
  Begin
    If EntityID = idPolygon Then
    Begin
      If Points.Parts.Count < 2 Then
      Begin
        If Not EzLib.FuzzEqualPoint2D( Points[0], Points[Points.Count - 1] ) Then
          Points.Add( Points[0] );
      End
      Else
      Begin
        n := 0;
        Repeat
          Found := False;
          Idx1 := Points.Parts[n];
          If n < Points.Parts.Count - 1 Then
            Idx2 := Points.Parts[n + 1] - 1
          Else
            Idx2 := Points.Count - 1;
          Repeat
            If Not EzLib.FuzzEqualPoint2D( Points[Idx1], Points[Idx2] ) Then
            Begin
              If Idx2 < Points.Count - 1 Then
                Points.Insert( Idx2 + 1, Points[Idx1] )
              Else
                Points.Add( Points[Idx1] );
              Found := True;
              Inc( n );
              Break;
            End;
            Inc( n );
            If n >= Points.Parts.Count Then
              Break;
            Idx1 := Points.Parts[n];
            If n < Points.Parts.Count - 1 Then
              Idx2 := Points.Parts[n + 1] - 1
            Else
              Idx2 := Points.Count - 1;
          Until False;
        Until ( Not Found ) Or ( n >= Points.Parts.Count );
      End;
    End;
  End;
End;

// utilities

Function AddShapeLayer( GIS: TEzBaseGIS; Const Filename: String;
  RepaintViewports: boolean ): Integer;
Var
  TmpName, s: String;
  Layer: TEzBaseLayer;
  I, PriorCount: Integer;
  Extents: TEzRect;
  AFileName: string;
  ShpLayerExtents: TEzRect;
Begin
  Result := -1;
  AFileName:= ChangeFileExt( Filename, '' );
  TmpName := ExtractFileName( AFileName );
  PriorCount := GIS.Layers.Count;
  If GIS.Layers.IndexOfName( TmpName ) >= 0 Then
  Begin
    MessageToUser( SDuplicateLayer, smsgerror, MB_ICONERROR );
    Exit;
  End;
  Layer := TSHPLayer.Create( GIS.Layers, AFileName );
  Result:= Gis.Layers.IndexOfName( TmpName );
  //GIS.Layers.AddLayer(Layer);
  s := AFileName + '.EZA';
  If FileExists( s ) Then
    SysUtils.DeleteFile( s );
  s := AFileName + '.RTC';
  If FileExists( s ) Then
    SysUtils.DeleteFile( s );
  s := AFileName + '.RTX';
  If FileExists( s ) Then
    SysUtils.DeleteFile( s );
  If GIS.Layers.Count = 1 Then
    Extents := INVALID_EXTENSION
  Else
    Extents := GIS.MapInfo.Extension;
  Layer.Open;
  Layer.Modified:= True;
  ShpLayerExtents:= TSHPLayer( Layer ).FShapeHeader.Extent;
  With ShpLayerExtents Do
  Begin
    MaxBound( Extents.Emax, Emax );
    MinBound( Extents.Emin, Emin );
  End;
  Layer.LayerInfo.Extension := ShpLayerExtents;
  GIS.MapInfo.Extension := Extents;
  If PriorCount = 0 Then
  begin
    GIS.MapInfo.LastView:= Extents;
    GIS.CurrentLayerName:= TmpName;
  end;
  Layer.LayerInfo.CoordsUnits := GIS.MapInfo.CoordsUnits;
  If RepaintViewports Then
  Begin
    Layer.Open;
    GIS.MapInfo.CurrentLayer := TmpName;
    If PriorCount = 0 Then
      For I := 0 To GIS.DrawBoxList.Count - 1 Do
      Begin
        GIS.DrawBoxList[I].ZoomToExtension;
      End;
  End;
  GIS.Modified := True;
End;

Function AddDGNLayer( GIS: TEzBaseGIS; Const Filename: String;
  RepaintViewports: boolean ): Integer;
Var
  TmpName, s: String;
  Layer: TEzBaseLayer;
  I, PriorCount: Integer;
  Extents, DGNLayerExtents: TEzRect;
  DGNFile: TEzDGNFile;
  AFileName: string;
Begin
  Result := -1;
  AFileName:= ChangeFileExt( Filename, '' );
  TmpName := ExtractFileName( AFileName );
  PriorCount := GIS.Layers.Count;
  If (PriorCount>0) And (GIS.Layers.IndexOfName( TmpName ) >= 0) Then
  Begin
    MessageToUser( SDuplicateLayer, smsgerror, MB_ICONERROR );
    Exit;
  End;
  Layer := TDGNLayer.Create( GIS.Layers, AFileName );
  Result:= Gis.Layers.IndexOfName( TmpName );
  //GIS.Layers.AddLayer(Layer);
  s := AFileName + '.EZG';
  If FileExists( s ) Then
    SysUtils.DeleteFile( s );
  s := AFileName + '.RTC';
  If FileExists( s ) Then
    SysUtils.DeleteFile( s );
  s := AFileName + '.RTX';

  { calculate extension of DGN layer }
  DGNFile:= TEzDGNFile.Create;
  Try
    DGNFile.FileName := AFileName + '.DGN';
    DGNFile.MemoryLoaded:= False;
    DGNFile.Open;
    DGNLayerExtents.Emin.x:= DGNFile.XMin;
    DGNLayerExtents.Emin.y:= DGNFile.YMin;
    DGNLayerExtents.Emax.x:= DGNFile.XMax;
    DGNLayerExtents.Emax.y:= DGNFile.YMax;
    DGNFile.Close;
  Finally
    DGNFile.Free;
  End;
  If GIS.Layers.Count = 1 Then
    Extents := INVALID_EXTENSION
  Else
    Extents := GIS.MapInfo.Extension;
  With DGNLayerExtents Do
  Begin
    MaxBound( Extents.Emax, Emax );
    MinBound( Extents.Emin, Emin );
  End;
  Layer.LayerInfo.Extension := DGNLayerExtents;
  GIS.MapInfo.Extension := Extents;
  If PriorCount = 0 Then
  begin
    GIS.MapInfo.LastView:= Extents;
    GIS.CurrentLayerName:= TmpName;
  end;
  Layer.LayerInfo.CoordsUnits := GIS.MapInfo.CoordsUnits;
  Layer.Modified:= True;
  //GIS.Layers.AddLayer(Layer);
  If RepaintViewports Then
  Begin
    Layer.Open;
    GIS.MapInfo.CurrentLayer := TmpName;
    If PriorCount = 0 Then
      For I := 0 To GIS.DrawBoxList.Count - 1 Do
      Begin
        GIS.DrawBoxList[I].ZoomToExtension;
      End;
  End;
  GIS.Modified := True;
End;

{ TEzMemLayerInfo implementation }

{-------------------------------------------------------------------------------}
{                  TEzMemLayerInfo - class implementation                    }
{-------------------------------------------------------------------------------}

Function TEzMemLayerInfo.GetIsCosmethic: boolean;
Begin
  result := True; //TEzMemoryLayer( FLayer ).FHeader.IsMemoryLayer;
End;

Procedure TEzMemLayerInfo.SetIsCosmethic( value: boolean );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.IsMemoryLayer = value Then Exit;
  TEzMemoryLayer( FLayer ).FHeader.IsMemoryLayer := value;
End;

Function TEzMemLayerInfo.GetLocked: Boolean;
Begin
  Result := TEzMemoryLayer( FLayer ).FHeader.Locked;
End;

Procedure TEzMemLayerInfo.SetLocked( Value: Boolean );
Begin
  TEzMemoryLayer( FLayer ).FHeader.Locked:= Value;
End;

Function TEzMemLayerInfo.GetUseAttachedDB: boolean;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.UseAttachedDB;
End;

Procedure TEzMemLayerInfo.SetUseAttachedDB( Value: boolean );
Begin
  TEzMemoryLayer( FLayer ).FHeader.UseAttachedDB := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetVisible: boolean;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.Visible;
End;

Procedure TEzMemLayerInfo.SetVisible( Value: boolean );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.Visible = Value Then Exit;
  TEzMemoryLayer( FLayer ).FHeader.Visible := Value;
  If Assigned( FLayer.Layers.GIS.OnVisibleLayerChange ) Then
    FLayer.Layers.GIS.OnVisibleLayerChange( Self, FLayer.Name );
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetOverlappedTextAction: TEzOverlappedTextAction;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.OverlappedTextAction;

⌨️ 快捷键说明

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