ezshpimport.pas

很管用的GIS控件

  Dbf := TEzSHPDbfTable.Create( Nil, FromDbf, false, true );
  Try
    FieldList.Add( 'UID;N;12;0' );
    For i := 1 To Dbf.FieldCount Do
    Begin
      if AnsiCompareText(Dbf.Field(i), 'UID') = 0 then Continue;
      FieldList.Add( Format( '%s;%s;%d;%d', [Dbf.Field( i ),
        Dbf.FieldType( i ), Dbf.FieldLen( i ), Dbf.FieldDec( i )] ) );
    End;
  Finally
    Dbf.Free;
  End;
End;

{A new layer is created on import because the DB file can contain
 very different information }

Constructor TEzSHPImport.Create(AOwner: TComponent);
Begin
  Inherited Create(AOwner);
  FTempCAD:= TEzCAD.Create(Nil);
End;

Destructor TEzSHPImport.Destroy;
Begin
  FTempCAD.Free;
  Inherited;
End;

Procedure TEzSHPImport.EraseShpIndexFiles;
Var
  temp: String;
Begin
  temp := ChangeFileExt( Filename, RTCEXT );
  If FileExists( temp ) Then
    SysUtils.DeleteFile( temp );
  temp := ChangeFileExt( Filename, RTXEXT );
  If FileExists( temp ) Then
    SysUtils.DeleteFile( temp );
End;

procedure TEzSHPImport.ImportInitialize;
Var
  ShpLayer: TEzBaseLayer;
Begin
  EraseShpIndexFiles;
  { create a temporary TEzCAD used for opening a .SHP file }
  ShpLayer := TSHPLayer.Create( FTempCAD.Layers, ChangeFileExt( Filename, '' ) );
  FTempCAD.ReadOnly:= True;
  ShpLayer.Open;
  With ShpLayer.LayerInfo.Extension Do
  Begin
    If Abs(Emax.x - Emin.x) <= 360 Then
    Begin
      { presumably source file is defined in degrees }
      Converter.SourceCoordSystem := csLatLon;
      If DrawBox.GIS.Layers.Count = 0 Then
        Converter.DestinCoordSystem := Converter.SourceCoordSystem;
    End;
  End;
  { initialize for progress messages }
  nEntities:= ShpLayer.RecordCount;   // this function must return the number of records to import
  MyEntNo := 0;
End;

Procedure TEzSHPImport.GetSourceFieldList( FieldList: TStrings );
Begin
  SHPPopulateFieldList( ChangeFileExt( Filename, '' ), FieldList As TStringList );
End;

Procedure TEzSHPImport.ImportFirst;
Begin
  FTempCAD.Layers[0].First;
End;

Function TEzSHPImport.ImportEof: Boolean;
Begin
  Result:= FTempCAD.Layers[0].Eof;
End;

Function TEzSHPImport.GetNextEntity(var progress,entno: Integer): TEzEntity;
Begin
  Inc(MyEntNo);
  progress:= Round((MyEntNo / nEntities) * 100);
  entno:=MyEntNo;
  Result:= FTempCAD.Layers[0].RecLoadEntity;
End;

Procedure TEzSHPImport.AddSourceFieldData(DestLayer: TEzBaseLayer; DestRecno: Integer);
Var
  SourceLayer: TEzBaseLayer;
  J: Integer;
Begin
  SourceLayer:= FTempCAD.Layers[0];
  If (DestLayer.DBTable = Nil) Or (SourceLayer.DBTable = Nil) Then Exit;
  DestLayer.DBTable.Recno:= DestRecno;
  DestLayer.DBTable.BeginTrans;
  Try
    DestLayer.DBTable.Edit;
    SourceLayer.DBTable.Recno:= SourceLayer.Recno;
    For J := 1 To SourceLayer.DBTable.FieldCount Do
    Begin
      Try
        With DestLayer.DBTable Do
          AssignFrom( SourceLayer.DBTable, J, FieldNo( SourceLayer.DBTable.Field( J ) ) );
      Except
        // ignore error in fields in DBF file (wrong data)
      End;
    End;
    DestLayer.DBTable.Post;
    DestLayer.DBTable.EndTrans;
  Except
    DestLayer.DBTable.RollbackTrans;
    raise;
  End;
End;

Procedure TEzSHPImport.ImportNext;
Begin
  FTempCAD.Layers[0].Next;
End;

Function TEzSHPImport.GetSourceExtension: TEzRect;
Begin
  Result:= FTempCAD.Layers[0].LayerInfo.Extension
End;

Procedure TEzSHPImport.ImportEnd;
Begin
  EraseShpIndexFiles;
End;

Function ShpCreateDbfTable( Const fname, apassword: String;
  AFieldList: TStringList ): boolean;
Var
{$IFDEF USENATIVEDLL}
  ErrorMode: Integer;
  DLLHandle: THandle;
  ezCreateDBF: Function( fname, apassword: PChar; ftype: integer; Fields: PChar ): boolean; stdcall;

  Function CreateDllList( FieldList: TStringList ): String;
  Var
    i: integer;
  Begin
    Result := '';
    For i := 0 To FieldList.Count - 1 Do
      Result := Result + FieldList[i] + '\';
  End;

{$ELSE}
  s: String;
  v: boolean;
  i: integer;
  p: integer;
  fs: String;
  ft: String[1];
  fl: integer;
  fd: integer;

  Procedure LoadField;
  Begin
    v := true;
    p := Ansipos( ';', s );
    fs := '';
    If p > 0 Then
    Begin
      fs := System.Copy( s, 1, pred( p ) );
      System.Delete( s, 1, p );
    End
    Else
      v := false;

    p := Ansipos( ';', s );
    ft := ' ';
    If p = 2 Then
    Begin
      ft := System.Copy( s, 1, 1 );
      System.Delete( s, 1, p );
    End
    Else
      v := false;

    p := Ansipos( ';', s );
    fl := 0;
    If p > 0 Then
    Begin
      Try
        fl := StrToInt( System.Copy( s, 1, pred( p ) ) );
        System.Delete( s, 1, p );
      Except
        On Exception Do
          v := false;
      End;
    End
    Else
      v := false;

    fd := 0;
    Try
      fd := StrToInt( System.Copy( s, 1, 3 ) );
    Except
      On Exception Do
        v := false;
    End;
  End;

{$ENDIF}

Begin
{$IFDEF USENATIVEDLL}
  Result:= False;
  ErrorMode := SetErrorMode( SEM_NOOPENFILEERRORBOX );
  DLLHandle := LoadLibrary( 'ezde10.dll' );
  If DLLHandle >= 32 Then
  Begin
    @ezCreateDBF := GetProcAddress( DLLHandle, 'CreateDBF' );
    Assert( @ezCreateDBF <> Nil );
    result := ezCreateDBF( pchar( ChangeFileExt(fname,'.dbf') ), pchar( apassword ),
                           ord( dtDBaseIII ), PChar( CreateDLLList( AFieldList ) ) );
    SetErrorMode( ErrorMode );
    FreeLibrary( DLLHandle );
  end;
{$ELSE}
  { create a DBF table }
  Result:=false;
  With TDbf.Create( Nil ) Do
  Try
    TableName := ChangeFileExt(fname,'.dbf');
    With FieldDefs Do
    Begin
      Clear;
      For I := 0 To AFieldList.count - 1 Do
      Begin
        s:= AFieldList[I];
        LoadField;
        If Not v Then EzGisError( SErrWrongField );

        Case ft[1] Of
          'C':
            Add( fs, ftString, fl, False );
          'F', 'N':
            If fd = 0 Then
              Add( fs, ftInteger, 0, False )
            Else
              Add( fs, ftFloat, 0, False );
          'M', 'G', 'B':
            Add( fs, ftMemo, 0, False );
          'L':
            Add( fs, ftBoolean, 0, False );
          'D':
            Add( fs, ftDate, 0, False );
          'T':
            Add( fs, ftTime, 0, False );
          'I':
            Add( fs, ftInteger, 0, False );
        End;
      End;
    End;
    CreateTable;
    Result:=true;
  Finally
    Free;
  End;
{$ENDIF}
End;


{ TEzSHPExport }

Constructor TEzSHPExport.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FExportAs := ftPolygon;
  FTempCAD:= TEzCAD.Create(Nil);
End;

destructor TEzSHPExport.Destroy;
begin
  FTempCAD.Free;
  inherited;
end;

Procedure TEzSHPExport.EraseShpIndexFiles;
Var
  temp: String;
Begin
  temp := ChangeFileExt( FileName, RTCEXT );
  If FileExists( temp ) Then
    SysUtils.DeleteFile( temp );
  temp := ChangeFileExt( FileName, RTXEXT );
  If FileExists( temp ) Then
    SysUtils.DeleteFile( temp );
End;

Procedure TEzSHPExport.CreateShapeFile;
Var
  Basename: String;
  shp, shx: TFileStream;
  ShapeHeader: TShapeHeader;
  FieldList: TStringList;
  Layer: TEzBaseLayer;
  I: Integer;
Begin
  BaseName := ChangeFileExt( FileName, '' );
  shp := TFileStream.Create( BaseName + '.SHP', fmCreate );
  FillChar( ShapeHeader, sizeof( TShapeHeader ), 0 );
  ShapeHeader.FileCode := ReverseInteger( 9994 );
  ShapeHeader.FileLength := ReverseInteger( sizeOf( TShapeHeader ) ) Div 2;
  ShapeHeader.Version := 1000;
  Case FExportAs Of
    ftPoint: ShapeHeader.ShapeType := 1;
    ftArc: ShapeHeader.ShapeType := 3;
    ftPolygon: ShapeHeader.ShapeType := 5;
    ftMultiPoint: ShapeHeader.ShapeType := 8;
  End;
  ShapeHeader.Extent := INVALID_EXTENSION;
  shp.Write( ShapeHeader, sizeOf( TShapeHeader ) );
  shp.Free;

  shx := TFileStream.Create( BaseName + '.SHX', fmCreate );
  shx.Write( ShapeHeader, sizeOf( TShapeHeader ) );
  shx.Free;

  { Now create the ArcView DBF file }
  Layer := DrawBox.GIS.Layers.LayerByName( Layername );
  FieldList := TStringList.Create;
  Try
    If Layer.DBTable <> Nil Then
    Begin
      With Layer.DBTable Do
      Begin
        For I := 1 To FieldCount Do
        Begin
          // I don磘 know if ArcView supports dBASE III/IV/V or what
          If FieldType( I ) In ['M', 'G', 'B'] Then Continue;

          FieldList.Add( Format( '%s;%s;%d;%d', [Field( I ), FieldType( I ), FieldLen( I ), FieldDec( I )] ) );
        End;
      End;
    End
    Else
      FieldList.Add( 'ID;N;8;0' );
    ShpCreateDbfTable( BaseName, '', FieldList );
  Finally
    FieldList.Free;
  End;
End;

Procedure TEzSHPExport.ExportInitialize;
Var
  ShpLayer: TEzBaseLayer;
Begin
  { create the shape file }
  CreateShapeFile;
  ShpLayer := TSHPLayer.Create( FTempCAD.Layers, ChangeFileExt( FileName, '' ) );
  ShpLayer.Open;
End;

Procedure TEzSHPExport.ExportEntity( SourceLayer: TEzBaseLayer; Entity: TEzEntity );
var
  ShpLayer: TEzBaseLayer;
  J, TheRecno: Integer;
  FSource, FDest: Integer;
Begin
  If ( Entity.Points.Parts.Count = 0 ) And ( Entity.Points.Count = 2 ) Then
    Entity.Points.Add( Entity.Points[0] );

  // the vector direction must be clockwise !!!!
  If IsCounterClockWise( Entity.Points ) Then
    Entity.Points.RevertDirection;

  ShpLayer:= FTempCAD.Layers[0];

  TheRecno:= ShpLayer.AddEntity( Entity );
  If (SourceLayer.DBTable <> Nil) And (ShpLayer.DBTable <> Nil) Then
  Begin
    ShpLayer.DBTable.Recno:= TheRecno;
    ShpLayer.DBTable.Edit;
    // write the new DBF shapefile record
    SourceLayer.DBTable.Recno := SourceLayer.Recno;
    For j := 1 To SourceLayer.DBTable.FieldCount Do
    Begin
      FSource := J;
      FDest := ShpLayer.DBTable.FieldNo( SourceLayer.DBTable.Field( J ) );
      If FDest <> 0 Then
      Begin
        Try
          ShpLayer.DBTable.AssignFrom( SourceLayer.DBTable, FSource, FDest );
        Except
          // probably caused by corrupted data
        End;
      End;
    End;
    ShpLayer.DBTable.Post;
  End
  Else If ShpLayer.DBTable <> Nil Then
  Begin
    // write an empty record
    ShpLayer.DBTable.IntegerPutN( 1, Entity.ID );
    ShpLayer.DBTable.Post;
  End;
End;

Procedure TEzSHPExport.ExportEnd;
Begin
  EraseShpIndexFiles;
End;

{$IFDEF BCB}
function TEzSHPExport.GetExportAs: TEzShapeFileType;
begin
  Result := FExportAs;
end;

procedure TEzSHPExport.SetExportAs(const Value: TEzShapeFileType);
begin
  FExportAs := Value;
end;
{$ENDIF}

End.