📄 ezctrls.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      Begin
        Layer.DBTable.FieldPutN( cnt, DstFieldValues[cnt - 1] );
      End;
      Layer.DBTable.Post;
      { exchange with destination}
      Layer.DBTable.Recno:= DestRecno;
      Layer.DBTable.Edit;
      For cnt := 1 To Layer.DBTable.FieldCount Do
      Begin
        Layer.DBTable.FieldPutN( cnt, SrcFieldValues[cnt - 1] );
      End;
      Layer.DBTable.Post;
    Finally
      SrcFieldValues.Free;
      DstFieldValues.Free;
    End;
  End;
End;

{-------------------------------------------------------------------------------}
{                  TEzLayerInfo - class implementation                         }
{-------------------------------------------------------------------------------}

Function TEzLayerInfo.GetIsCosmethic: boolean;
Begin
  result := TEzLayer( FLayer ).FHeader.IsMemoryLayer;
End;

Procedure TEzLayerInfo.SetIsCosmethic( value: boolean );
Begin
  If TEzLayer( FLayer ).FHeader.IsMemoryLayer = value Then
    Exit;
  TEzLayer( FLayer ).FHeader.IsMemoryLayer := value;
  SetModifiedStatus( FLayer );
End;

Function TEzLayerInfo.GetLocked: Boolean;
Begin
  Result := TEzLayer( FLayer ).FHeader.Locked;
End;

Procedure TEzLayerInfo.SetLocked( Value: Boolean );
Begin
  TEzLayer( FLayer ).FHeader.Locked := Value;
End;

Function TEzLayerInfo.GetUseAttachedDB: boolean;
Begin
  result := TEzLayer( FLayer ).FHeader.UseAttachedDB;
End;

Procedure TEzLayerInfo.SetUseAttachedDB( Value: boolean );
Begin
  If TEzLayer( FLayer ).FHeader.UseAttachedDB = value Then
    Exit;
  TEzLayer( FLayer ).FHeader.UseAttachedDB := Value;
  SetModifiedStatus( FLayer );
End;

Function TEzLayerInfo.GetVisible: boolean;
Begin
  result := TEzLayer( FLayer ).FHeader.Visible;
End;

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

Function TEzLayerInfo.GetOverlappedTextAction: TEzOverlappedTextAction;
Begin
  result := TEzLayer( FLayer ).FHeader.OverlappedTextAction;
End;

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

Function TEzLayerInfo.GetOverlappedTextColor: TColor;
Begin
  result := TEzLayer( FLayer ).FHeader.OverlappedTextColor;
End;

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

Function TEzLayerInfo.GetTextHasShadow: boolean;
Begin
  result := TEzLayer( FLayer ).FHeader.TextHasShadow;
End;

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

Function TEzLayerInfo.GetTextFixedSize: Byte;
Begin
  result := TEzLayer( FLayer ).FHeader.TextFixedSize;
End;

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

Function TEzLayerInfo.GetSelectable: boolean;
Begin
  result := TEzLayer( FLayer ).FHeader.Selectable;
End;

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

Function TEzLayerInfo.GetExtension: TEzRect;
Begin
  result := TEzLayer( FLayer ).FHeader.Extension;
End;

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

Function TEzLayerInfo.GetIDCounter: integer;
Begin
  result := TEzLayer( FLayer ).FHeader.IDCounter;
End;

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

Function TEzLayerInfo.GetIsAnimationLayer: boolean;
Begin
  result := TEzLayer( FLayer ).FHeader.IsAnimationLayer;
End;

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

Function TEzLayerInfo.GetCoordSystem: TEzCoordSystem;
Begin
  result := TEzLayer( FLayer ).FHeader.CoordSystem;
End;

Procedure TEzLayerInfo.SetCoordSystem( Value: TEzCoordSystem );
Begin
  If TEzLayer( FLayer ).FHeader.CoordSystem = Value Then
    Exit;
  With TEzLayer( 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 TEzLayerInfo.GetCoordsUnits: TEzCoordsUnits;
Begin
  result := TEzLayer( FLayer ).FHeader.CoordsUnits;
End;

Procedure TEzLayerInfo.SetCoordsUnits( Value: TEzCoordsUnits );
Begin
  With TEzLayer( 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 TEzLayerInfo.GetIsIndexed: boolean;
Begin
  With TEzLayer( FLayer ) Do
    result := FHeader.IsIndexed And ( Frt <> Nil );
End;

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

{-------------------------------------------------------------------------------}
{                  TEzLayer - class implementation                                }
{-------------------------------------------------------------------------------}

Constructor TEzLayer.Create( Layers: TEzBaseLayers; Const AFileName: String );
Begin
  Inherited Create( Layers, AFileName );
  FLayerInfo := TEzLayerInfo.Create( self );
  FUpdateRtree := True;

  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 );
  End;
  CoordMultiplier := 1;
End;

Destructor TEzLayer.Destroy;
Begin
  Close;
  If ol <> Nil Then
    ol.free;
  If FBuffEnx <> Nil Then
    FBuffEnx.Free;
  If FBuffEnt <> Nil Then
    FBuffEnt.Free;

  // FLayerInfo is destroyed in the inherited class

  Inherited Destroy;

End;

Procedure TEzLayer.Synchronize;
Begin
  If FDBTable <> Nil Then
    FDBTable.Recno := Self.Recno;
End;

function TEzLayer.DeleteLayerFiles: Boolean;
Begin
    Result:= False;
    if LayerInfo.Locked then Exit;
    Result:= EzSystem.DeleteFilesSameName( Self.FileName );
end;

Procedure TEzLayer.InitializeOnCreate( Const FileName: String;
  AttachedDB, IsAnimation: Boolean; CoordSystem: TEzCoordSystem;
  CoordsUnits: TEzCoordsUnits; FieldList: TStrings );
Var
  TempFieldList: TStringList;
  EzxHeader: TEzxData;
Begin
  FHeader.CoordsUnits := CoordsUnits;
  FHeader.CoordSystem := CoordSystem;
  FHeader.IsIndexed := true; // all this kind of layers must be indexed
  FHeader.IsAnimationLayer := IsAnimation;
  FHeader.UseAttachedDB := AttachedDB;
  FEzDStream := TFileStream.Create( FileName + EZDEXT, fmCreate );
  FEzDStream.Write( FHeader, SizeOf( TEzLayerHeader ) );
  FreeAndNil( FEzDStream );
  FreeAndNil( FBuffEnt );
  FEzXStream := TFileStream.Create( FileName + EZXEXT, fmCreate );
  EzxHeader.HeaderID := LAYER_IDX;
  EzxHeader.VersionNumber := LAYER_VERSION_NUMBER;
  EzxHeader.RecordCount := 0;
  EzxHeader.MaxRecSize := 0;
  FEzXStream.Write( EzxHeader, SizeOf( TEzxData ) );
  FreeAndNil( FEzXStream );
  If AttachedDB Then
  Begin
    // Create the DBF file with a standar ID field
    TempFieldList := TStringList.Create;
    Try
      If ( FieldList <> Nil ) And ( FieldList.Count > 0 ) Then
        TempFieldList.AddStrings( FieldList );
      If TempFieldList.Count = 0 Then
        TempFieldList.Add( 'UID;N;11;0' );
      with EzBaseGIS.BaseTableClass.createNoOpen( Layers.Gis ) do
        try
          DBCreateTable( FileName, TempFieldList );
        finally
          free;
        end;
    Finally
      TempFieldList.Free;
    End;
  End;
End;

Procedure TEzLayer.GetFieldList( Strings: TStrings );
Var
  i: Integer;
Begin
    If DBTable <> Nil Then
      For i := 1 To DBTable.FieldCount Do
        Strings.Add( Format( '%s;%s;%d;%d', [DBTable.Field( I ), DBTable.FieldType( I ),
          DBTable.FieldLen( I ), DBTable.FieldDec( I )] ) );
End;

Procedure TEzLayer.StartBatchInsert;
Begin
  FUpdateRtree := false;
End;

Procedure TEzLayer.CancelBatchInsert;
Begin
  FUpdateRtree := false;
End;

Procedure TEzLayer.FinishBatchInsert;
Begin
  FUpdateRtree := true;
  RebuildTree;
End;

Procedure TEzLayer.Zap;
Var
  I: Integer;
  EzxData: TEzxData;
Begin
    For I := 1 To FHeader.RecordCount Do
      With FEzXStream Do
      Begin
        Seek( I * sizeof( TEzxData ), 0 );
        Read( EzxData, sizeof( EzxData ) );
        EzxData.IsDeleted := TRUE;
        Seek( I * sizeof( TEzxData ), 0 );
        Write( EzxData, sizeof( EzxData ) );
      End;
  Pack( False );
End;

Function TEzLayer.GetDBTable: TEzBaseTable;
Begin
  Result := FDBTable;
End;

Function TEzLayer.BuffEnt: TStream;
Var
  EzxHeader: TEzxData;
Begin
    If FBuffEnt = Nil Then
    Begin
      With FEzXStream Do
      Begin
        Seek( 0, 0 );
        Read( EzxHeader, SizeOf( TEzxData ) );
      End;
      FBuffEnt := TEzBufferedRead.Create( FEzDStream, 1024 );
    End;
  Result := FBuffEnt;
End;

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

Procedure TEzLayer.SetRecno( Value: Integer );
Begin
  If ( Value < 1 ) Or ( Value > FHeader.RecordCount ) Then
    EzGISError( SRecnoInvalid );
  FRecno := Value;
End;

Function TEzLayer.SendEntityToBack( ARecno: Integer ): Integer;
Var
  EzxData, EzxDataN, EzxData1: 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 := 1 To FHeader.RecordCount 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;
⌨️ 快捷键说明

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