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

📄 ezctrls.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        FEzXStream.Seek( cnt * SizeOf( EzxData ), 0 );
        FEzXStream.Write( EzxData, SizeOf( TEzxData ) );

        MaxBound( Result.Emax, EzxData.Extension.Emax );
        MinBound( Result.Emin, EzxData.Extension.Emin );
      End;
    End;
    FreeAndNil( FBuffEnt );
  Finally
    If RecCount > 0 Then
      GIS.EndProgress;
  End;
  // rebuild the r-tree
  RebuildTree;
  Modified := true;
  FHeader.Extension := Result;
  If AutoFlush Then
    WriteHeaders( True );
End;

Function TEzLayer.InternalLoadEntity( EntityID: TEzEntityID; Stream: TStream ): TEzEntity;
Var
  TmpClass: TEzEntityClass;
  RecordSize: Integer;
  TmpEntID: TEzEntityID;
  TmpDeleted: Boolean;
Begin
  Stream.Read( RecordSize, SizeOf( Integer ) );
  Stream.Read( RecordSize, SizeOf( Integer ) );
  Stream.Read( TmpEntID, SizeOf( TEzEntityID ) );
  Stream.Read( TmpDeleted, SizeOf( TmpDeleted ) );
  TmpClass := GetClassFromID( EntityID );
  Result := TmpClass.Create( 1 );
  Result.LoadFromStream( Stream );
End;

Function TEzLayer.LoadEntityWithRecNo( RecNo: Longint ): TEzEntity;
Var
  EzxData: TEzxData;
Begin
  {RecNo is base 1}
  Result := Nil;
  If ( RecNo < 1 ) Or ( RecNo > FHeader.RecordCount ) Then Exit;
  FEzXStream.Seek( RecNo * SizeOf( TEzxData ), 0 );
  FEzXStream.Read( EzxData, SizeOf( TEzxData ) );
  If EzxData.IsDeleted Then Exit;
  BuffEnt {FEzDStream}.Seek( EzxData.Offset, 0 );
  Result := InternalLoadEntity( EzxData.EntityID, BuffEnt {FEzDStream} );
End;

Procedure TEzLayer.UpdateEntity( RecNo: Integer; Entity2D: TEzEntity );
Var
  EzxData, EzxHeader: TEzxData;
  I: Integer;
  Prev: TEzRect;
  GIS: TEzBaseGIS;
  Viewport: TEzBaseDrawBox;
  RecordSize, NewRecordSize, FullRecordSize: Integer;
  TmpEntID: TEzEntityID;
  TmpDeleted: Boolean;

  Procedure SaveToEndOfFile;
  Begin
    With FEzXStream Do
    Begin
      Seek( RecNo * SizeOf( TEzxData ), 0 );
      Read( EzxData, SizeOf( TEzxData ) );
    End;
    Prev := EzxData.Extension; // r-tree
    { mark current occupied record as deleted }
    With FEzDStream Do
    Begin
      Seek( EzxData.Offset, 0 );
      Read( RecordSize, SizeOf( Integer ) );
      Read( RecordSize, SizeOf( Integer ) );
      Read( TmpEntID, SizeOf( TEzEntityID ) );
      TmpDeleted := True;
      Write( TmpDeleted, SizeOf( Boolean ) );
    End;
    EzxData.EntityID := Entity2D.EntityID;
    EzxData.IsDeleted := False;
    EzxData.Offset := FEzDStream.Size;
    RecordSize := 0;
    With FEzDStream Do
    Begin
      Seek( EzxData.Offset, 0 );
      Write( RecordSize, SizeOf( Integer ) );
      Write( RecordSize, SizeOf( Integer ) );
      Write( EzxData.EntityID, SizeOf( TEzEntityID ) );
      Write( EzxData.IsDeleted, SizeOf( Boolean ) );
      Entity2D.SaveToStream( FEzDStream );
      RecordSize := FEzDStream.Position - EzxData.Offset;
      Seek( EzxData.Offset, 0 );
      Write( RecordSize, SizeOf( Integer ) );
      Write( RecordSize, SizeOf( Integer ) );
    End;
    Entity2D.UpdateExtension;
    EzxData.Extension := Entity2D.FBox; //.Points.Extension;
    With FEzXStream Do
    Begin
      Seek( RecNo * SizeOf( TEzxData ), 0 );
      Write( EzxData, SizeOf( TEzxData ) );
      // rewrite the header of .enx file
      Seek( 0, 0 );
      Read( EzxHeader, SizeOf( TEzxData ) );
      If RecordSize > EzxHeader.MaxRecSize Then
      Begin
        EzxHeader.MaxRecSize := RecordSize;
        Seek( 0, 0 );
        Write( EzxHeader, SizeOf( TEzxData ) );
      End;
    End;
  End;

Begin
  If Layers.GIS.ReadOnly Or ( FEzDStream = Nil ) Or LayerInfo.Locked Then Exit;

  NormalizePolygon( Entity2d );

  If Not Entity2D.NeedReposition Then
  Begin
    // save new extension
    With FEzXStream Do
    Begin
      Seek( RecNo * SizeOf( TEzxData ), 0 );
      Read( EzxData, SizeOf( TEzxData ) );
    End;
    Prev := EzxData.Extension; // r-tree
    Entity2D.UpdateExtension;
    EzxData.Extension := Entity2D.FBox; //.Points.Extension;
    If EzxData.EntityID = Entity2D.EntityID Then
    Begin
      { continues to be the same type of entity }
      If Not EqualRect2D( Prev, EzxData.Extension ) Then
      Begin
        FEzXStream.Seek( RecNo * SizeOf( TEzxData ), 0 );
        FEzXStream.Write( EzxData, SizeOf( TEzxData ) );
      End;

      With FEzDStream Do
      Begin
        Seek( EzxData.Offset, 0 );
        Read( FullRecordSize, SizeOf( Integer ) );
        Read( RecordSize, SizeOf( Integer ) );
        Read( TmpEntID, SizeOf( TEzEntityID ) );
        Read( TmpDeleted, SizeOf( Boolean ) );
        Entity2D.SaveToStream( FEzDStream );
        NewRecordSize := FEzDStream.Position - EzxData.Offset;
        If RecordSize <> NewRecordSize Then
        Begin
          Seek( EzxData.Offset, 0 );
          Write( FullRecordSize, SizeOf( Integer ) );
          Write( NewRecordSize, SizeOf( Integer ) );
        End;
      End;
    End
    Else
      SaveToEndOfFile;
  End
  Else
    SaveToEndOfFile;

  // update the r-tree
  If ( EzxData.EntityID <> idNone ) And FHeader.IsIndexed And
    Not EqualRect2D( Prev, EzxData.Extension ) Then
    Frt.Update( FloatRect2Rect( Prev ), Recno, FloatRect2Rect( EzxData.Extension ) );

  FreeAndNil( FBuffEnt );

  MaxBound( FHeader.Extension.Emax, EzxData.Extension.Emax );
  MinBound( FHeader.Extension.Emin, EzxData.Extension.Emin );

  Modified := true;
  If AutoFlush Then
    WriteHeaders( True );

  {new map extension}
  UpdateMapExtension( EzxData.Extension );
  GIS := Layers.GIS;
  For I := 0 To GIS.DrawBoxList.Count - 1 Do
  Begin
    Viewport := GIS.DrawBoxList[i];
    If Assigned( Viewport.OnEntityChanged ) Then
      Viewport.OnEntityChanged( Viewport, self, Recno );
  End;
End;

Procedure TEzLayer.Pack( ShowMessages: Boolean );
Begin
  If LayerInfo.Locked then Exit;
  DoPack( ShowMessages );
End;

// pack layer

Procedure TEzLayer.DoPack( ShowMessages: Boolean );
Var
  RecCount: Integer;
  cnt, J, K, N: Integer;
  NewRecno, NumBadRecords, TmpID: Integer;
  TmpLayer: TEzLayer;
  HasDeleted, IsValid, ThisIsIndexed: Boolean;
  EzxData: TEzxData;
  EzxHeader: TEzxData;
  TmpEntity: TEzEntity;
  TempFileName: String;
  FieldList: TStringList;
  GIS: TEzBaseGIS;
  TempGis: TEzGis;
  NetworkCount: Integer;
  PivotRecnos: TIntegerList;

  Function PointOutOfRange( Const P: TEzPoint ): Boolean;
  Begin
    Result := ( Abs( P.X ) < MINCOORD ) Or ( Abs( P.X ) > MAXCOORD ) Or
              ( Abs( P.Y ) < MINCOORD ) Or ( Abs( P.Y ) > MAXCOORD );
  End;

Begin
  { Warning: This must be done with all threads stopped }

  GIS := Layers.GIS;
  If GIS.ReadOnly Then Exit;
  Close;
  { Try open all files exclusively }
  Try
    Try
      TFileStream.Create( FileName + EZDEXT, fmOpenReadWrite Or fmShareExclusive ).Free;
      TFileStream.Create( FileName + EZXEXT, fmOpenReadWrite Or fmShareExclusive ).Free;
    Except
      If ShowMessages Then
        MessageToUser( SRestNotExclusive, smsgerror, MB_ICONERROR );
      Raise;
    End;
  Finally
    Open;
  End;

  ForceOpened;
  If FEzDStream = Nil Then Exit;

  // Calc correct RecordCount
  RecCount := Self.RecordCount;
  If RecCount = 0 Then Exit;

  HasDeleted := False;
  { check all DBF recs that are not marked for deletion }
  If FDBTable <> Nil Then
    FDBTable.SetTagTo( '' );

  NetworkCount:= 0;

  FEzXStream.Seek( SizeOf( TEzxData ), 0 );
  For cnt := 1 To RecCount Do
  Begin
    Try
      FEzXStream.Read( EzxData, SizeOf( TEzxData ) );
      If EzxData.EntityID In [idNode, idNodeLink] then
        Inc( NetworkCount );
      If EzxData.IsDeleted Then
      Begin
        If FDBTable <> Nil Then
        Begin
          If cnt > FDBTable.RecordCount Then Break;
          FDBTable.RecNo := cnt;
          If Not FDBTable.Deleted Then
            FDBTable.Delete;
        End;
        HasDeleted := True;
        Break;
      End;
    Except
      // ignore error probably caused for hard disk damage
    End;
  End;

  If Not HasDeleted Then
    NetworkCount := 0;

  PivotRecnos:= Nil;
  If NetworkCount > 0 then
  begin
    { create a bit array for marking original record numbers }
    PivotRecnos:= TIntegerList.Create;
    PivotRecnos.Capacity:= RecCount;
    For cnt := 1 To RecCount + 1 Do
    Begin
      PivotRecnos.Add( 0 );
    End;
  end;

  { Now check all entities that are not marked ( based on DBF deleted recs ) }
  If FDBTable <> Nil Then
  Begin
    For cnt := 1 To RecCount Do
    Begin
      If cnt > FDBTable.RecordCount Then Break;

      Try
        FDBTable.RecNo := cnt;
        If FDBTable.Deleted Then
        Begin
          FEzXStream.Seek( cnt * SizeOf( TEzxData ), 0 );
          FEzXStream.Read( EzxData, SizeOf( TEzxData ) );
          If Not EzxData.IsDeleted Then
          Begin
            EzxData.IsDeleted := true;
            FEzXStream.Seek( cnt * SizeOf( TEzxData ), 0 );
            FEzXStream.Write( EzxData, SizeOf( TEzxData ) );
          End;
        End;
      Except
        // ignore error probably caused for damaged DBF
      End;
    End;
  End;

  If ShowMessages Then
  Begin
    If Not HasDeleted And
      ( Application.MessageBox( PChar( SThereAreNoDeleted ), pchar( SMsgConfirm ),
      MB_YESNO Or MB_ICONQUESTION ) <> IDYES ) Then
    begin
      If Assigned( PivotRecnos ) then
        PivotRecnos.Free;
      Exit;
    end;
  End;

  // Create a temp gis and layer for packing
  TempGis:= TEzGis.Create(Nil);
  TempFileName := ChangeFileExt( GetTemporaryLayerName( ExtractFilePath( self.FileName ), 'PAK' ), '' );
  DeleteFilesSameName( TempFileName );
  TempGis.FileName:= TempFileName;
  TempGis.Open;
  TmpLayer := TEzLayer.Create( TempGis.Layers, TempFileName );

  With TmpLayer Do
  Begin
    FHeader := Self.FHeader;
    FHeader.RecordCount := 0;
    FHeader.IDCounter := 0;
    FEzDStream := TFileStream.Create( TempFileName + EZDEXT,
                    fmCreate Or fmShareExclusive );
    FEzDStream.Write( FHeader, Sizeof( TEzLayerHeader ) );
    FEzXStream := TFileStream.Create( TempFileName + EZXEXT,
        fmCreate Or fmShareExclusive );
    EzxHeader.RecordCount := 0;
    EzxHeader.HeaderID := LAYER_ID;
    EzxHeader.VersionNumber := LAYER_VERSION_NUMBER;
    FEzXStream.Write( EzxHeader, Sizeof( TEzxData ) );
    { create DB table }
    FieldList := TStringList.Create;
    try
      For cnt := 1 To Self.FDBTable.FieldCount Do
      Begin
        FieldList.Add( Format( '%s;%s;%d;%d',
          [Self.FDBTable.Field( cnt ), Self.FDBTable.FieldType( cnt ),
           Self.FDBTable.FieldLen( cnt ), Self.FDBTable.FieldDec( cnt )] ) );
      End;
      Self.FDBTable.DBCreateTable( TempFileName, FieldList );
    finally
      FieldList.free;
    end;
    { create the r-tree }
    If FHeader.IsIndexed Then
    Begin
      Frt.free;
      Frt := TEzRTree.Create( TmpLayer, RTYPE, fmOpenReadWrite Or fmShareDenyNone );
      Frt.CreateIndex( TempFileName, CoordMultiplier );
    End;
    Modified:= true;
    Close;
    ForceOpened;
  End;

  FEzXStream.Seek( SizeOf( TEzxData ), 0 );

  N := 0;
  NumBadRecords := 0;
  If (Gis <> Nil) And (RecCount > 0) Then
    GIS.StartProgress( SPackingLayer, 1, RecCount );
  For cnt := 1 To RecCount Do
  Begin
    if Gis <> Nil then GIS.UpdateProgress( cnt );
    Try
      FEzXStream.Read( EzxData, SizeOf( TEzxData ) );
      If EzxData.IsDeleted Or ( EzxData.Offset < 0 ) Or
        ( EzxData.Offset > Pred( FEzDStream.Size ) ) Then
        Continue;
      FEzDStream.Seek( EzxData.Offset, 0 );
      TmpEntity := Self.InternalLoadEntity( EzxData.EntityID, FEzDStream );
      If TmpEntity = Nil Then Continue;

      { Check Points of vector }
      IsValid := true;
      For J := 0 To TmpEntity.Points.Count - 1 Do
      Begin
        If PointOutOfRange( TmpEntity.Points[J] ) Then
        Begin
          IsValid := False;
          Break;
        End;
      End;
      If Not IsValid Then
      Begin
        TmpEntity.Free;
        Continue;
      End;
      TmpID := TmpEntity.ID;
      If FDBTable <> Nil Then
        FDBTable.RecNo := cnt;
      TmpLayer.FProposedID := TmpID;
      NewRecno:= TmpLayer.AddEntity( TmpEntity );
      If (NetworkCount > 0) And (TmpEntity.EntityID In [idNode, idNodeLink]) then
      begin
        { in the new record number is saved the old record number }
        PivotRecnos[NewRecno]:= cnt;
      end;

      if TmpLayer.DBTable <> Nil then
      begin
        TmpLayer.DBTable.Last;
        TmpLayer.DBTable.Edit;
        For K := 1 To FDBTable.FieldCount Do
        Begin
          Try
            //CopyDBFField( FDBTable, K, Halc, K );
            TmpLayer.DBTable.AssignFrom( FDbTable, K, K );
          Except
            // probably caused by wrong data in source file
       

⌨️ 快捷键说明

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