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

📄 ezbasicctrls.pas

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

Procedure TEzMemLayerInfo.SetOverlappedTextAction( Value: TEzOverlappedTextAction );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.OverlappedTextAction = Value Then
    Exit;
  TEzMemoryLayer( FLayer ).FHeader.OverlappedTextAction := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetOverlappedTextColor: TColor;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.OverlappedTextColor;
End;

Procedure TEzMemLayerInfo.SetOverlappedTextColor( Value: TColor );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.OverlappedTextColor = Value Then
    Exit;
  TEzMemoryLayer( FLayer ).FHeader.OverlappedTextColor := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetTextHasShadow: boolean;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.TextHasShadow;
End;

Procedure TEzMemLayerInfo.SetTextHasShadow( Value: boolean );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.TextHasShadow = Value Then
    Exit;
  TEzMemoryLayer( FLayer ).FHeader.TextHasShadow := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetTextFixedSize: Byte;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.TextFixedSize;
End;

Procedure TEzMemLayerInfo.SetTextFixedSize( Value: Byte );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.TextFixedSize = Value Then
    Exit;
  TEzMemoryLayer( FLayer ).FHeader.TextFixedSize := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetSelectable: boolean;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.Selectable;
End;

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

Function TEzMemLayerInfo.GetExtension: TEzRect;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.Extension;
End;

Procedure TEzMemLayerInfo.SetExtension( Const Value: TEzRect );
Begin
  If EqualRect2D( Value, TEzMemoryLayer( FLayer ).FHeader.Extension ) Then
    Exit;
  TEzMemoryLayer( FLayer ).FHeader.Extension := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetIDCounter: integer;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.IDCounter;
End;

Procedure TEzMemLayerInfo.SetIDCounter( Value: integer );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.IDCounter = Value Then
    Exit;
  TEzMemoryLayer( FLayer ).FHeader.IDCounter := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetIsAnimationLayer: boolean;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.IsAnimationLayer;
End;

Procedure TEzMemLayerInfo.SetIsAnimationLayer( Value: boolean );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.IsAnimationLayer = Value Then Exit;
  TEzMemoryLayer( FLayer ).FHeader.IsAnimationLayer := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetCoordSystem: TEzCoordSystem;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.CoordSystem;
End;

Procedure TEzMemLayerInfo.SetCoordSystem( Value: TEzCoordSystem );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.CoordSystem = Value Then
    Exit;
  With TEzMemoryLayer( FLayer ) Do
  Begin
    FHeader.CoordSystem := Value;
    If Value = csLatLon Then
    Begin
      CoordMultiplier := DEG_MULTIPLIER;
      FHeader.coordsunits := cuDeg;
    End
    Else
      CoordMultiplier := 1;
  End;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetCoordsUnits: TEzCoordsUnits;
Begin
  result := TEzMemoryLayer( FLayer ).FHeader.CoordsUnits;
End;

Procedure TEzMemLayerInfo.SetCoordsUnits( Value: TEzCoordsUnits );
Begin
  With TEzMemoryLayer( FLayer ) Do
  Begin
    If FHeader.coordsunits = value Then Exit;
    If FHeader.CoordSystem = csLatLon Then
      FHeader.CoordsUnits := cuDeg
    Else
      FHeader.CoordsUnits := Value;
  End;
  SetModifiedStatus( FLayer );
End;

Function TEzMemLayerInfo.GetIsIndexed: boolean;
Begin
  With TEzMemoryLayer( FLayer ) Do
    result := FHeader.IsIndexed And ( Frt <> Nil );
End;

Procedure TEzMemLayerInfo.SetIsIndexed( Value: boolean );
Begin
  If TEzMemoryLayer( FLayer ).FHeader.IsIndexed = Value Then
    Exit;
  TEzMemoryLayer( FLayer ).FHeader.IsIndexed := Value;
  SetModifiedStatus( FLayer );
End;

{ TEzMemoryLayer - class implementation }

Constructor TEzMemoryLayer.Create( Layers: TEzBaseLayers; Const AFileName: String );
Begin
  Inherited Create( Layers, AFileName );
  FLayerInfo := TEzMemLayerInfo.Create( self );
  FEntities := TList.Create;
  FDelStatus := TBits.Create;

  Self.FileName := ChangeFileExt( AFileName, '' );
  Self.Name := ExtractFileName( AFileName );
  With FHeader Do
  Begin
    HeaderID := 8003;
    VersionNumber := LAYER_VERSION_NUMBER;
    IDCounter := 0;
    Extension := INVALID_EXTENSION;
    Visible := True;
    Selectable := True;
    FillChar( Reserved, SizeOf( Reserved ), 0 );
    IsMemoryLayer:= true;
  End;
  CoordMultiplier := 1;

  FCopierStream := TMemoryStream.Create;
End;

Destructor TEzMemoryLayer.Destroy;
Begin
  Inherited Destroy;
  Close;
  FEntities.Free;
  FDelStatus.Free;
  FCopierStream.Free;
End;

function TEzMemoryLayer.GetBookmark: Pointer;
var
  I: Integer;
  bmrk: TEzMemBookmark;
begin
  bmrk:= TEzMemBookmark.Create;
  bmrk.FRecno:= FRecno;
  bmrk.FFiltered:= FFiltered;
  bmrk.FEofCrack:= FEofCrack;
  bmrk.FFilterRecno:= FFilterRecno;
  if (ol <> nil) and (ol.Count > 0) then
  begin
    bmrk.Fol.Capacity:= ol.Count;
    for I:= 0 to ol.Count-1 do
      bmrk.Fol.Add( ol[I] );
  end;
  Result:= bmrk;
end;

procedure TEzMemoryLayer.GotoBookmark(Bookmark: Pointer);
var
  I: Integer;
  bmrk: TEzMemBookmark;
begin
  bmrk:= TEzMemBookmark(Bookmark);
  FRecno:= bmrk.FRecno;
  FFiltered:= bmrk.FFiltered;
  FEofCrack:= bmrk.FEofCrack;
  FFilterRecno:= bmrk.FFilterRecno;
  if bmrk.Fol.Count > 0 then
  begin
    if ol = nil then ol := TIntegerList.Create;
    ol.clear;
    ol.Capacity:= bmrk.Fol.Count;
    for I:= 0 to bmrk.Fol.Count-1 do
      ol.Add( bmrk.Fol[I] );
  end else if ol <> nil then
    ol.clear;
end;

procedure TEzMemoryLayer.FreeBookmark(Bookmark: Pointer);
begin
  TEzMemBookmark(Bookmark).Free;
end;

function TEzMemoryLayer.GetExtensionForRecords( List: TIntegerList ): TEzRect;
var
  I, TheRecno:Integer;
  Extent: TEzRect;
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 > FEntities.Count) then Continue;
    Extent:= TEzEntity(FEntities[TheRecno-1]).FBox;
    MaxBound(Result.Emax, Extent.Emax);
    MinBound(Result.Emin, Extent.Emin);
  end;
end;

Procedure TEzMemoryLayer.InitializeOnCreate( Const FileName: String;
  AttachedDB, IsAnimation: Boolean; CoordSystem: TEzCoordSystem;
  CoordsUnits: TEzCoordsUnits; FieldList: TStrings );
Var
  Stream: TFileStream;
Begin
  { initialize this layer
   warning !!!
   this method is for internal use only and you must never call this method }
  FHeader.CoordsUnits := CoordsUnits;
  FHeader.IsIndexed := True;
  FHeader.IsAnimationLayer := False;
  FHeader.UseAttachedDB := False;
  // initialize the file
  Stream := TFileStream.Create( FileName + CADEXT, fmCreate );
  Try
    Stream.Write( FHeader, sizeof( TEzLayerHeader ) );
  Finally
    Stream.free;
  End;
  If Frt <> Nil Then
    Frt.free;
  Frt := TMemRTree.Create( Self, RTYPE, fmCreate );
  Frt.CreateIndex( '', CoordMultiplier );
  If FDelStatus <> Nil Then
    FDelStatus.Free;
  FDelStatus := TBits.Create;
  Modified := True;
End;

Procedure TEzMemoryLayer.Zap;
Var
  I: Integer;
Begin
  For I := 0 To FEntities.Count - 1 Do
    TEzEntity( FEntities[I] ).Free;
  FEntities.Clear;
  Frt.free;
  Frt := TMemRTree.Create( Self, RTYPE, fmCreate );
  Frt.CreateIndex( FileName, CoordMultiplier );
  If FDelStatus <> Nil Then
    FDelStatus.Free;
  FDelStatus := TBits.Create;
  Modified := True;
End;

Function TEzMemoryLayer.GetDBTable: TEzBaseTable;
Begin
  result := Nil;
End;

Function TEzMemoryLayer.GetRecno: Integer;
Begin
  If FFiltered Then
    result := Longint( ol[FFilterRecno] )
  Else
    result := FRecno;
End;

Procedure TEzMemoryLayer.SetRecno( Value: Integer );
Begin
  If ( Value < 1 ) Or ( Value > FEntities.Count ) Then
    EzGISError( SRecnoInvalid );
  FRecno := Value;
End;

Function TEzMemoryLayer.SendEntityToBack( ARecno: Integer ): Integer;
Var
  Ent: TEzEntity;
  bbox: TEzRect;
Begin
  Result := 0;
  if LayerInfo.Locked then Exit;
  If ( ARecno > 1 ) And ( ARecno < FEntities.Count ) Then
  Begin
    ent := TEzEntity( FEntities[ARecno - 1] );
    bbox := ent.FBox;
    FEntities.Delete( ARecno - 1 );
    FEntities.Insert( 0, ent );
    Frt.Delete( FloatRect2Rect( bbox ), ARecno );
    Frt.Insert( FloatRect2Rect( bbox ), 1 );
    Result := 1;
    { pendiente que pasa cuando esta borrado }
  End;
End;

Function TEzMemoryLayer.BringEntityToFront( ARecno: Integer ): Integer;
Var
  Ent: TEzEntity;
Begin
  Result := 0;
  If LayerInfo.Locked then Exit;
  If ( ARecno > 0 ) And ( ARecno < FEntities.Count ) Then
  Begin
    ent := TEzEntity( FEntities[ARecno - 1] );
    FEntities.Delete( ARecno - 1 );
    FEntities.Add( ent );
    Frt.Delete( FloatRect2Rect( ent.FBox ), ARecno );
    Frt.Insert( FloatRect2Rect( ent.FBox ), FEntities.Count );
    Result := 1;
    { pendiente que pasa cuando esta borrado }
  End;
End;

Function TEzMemoryLayer.GetActive: Boolean;
Begin
  Result := FIsOpened;
End;

Procedure TEzMemoryLayer.SetActive( Value: Boolean );
Begin
End;

Procedure TEzMemoryLayer.SetGraphicFilter( s: TSearchType; Const VisualWindow: TEzRect );
Var
  treeBBox, viewBBox: TRect_rt;
Begin
  FFiltered := False;
  If Not FHeader.IsIndexed or (Frt = Nil) Then Exit;
  If ol = Nil Then
    ol := TIntegerList.Create
  Else
    ol.clear;
  treeBBox := Frt.RootExtent;
  viewBBox := FloatRect2Rect( VisualWindow );
  If Contains_rect( viewBBox, treeBBox ) Then
  Begin
    FreeAndNil( ol );
    Exit;
  End;
  Frt.Search( S, viewBBox, ol, FEntities.Count );
  FFiltered := True;
  FFilterRecno := -1;
End;

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

Function TEzMemoryLayer.Eof: Boolean;
Begin
  result := FEofCrack;
End;

Procedure TEzMemoryLayer.First;
Begin
  If FFiltered Then
  Begin
    If ( ol <> Nil ) And ( ol.Count > 0 ) Then
    Begin
      FFilterRecno := 0;
      FEofCrack := False;

⌨️ 快捷键说明

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