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

📄 ezctrls.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  If Not found Then Exit;
  result := I; // return the record to move
  If ARecno = I Then Exit;
  With FEzXStream Do
  Begin
    { read the selected record }
    Seek( result * SizeOf( TEzxData ), 0 );
    Read( EzxData1, SizeOf( TEzxData ) );
    Prev[1] := EzxData1.Extension;
    {read the selected record}
    Seek( ARecno * SizeOf( TEzxData ), 0 );
    Read( EzxDataN, SizeOf( TEzxData ) );
    Prev[2] := EzxDataN.Extension;
    {and swap}
    Seek( result * SizeOf( TEzxData ), 0 );
    Write( EzxDataN, SizeOf( TEzxData ) );
    Frt.Update( FloatRect2Rect( Prev[1] ), result, FloatRect2Rect( Prev[2] ) );
    Seek( ARecno * SizeOf( TEzxData ), 0 );
    Write( EzxData1, SizeOf( TEzxData ) );
    Frt.Update( FloatRect2Rect( Prev[2] ), ARecno, FloatRect2Rect( Prev[1] ) );
  End;
  ExchangeDBRecord( Self, 1, ARecno );
End;

Function TEzLayer.BringEntityToFront( ARecno: Integer ): Integer;
Var
  EzxData, EzxDataN, EzxDataLast: TEzxData;
  I: Integer;
  found: boolean;
  Prev: Array[1..2] Of TEzRect;
Begin
  result := 0;
  If Layers.GIS.ReadOnly Or LayerInfo.Locked Then Exit;
  found := false;
  For I := FHeader.RecordCount Downto 1 Do
  Begin
    With FEzXStream Do
    Begin
      Seek( I * sizeof( TEzxData ), 0 );
      Read( EzxData, sizeof( EzxData ) );
      If Not EzxData.IsDeleted Then
      Begin
        found := true;
        break;
      End;
    End;
  End;
  If Not found Then Exit;
  Result := I; // return the record to move
  With FEzXStream Do
  Begin
    { read the last record }
    Seek( Result * SizeOf( TEzxData ), 0 );
    Read( EzxDataLast, SizeOf( TEzxData ) );
    Prev[1] := EzxDataLast.Extension;
    {read the selected record}
    Seek( ARecno * SizeOf( TEzxData ), 0 );
    Read( EzxDataN, SizeOf( TEzxData ) );
    Prev[2] := EzxDataN.Extension;
    {and swap}
    Seek( result * SizeOf( TEzxData ), 0 );
    Write( EzxDataN, SizeOf( TEzxData ) );
    Frt.Update( FloatRect2Rect( Prev[1] ), result, FloatRect2Rect( Prev[2] ) );
    Seek( ARecno * SizeOf( TEzxData ), 0 );
    Write( EzxDataLast, SizeOf( TEzxData ) );
    Frt.Update( FloatRect2Rect( Prev[2] ), ARecno, FloatRect2Rect( Prev[1] ) );
  End;
  ExchangeDBRecord( Self, ARecno, RecordCount );
End;

Procedure TEzLayer.SetGraphicFilter( s: TSearchType; Const VisualWindow: TEzRect );
Var
  treeBBox, viewBBox: TRect_rt;
Begin
  Assert( Not FFiltered, SFilterEnabled );
  FFiltered := false;
  If Not FHeader.IsIndexed Then Exit;
  treeBBox := Frt.RootExtent;
  viewBBox := FloatRect2Rect( VisualWindow );
  If Contains_rect( viewBBox, treeBBox ) Then Exit;
  If ol = Nil Then
    ol := TIntegerList.Create
  Else
    ol.clear;
  Frt.Search( S, viewBBox, ol, FHeader.RecordCount );
  //SortList(ol);
  FFiltered := True;
  FFilterRecno := -1;
  FCurrentLoaded := 0;
End;

Procedure TEzLayer.CancelFilter;
Begin
  If ol <> Nil Then
    FreeAndNil( ol );
  FFiltered := False;
End;

Function TEzLayer.Eof: Boolean;
Begin
  Result := FEofCrack
End;

Procedure TEzLayer.First;
Begin
    If FFiltered Then
    Begin
      If ( ol <> Nil ) And ( ol.Count > 0 ) Then
      Begin
        FFilterRecno := 0;
        FEofCrack := false;
      End
      Else
      Begin
        FEofCrack := true;
      End
    End
    Else If FHeader.RecordCount > 0 Then
    Begin
      If FBuffEnx <> Nil Then // is buffering ?
      Begin
        FBuffEnx.Read( FEzxData, SizeOf( TEzxData ) );
      End;
      FRecno := 1;
      FEofCrack := false;
    End
    Else
    Begin
      FEofCrack := true;
    End;
End;

Procedure TEzLayer.Next;
Var
  N: Integer;
Begin
    If FFiltered Then
    Begin
      N := ol.count;
      If N > 0 Then
      Begin
        If FFilterRecno < N - 1 Then
        Begin
          Inc( FFilterRecno );
          FEofCrack := false;
        End
        Else
        Begin
          FFilterRecno := N - 1;
          FEofCrack := true;
        End;
      End
      Else
      Begin
        FEofCrack := true;
      End
    End
    Else
    Begin
      N := FHeader.RecordCount;
      If N > 0 Then
      Begin
        If FBuffEnx <> Nil Then // is buffering ?
        Begin
          FBuffEnx.Read( FEzxData, SizeOf( TEzxData ) );
        End;
        If FRecno < N Then
        Begin
          Inc( FRecno );
          FEofCrack := false;
        End
        Else
        Begin
          FRecno := N;
          FEofCrack := true;
        End;
      End
      Else
      Begin
        FEofCrack := true;
      End;
    End;
End;

Procedure TEzLayer.Last;
Var
  N: Integer;
Begin
    If FFiltered Then
    Begin
      N := ol.count;
      If N > 0 Then
      Begin
        FFilterRecno := N - 1;
        FEofCrack := false;
      End
      Else
      Begin
        FEofCrack := true;
      End;
    End
    Else
    Begin
      N := FHeader.RecordCount;
      If N > 0 Then
      Begin
        FRecno := N;
        FEofCrack := false;
      End
      Else
      Begin
        FEofCrack := true;
      End;
    End;
End;

Procedure TEzLayer.StartBuffering;
Begin
  EndBuffering;
  If FFiltered or not Active Then Exit; // not allowed buffering when it's filtered
    FEzXStream.Seek( FRecno * SizeOf( TEzxData ), 0 );
    FBuffEnx := TEzBufferedRead.Create( FEzXStream, SIZE_LONGBUFFER );
    FBuffEnx.Read( FEzxData, SizeOf( TEzxData ) ); // read the first record
End;

Procedure TEzLayer.EndBuffering;
Begin
    If FBuffEnx <> Nil Then
      FreeAndNil( FBuffEnx );
    FCurrentLoaded := 0;
End;

Procedure TEzLayer.Assign( Source: TEzBaseLayer );
Var
  TmpID: Integer;
Begin
  If Not (Source Is TEzLayer) Then Exit;
  TmpID := FHeader.IDCounter;
  FHeader := TEzLayer( Source ).FHeader;
  FHeader.IDCounter := TmpID;
End;

function TEzLayer.GetExtensionForRecords( List: TIntegerList ): TEzRect;
var
  I, TheRecno:Integer;
  EzxData: TEzxData;
begin
    Result:= INVALID_EXTENSION;
    if (List=nil) or (List.Count=0) then Exit;
    for I:= 0 to List.Count-1 do
    begin
      TheRecno:= List[I];
      if (TheRecno < 1) or (TheRecno > FHeader.RecordCount) then Continue;
      FEzXStream.Seek( TheRecno * SizeOf( TEzxData ), 0 );
      FEzXStream.Read( EzxData, SizeOf( TEzxData ) );
      MaxBound(Result.Emax, EzxData.Extension.Emax);
      MinBound(Result.Emin, EzxData.Extension.Emin);
    end;
end;

Procedure TEzLayer.RebuildTree;
Var
  BuffEnx: TEzBufferedRead;
  I, J, RecCount: Integer;
  EzxData: TEzxData;
  Mode: Word;
  StreamRtc, StreamRtx: TStream;
  IdxInfo: TRTCatalog;
  dp: PDiskPage;
  Gis: TEzBaseGIS;
Begin
  Gis:= Layers.Gis;
  If Gis.ReadOnly Or Not FHeader.IsIndexed Then Exit;

  ForceOpened;
  If FEzDStream = Nil Then Exit;

  RecCount := Self.RecordCount;


  If Frt <> Nil Then
    FreeAndNil( Frt );
  Mode := Layers.GIS.OpenMode;
  { A memory r-tree used for fast speed }
  Frt := TMemRTree.Create( Self, RTYPE, Mode );
  // Create the index
  Frt.CreateIndex( '', CoordMultiplier );
  // Now add all the entities to the R-tree
  FEzXStream.Seek( SizeOf( TEzxData ), 0 );
  BuffEnx := TEzBufferedRead.Create( FEzXStream, SIZE_LONGBUFFER );

  If RecCount > 0 Then
    GIS.StartProgress( Format( SRebuildTree, [Name] ), 1, RecCount );
  Try
    For I := 1 To RecCount Do
    Begin
      GIS.UpdateProgress( I );
      BuffEnx.Read( EzxData, SizeOf( TEzxData ) );
      If EzxData.IsDeleted Or (EzxData.EntityID=idNone) Then Continue;

      Frt.Insert( FloatRect2Rect( EzxData.Extension ), I );
    End;
    { now create the files based on the memory r-tree }
    StreamRtc := TFileStream.Create( FileName + RTCEXT, fmCreate );
    StreamRtx := TFileStream.Create( FileName + RTXEXT, fmCreate );
    Try
      FillChar( IdxInfo, sizeof( IdxInfo ), 0 );
      With IdxInfo Do
      Begin
        PageCount := TMemRTree( Frt ).PageCount;
        Depth := TMemRTree( Frt ).Depth;
        FreePageCount := 0;
        RootNode := ( TMemRTree( Frt ).RootId - 1 ) * sizeof( TDiskPage );
        Implementor := 1; // 1=luis, 2=Garry
        TreeType := ttRTree;
        PageSize := 1;
        Version := TREE_VERSION;
        Multiplier := CoordMultiplier;
        BucketSize := ezrtree.BUCKETSIZE;
        LowerBound := ezrtree.LOWERBOUND;
        LastUpdate := Now;
      End;

      StreamRtc.Write( IdxInfo, sizeof( IdxInfo ) );
      { now write all the pages }
      For I := 0 To IdxInfo.PageCount - 1 Do
      Begin
        dp := TMemRTree( Frt ).DiskPagePtr[I];
        If dp^.Parent <> -1 Then
          dp^.Parent := ( dp^.Parent - 1 ) * sizeof( TDiskPage );
        If Not dp^.Leaf Then
          For J := 0 To dp^.FullEntries - 1 Do
            dp^.Entries[J].Child := ( dp^.Entries[J].Child - 1 ) * sizeof( TDiskPage );
        StreamRtx.Write( dp^, sizeof( TDiskPage ) );
      End;
    Finally
      StreamRtc.free;
      StreamRtx.free;
    End;
  Finally
    BuffEnx.free;
    Frt.Free; // delete memory rtree
    Frt := TEzRTree.Create( Self, RTYPE, Mode ); // open the disk based r-tree
    Frt.Open( Self.FileName, Mode );
    If RecCount > 0 Then
      GIS.EndProgress;
  End;
  If Not FHeader.Visible Then
    Frt.Close;
  WriteHeaders( true );
End;

Procedure TEzLayer.Open;
Var
  AFileName: String;
  EzxHeader: TEzxData;
  TmpStream: TFileStream;
  Mode: Word;
  GIS: TEzBaseGIS;
Begin

  Close;

  If Not FHeader.Visible Then Exit;

  GIS := Layers.GIS;
  Mode := GIS.OpenMode;

  AFileName := FileName + EZDEXT;
  If FileExists( AFileName ) Then
  Begin
    TmpStream := TFileStream.Create( AFileName, Mode );
    TmpStream.Read( FHeader, SizeOf( TEzLayerHeader ) );
    FEzDStream := TmpStream;
    If GIS.MapInfo.CoordSystem = csLatLon Then
      CoordMultiplier := DEG_MULTIPLIER
    Else
      CoordMultiplier := 1;
    If FHeader.HeaderID <> LAYER_ID then
    begin
      //Raise EExpression.Create( SUnknownFormat );
    end;
  End
  Else If Not GIS.ReadOnly Then
  Begin
    FEzDStream := TFileStream.Create( AFileName, fmCreate Or fmShareDenyNone );
    FEzDStream.Write( FHeader, SizeOf( FHeader ) );
  End;

  AFileName := Self.FileName + EZXEXT;
  If FileExists( AFileName ) Then
  Begin
    FEzXStream := TFileStream.Create( AFileName, Mode );
  End
  Else If Not GIS.ReadOnly Then
  Begin
    FEzXStream := TFileStream.Create( AFileName, fmCreate Or fmShareDenyNone );
    EzxHeader.HeaderID := LAYER_IDX;
    EzxHeader.VersionNumber := LAYER_VERSION_NUMBER;
    EzxHeader.RecordCount := 0;
    EzxHeader.MaxRecSize := 0;
    FEzXStream.Write( EzxHeader, SizeOf( EzxHeader ) );
  End;

  { open the r-tree file }
  If FHeader.IsIndexed Then
  Begin
    Frt := TEzRTree.Create( Self, RTYPE, Mode );
    If Not FileExists( self.FileName + RTXEXT ) Or
      Not FileExists( self.FileName + RTCEXT ) Then
      // create the index
      RebuildTree
        //rt.CreateIndex( self.FileName )
    Else
      Frt.Open( self.FileName, Mode );
  End;

  If FHeader.UseAttachedDB Then
  Begin
    AFileName := Self.FileName;
    if BaseTableClass = Nil then
    begin
      FHeader.UseAttachedDB := False;
      Modified := True;
      EzGISError( SDBFNotFound );
    end;
    with EzBaseGIS.BaseTableClass.createNoOpen( Layers.Gis ) do
      try
        if not DBTableExists( AFileName ) then
        begin
          FHeader.UseAttachedDB := False;
          Modified := True;
          EzGISError( SDBFNotFound );
        end;

⌨️ 快捷键说明

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