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

📄 ezflashfilergis.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  TreeBBox, ViewBBox: TRect_RT;
  RT: TRTree;
begin
  If Not FClientHasAllData Then  // All buffered is set only when all records have been local stored
  Begin
    CancelFilter;
    if IsCachedSpatialIndex then
      RT := FCachedRT
    else
      RT := FRT;
    TreeBBox := RT.RootExtent;
    ViewBBox := FloatRect2Rect(VisualWindow);
    if Contains_Rect(ViewBBox, TreeBBox) then Exit;
    if FOl = nil then
      FOl := TIntegerList.Create
    else
      FOl.Clear;
    RT.Search(S, ViewBBox, FOl, 1000);
    FFiltered := True;
    FFilterRecNo := -1;
  End Else
    LocalLayer.SetGraphicFilter(s, VisualWindow);
end;

procedure TEzFlashFilerLayer.CancelFilter;
begin
  If Not FClientHasAllData Then
  Begin
    if FOl <> nil then FreeAndNil(FOl);
    FFiltered := False;
  End Else
    LocalLayer.CancelFilter;
end;

function TEzFlashFilerLayer.Eof: Boolean;
begin
  If Not FClientHasAllData Then
  Begin
    if FFiltered then
      Result := FEofCrack
    else
      Result := FFlashFilerEntities.Eof;
  End Else
    Result:= LocalLayer.Eof;
end;

Function TEzFlashFilerLayer.IsClientBuffered: Boolean;
begin
  Result:= (Layers.GIS Is TEzFlashFilerGIS) And (Layers.GIS as TEzFlashFilerGIS).FClientBuffered;
end;

procedure TEzFlashFilerLayer.First;
begin
  If Not FClientHasAllData Then
  Begin
    if FFiltered then
    begin
      if (FOl <> nil) and (FOl.Count > 0) then
      begin
        FFilterRecNo := 0;
        FEofCrack := False;
        If IsClientBuffered Then
        Begin
          If FClientHasAllData Or (LocalRecno[FOl[FFilterRecNo]] = 0) Then
            SetRecNo(FOl[FFilterRecNo]);
        End Else
          SetRecNo(FOl[FFilterRecNo]);
      end
      else
      begin
        FEofCrack := True;
      end
    end
    else
    begin
      FFlashFilerEntities.First;
    end;
  End Else
    LocalLayer.First;
end;

procedure TEzFlashFilerLayer.Next;
var
  N: Integer;
begin
  If Not FClientHasAllData Then
  Begin
    if FFiltered then
    begin
      N := FOl.Count;
      if N > 0 then
      begin
        if FFilterRecNo < N - 1 then
        begin
          Inc(FFilterRecNo);
          If IsClientBuffered Then
          Begin
            If FClientHasAllData Or (LocalRecno[FOl[FFilterRecNo]] = 0) Then
              SetRecNo(FOl[FFilterRecNo]);
          End Else
            SetRecNo(FOl[FFilterRecNo]);
          FEofCrack := False;
        end
        else
        begin
          FFilterRecNo := N - 1;
          FEofCrack := True;
        end;
      end
      else
      begin
        FEofCrack := True;
      end
    end
    else
      FFlashFilerEntities.Next;
  End Else
    LocalLayer.Next;
end;

procedure TEzFlashFilerLayer.Last;
var
  N: Integer;
begin
  If Not FClientHasAllData Then
  Begin
    if FFiltered then
    begin
      N := FOl.Count;
      if N > 0 then
      begin
        FFilterRecNo := N - 1;
        If IsClientBuffered Then
        Begin
          If FClientHasAllData Or (LocalRecno[FOl[FFilterRecNo]] = 0) Then
            SetRecNo(FOl[FFilterRecNo]);
        End Else
          SetRecNo(FOl[FFilterRecNo]);
        FEofCrack := False;
      end
      else
      begin
        FEofCrack := True;
      end;
    end
    else
    begin
      FFlashFilerEntities.Last;
    end;
  End Else
    LocalLayer.Last;
end;

procedure TEzFlashFilerLayer.StartBuffering;
begin
  If Not FClientHasAllData Then
  Begin
  End Else
    LocalLayer.StartBuffering;
end;

procedure TEzFlashFilerLayer.EndBuffering;
begin
  If Not FClientHasAllData Then
  Begin
  End Else
    LocalLayer.EndBuffering;
end;

procedure TEzFlashFilerLayer.Assign(Source: TEzBaseLayer);
begin
  If Not FClientHasAllData Then
  Begin
  End Else
    LocalLayer.Assign(Source);
end;

function TEzFlashFilerLayer.GetExtensionForRecords(List: TIntegerList): TEzRect;
var
  I: Integer;
  Bounds: TEzRect;
begin
  If Not FClientHasAllData Then
  Begin
    Result := INVALID_EXTENSION;
    Assert(List <> Nil);
    if List.Count = 0 then Exit;
    for I := 0 to List.Count-1 do
    begin
      SetRecNo(List[I]);
      with FFlashFilerEntities do
      begin
        Bounds.X1 := FieldByName('Xmin').AsFloat;
        Bounds.Y1 := FieldByName('Ymin').AsFloat;
        Bounds.X2 := FieldByName('Xmax').AsFloat;
        Bounds.Y2 := FieldByName('Ymax').AsFloat;
        MaxBound(Result.Emax, Bounds.Emax);
        MinBound(Result.Emin, Bounds.Emin);
      end;
    end;
  End Else
    Result:= LocalLayer.GetExtensionForRecords(List);
end;

procedure TEzFlashFilerLayer.UpdateCachedTree;
var
  I, Index, RecCount: Integer;
  ShapeType: TEzEntityID;
  Gis: TEzBaseGis;
  Extents: TEzRect;
  Ol, OlCached: TIntegerList;
begin
  Gis := Layers.Gis;
  if not IsCachedSpatialIndex then Exit;

  RecCount := RecordCount;

  if RecCount > 0 then
    Gis.StartProgress(Format(SRebuildTree, [Name]), 1, RecCount);
  Ol := TIntegerList.Create;
  OlCached := TIntegerList.Create;
  try
    FRT.GetAllNodes(Ol);
    FCachedRT.GetAllNodes(OlCached);
    OlCached.Sort;
    for I := 0 to Ol.Count-1 do
    begin
      if not OlCached.Find(Ol[I], Index) and FFlashFilerEntities.FindKey([Ol[I]]) then
      begin
        with FFlashFilerEntities do
        begin
          Extents.X1 := FieldByName('Xmin').AsFloat;
          Extents.Y1 := FieldByName('Ymin').AsFloat;
          Extents.X2 := FieldByName('Xmax').AsFloat;
          Extents.Y2 := FieldByName('Ymax').AsFloat;
          ShapeType := TEzEntityID(FieldByName('ShapeType').AsInteger);
          if (ShapeType <> idNone) and not EqualRect2D(Extents, INVALID_EXTENSION) then
          begin
            FCachedRT.Insert(FloatRect2Rect(Extents), FieldByName('UID').AsInteger);
          end;
        end;
      end;
    end;
  finally
    if RecCount > 0 then Gis.EndProgress;
    Ol.Free;
    OlCached.Free;
  end;
end;

procedure TEzFlashFilerLayer.BuildRTreeInMemory(var RT: TRTree);
var
  I, RecCount: Integer;
  ShapeType: TEzEntityID;
  Gis: TEzBaseGis;
  Extents: TEzRect;
begin
  Gis := Layers.Gis;
  // A memory R-Tree used for fast speed
  if RT <> nil then FreeAndNil(RT);
  // nota: en esta version se cambio a un disk based r-tree

  //RT := TEzRTree.Create(Self, RTYPE, 0);
  RT := TMemRtree.Create(Self, RTYPE, 0);
  // Create the Index
  RT.CreateIndex('', CoordMultiplier);
  RecCount := RecordCount;

  // Create the Index
  I := 0;
  if RecCount > 0 then
    Gis.StartProgress(Format(SRebuildTree, [Name]), 1, RecCount);
  try
    {$IFDEF CACHED_TABLE}
    if FFlashFilerEntities is TffCachedTable then
      FFlashFilerEntities.CacheOnOptimum(cmRead)
    else
    {$ENDIF}
      FFlashFilerEntities.First;
    while not FFlashFilerEntities.Eof do
    begin
      Inc(I);
      Gis.UpdateProgress(I);
      with FFlashFilerEntities do
      begin
        Extents.X1 := FieldByName('Xmin').AsFloat;
        Extents.Y1 := FieldByName('Ymin').AsFloat;
        Extents.X2 := FieldByName('Xmax').AsFloat;
        Extents.Y2 := FieldByName('Ymax').AsFloat;

        ShapeType := TEzEntityID(FieldByName('ShapeType').AsInteger);

        if (ShapeType <> idNone) and not EqualRect2D(Extents, INVALID_EXTENSION) then
          RT.Insert(FloatRect2Rect(Extents), FieldByName('UID').AsInteger);
      end;
      FFlashFilerEntities.Next;
    end;
  finally
    {$IFDEF CACHED_TABLE}
    if FFlashFilerEntities is TffCachedTable then
      FFlashFilerEntities.CacheOff;
    {$ENDIF}
    if RecCount > 0 then
      Gis.EndProgress;
  end;
end;

procedure TEzFlashFilerLayer.RebuildTree;
var
  Gis: TEzFlashFilerGis;
  IdxInfo: TRTCatalog;
  DP: PDiskPage;
  I, J: Integer;
  TempTable: TffTable;
begin
  If Not FClientHasAllData Then
  Begin
    Gis := Layers.Gis as TEzFlashFilerGIS;
    if Gis.ReadOnly then Exit;

    if not FFlashFilerEntities.Active then Exit;

    if FRT <> nil then
      FreeAndNil(FRT);

    BuildRTreeInMemory(FRT);

    if not FFlashFilerHeader.Active then Exit;

    // Update the header
    FRT.ReadCatalog(IdxInfo);
    with FFlashFilerHeader do
    begin
      try
        Edit;
        FieldByName('RootNode').AsInteger := IdxInfo.RootNode;
        FieldByName('Depth').AsInteger := IdxInfo.Depth;
        FieldByName('Multiplier').AsInteger := IdxInfo.Multiplier;
        FieldByName('BucketSize').AsInteger := BucketSize;
        FieldByName('LowerBound').AsInteger := LowerBound;
        Post;
      except
        if State = dsEdit then
          Cancel;
        raise;
      end;
    end;
    // Now recreate the RTX_Xxx file

    // Delete all the R-Tree records (This might not work in CS scenarios)
    with TEzFlashFilerGIS(GIS) do
      If TableExists('RTX_' + Name) Then
        DropFlashFilerTable('RTX_' + Name);

    // Now insert all the nodes
    //  Note: We assume here that the PageId will be created consecutively
    //  starting from 1
    TempTable:= GIS.CreateFlashFilerTable;
    try
      with TempTable do
      begin
        TableName := 'RTX_' + Self.Name;
        with FieldDefs do
        begin
          Clear;
          Add('PageId', ftAutoInc, 0, False);
          Add('Parent', ftInteger, 0, False);
          Add('FullEntries', ftInteger, 0, False);
          Add('Leaf', ftBoolean, 0, False);
          for I := 0 to BucketSize - 1 do
          begin
            Add('X1_' + IntToStr(I), ftInteger, 0, False);
            Add('Y1_' + IntToStr(I), ftInteger, 0, False);
            Add('X2_' + IntToStr(I), ftInteger, 0, False);
            Add('Y2_' + IntToStr(I), ftInteger, 0, False);
            Add('Child_' + IntToStr(I), ftInteger, 0, False);
          end;
        end;
        with IndexDefs do
        begin
          Clear;
          Add('ixPrimary', 'PageId', []);
        end;
        if not Exists then
          CreateTable
        Else
          EmptyTable;

        Open;

        try
          // Maybe this transaction blocks the RTX_Xxx table for a long time,
          // but it cannot be used by others anyway
          Database.StartTransactionWith([TempTable]);
          for I := 0 to TMemRTree(FRT).PageCount - 1 do
          begin
            DP := TMemRTree(FRT).DiskPagePtr[I];

            Insert;
            FieldByName('Parent').AsInteger := DP^.Parent;
            FieldByName('FullEntries').AsInteger := DP^.FullEntries;
            FieldByName('Leaf').AsBoolean := DP^.Leaf;
            for J := 0 to BucketSize - 1 do
            begin
              FieldByName('X1_' + IntToStr(J)).AsInteger := DP^.Entries[J].R.X1;
              FieldByName('Y1_' + IntToStr(J)).AsInteger := DP^.Entries[J].R.Y1;
              FieldByName('X2_' + IntToStr(J)).AsInteger := DP^.Entries[J].R.X2;
              FieldByName('Y2_' + IntToStr(J)).AsInteger := DP^.Entries[J].R.Y2;
              FieldByName('Child_' + IntToStr(J)).AsInteger := DP^.Entries[J].Child;
            end;
            Post;
          end;
          Database.Commit;
        except
          on E: Exception do begin
            try
              if State = dsInsert then
                Cancel;
            finally
              Database.Rollback;
              raise E;
            end;
          end;
        end;
      end;

⌨️ 快捷键说明

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