ezmifimport.pas

很管用的GIS控件

  Begin
    sTmp := trim( gMIFLines[i] );
    If STmp <> '' Then
    Begin
      splitspace( Stmp, Stmp1, Stmp2 );
      STmp1 := UpperCase( STmp1 );
      If ( AnsiCompareText( sTmp1, 'NONE' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Point' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Region' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Line' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'PLine' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Text' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Arc' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Ellipse' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Rect' ) = 0 ) Or
        ( AnsiCompareText( sTmp1, 'Roundrect' ) = 0 ) Then
        inc( result );
    End;
  End;
End;

{------------------------------------------------------------------------------
  ReadMIFHeader
------------------------------------------------------------------------------}

Procedure TEzMifImport.MIFOpen;
Const
  k: integer = 1;
Var
  fldname, szFullName, szBaseName: String;
  code,FieldCount, i, j, N: integer;
  Field, s1, s2, sTmp, prvfield: String;
  DBType: Char;
  dbflist: tstrings;
  test: TStrings;

  Function EraseChar( Const instr: String ): String;
  Var
    i: integer;
  Begin
    result := '';
    If trim( instr ) = '' Then
      exit;
    For i := 1 To length( instr ) Do
      If AnsiPos( instr[i], '",()' ) = 0 Then
        result := result + instr[i];
  End;

  Function EraseChar2( Const instr: String ): String;
  Var
    i: integer;
  Begin
    result := '';
    If trim( instr ) = '' Then
      exit;
    For i := 1 To length( instr ) Do
      If AnsiPos( instr[i], '",()' ) = 0 Then
        result := result + instr[i]
      Else
        Result := Result + ' ';
  End;

  Function splitComma( Const ss: String; Var s1, s2: String ): boolean;
  Var
    i: integer;
  Begin
    If Ansipos( ' ', ss ) = 0 Then
    Begin
      s1 := ss;
      s2 := ss;
      result := false;
      exit;
    End;

    i := Ansipos( ' ', ss );
    s1 := copy( ss, 1, i - 1 );
    s2 := copy( ss, i + 1, length( ss ) - i );
    result := true;
  End;

Begin
  (* initialize the info structure *)
  szBaseName := ChangeFileExt( Filename, '' );

  szFullName := Format( '%s.mif', [szBaseName] );
  If Not FileExists( szFullName ) Then
  Begin
    MessageToUser( Format( SShpFileNotFound, [szFullName] ), smsgerror, MB_ICONERROR );
    Exit;
  End;

  //initialize; <-- added for initialize pen and brush objects. begin
  With Ez_Preferences Do
  Begin
    defPen := DefPenStyle.FPenStyle;
    defbrush := DefBrushStyle.FBrushStyle;
    deffont := DefFontStyle.FFontStyle;
    defsymbol := DefSymbolStyle.FSymbolStyle;
  End;

  MIFInfo.nRecords := MifDataCount;
  MIFInfo.adBoundsMin[0] := 0;
  MIFInfo.adBoundsMin[1] := 0;
  MIFInfo.adBoundsMax[0] := 0;
  MIFInfo.adBoundsMax[1] := 0;
  MIFInfo.nMaxRecords := MIFInfo.nRecords;
  If MIFInfo.nMaxRecords = 0 Then
    MIFInfo.nMaxRecords := 1;

  While FetchMIFdata( True ) Do
  Begin
    sTmp := gslMIF[0];

    If AnsiCompareText( sTmp, 'Version' ) = 0 Then
      val(gslMIF[1],giMIFVersion,code);

    If AnsiCompareText( sTmp, 'Delimiter' ) = 0 Then
      gsMIDSepChar := gslMIF[1][2];

    If AnsiCompareText( sTmp, 'Data' ) = 0 Then
      Break; // Data Section

    If AnsiCompareText( sTmp, 'CoordSys' ) = 0 Then
    Begin
      If AnsiCompareText( gslMIF[1], 'Earth' ) = 0 Then
      Begin
        If gslmif.Count > 1 Then
          Mifinfo.ProjectionType := EraseChar( gslMIF[1] );
        If gslmif.Count > 5 Then
          Mifinfo.ProjectionUnit := EraseChar( gslMIF[5] );
        If gslmif.Count > 3 Then
          Mifinfo.ProjectionParam[0] := EraseChar( gslMIF[3] );
        If gslmif.Count > 4 Then
          Mifinfo.ProjectionParam[1] := EraseChar( gslMIF[4] );
        If gslmif.Count > 6 Then
          Mifinfo.ProjectionParam[2] := EraseChar( gslMIF[6] );
      End
      Else If AnsiCompareText( gslMIF[1], 'NonEarth' ) = 0 Then
      Begin
        Mifinfo.ProjectionType := EraseChar( gslMIF[1] );
        Mifinfo.ProjectionUnit := EraseChar( gslMIF[3] );
        Mifinfo.ProjectionParam[0] := '';
        Mifinfo.ProjectionParam[1] := '';
        Mifinfo.ProjectionParam[2] := '';
      End;
      //Bounds Check
      Havebound := false;
      For i := 0 To gslMIF.Count - 1 Do
        If AnsiCompareText( gslMIF[i], 'Bounds' ) = 0 Then
          HaveBound := true;

      If Havebound = false Then
      Begin
        If FetchMIFdata( True ) = false Then
          exit;
        sTmp := gslMIF[0];
      End;

      If HaveBound Then
      Begin
        For i := 0 To gslMIF.Count - 1 Do
          If AnsiCompareText( gslMIF[i], 'Bounds' ) = 0 Then
          Begin
            val(EraseChar( gslMIF[i + 1] ),MIFInfo.adBoundsMin[0],code);
            val(EraseChar( gslMIF[i + 2] ),MIFInfo.adBoundsMin[1],code);
            val(EraseChar( gslMIF[i + 3] ),MIFInfo.adBoundsMax[0],code);
            val(EraseChar( gslMIF[i + 4] ),MIFInfo.adBoundsMax[1],code);
            break;
          End;
      End
      Else If ( AnsiCompareText( gslMIF[0], 'Bounds' ) = 0 ) And ( gslmif.count = 3 ) Then
      Begin
        Splitcomma( EraseChar( gslMIF[1] ), s1, s2 );
        val(s1,MIFInfo.adBoundsMin[0],code);
        val(s2,MIFInfo.adBoundsMin[1],code);
        Splitcomma( EraseChar( gslMIF[2] ), s1, s2 );
        val(s1,MIFInfo.adBoundsMax[0],code);
        val(s2,MIFInfo.adBoundsMax[1],code);
      End;
    End;
    If AnsiCompareText( sTmp, 'Columns' ) = 0 Then
      Break;
  End;

  //Mapinfo Database Structure...

  If AnsiCompareText( sTmp, 'Columns' ) = 0 Then
  Begin
    val(gslMIF[1],fieldcount,code);

    If fieldCOunt > 0 Then
    Begin
      test:= TStringList.Create;
      try
        For i := 0 To fieldcount - 1 Do
        Begin
          FetchMIFdata( True );

          //fix for mapinfo.dll.   <--- added begin
          If gslMIF[0] = prvfield Then
          Begin
            FetchMIFdata( True );
            prvfield := gslMIF[0];
          End
          Else
            prvfield := gslMIF[0]; //<-- added end

          DBType := #0;
          If gslmif.Count > 2 Then
            s1 := EraseChar2( gslMIF[1] + gslMIF[2] )
          Else
            s1 := EraseChar2( gslMIF[1] );
          dbflist := TStringlist.Create;
          StrSplitToList( s1, ' ', dbflist, True );

          If AnsiCompareText( dbflist[0], 'Char' ) = 0 Then
            DbType := 'C'
          Else If AnsiCompareText( dbflist[0], 'Integer' ) = 0 Then
            Dbtype := 'N'
          Else If AnsiCompareText( dbflist[0], 'Smallint' ) = 0 Then
            DbType := 'N'
          Else If AnsiCompareText( dbflist[0], 'Float' ) = 0 Then
            DbType := 'N'
          Else If AnsiCompareText( dbflist[0], 'Decimal' ) = 0 Then
            DbType := 'N'
          Else If AnsiCompareText( dbflist[0], 'Date' ) = 0 Then
            DbType := 'C'
          //if AnsiCompareText(dbflist[0], 'Date') = 0 then DbType := 'D';
          Else If AnsiCompareText( dbflist[0], 'Logical' ) = 0 Then
            DbType := 'L';

          fldname:= Copy(gslMIF[0],1,10);
          N:= 0;
          while test.IndexOf(fldname) >= 0 do
          begin
            if length(fldname)>=10 then
              fldname:=copy(fldname,1,9);
            fldname := fldname + '_';
            Inc(N);
            if N > 10 then break;
          end;
          fldname:= Copy(fldname,1,10);
          test.add(fldname);

          Field := fldname + ';' + Dbtype;

          {if length(gslmif[0]) < 10 then
            Field := gslMIF[0] + ';' + Dbtype
          else
            Field := copy(gslMIF[0], 1, 10) + ';' + Dbtype;}

          s1 := '';
          Case dbflist.count Of
            1: s1 := ';12;2';
            2: s1 := s1 + ';' + dbflist[1] + ';0';
          Else
            For j := 1 To dbflist.count - 1 Do
              s1 := s1 + ';' + dbflist[j];
          End;
          gslFields.Add( Field + s1 );
          dbflist.Free;
        End;
      finally
        test.free;
      end;
      If pos( 'UID', gslFields[0] ) = 0 Then
        gslFields.Insert( 0, 'UID;N;12;0' );
    End
    Else
    Begin
      gslFields.Add( 'UID;N;12;0' );
    End;

    FetchMIFdata( True );

  End;
End;

//Erase Layer

Procedure TEzMifImport.ImportInitialize;
var
  Saved: TCursor;
  emin, emax: TEzPoint;
  filenam: string;
  LibHandle: THandle;
  _tab2mif: Ttab2mif;
Begin
  filenam := Self.FileName;
  // check if it is a TAB file and convert to .MIF if it is
  If AnsiCompareText( ExtractFileExt( filenam ), '.TAB' ) = 0 Then
  Begin
    LibHandle := LoadLibrary( PChar( 'mapinfo.dll' ) );
    If LibHandle < 32 Then
      EzGISError( SDLLLoadError );
    Saved := Screen.Cursor;
    If DrawBox.GIS.ShowWaitCursor Then
      Screen.Cursor := crHourGlass;
    Try
      @_tab2mif := GetProcAddress( LibHandle, PChar( 1 ) );
      _tab2mif( PChar( filenam ), Pchar( changefileext( filenam, '.MIF' ) ) );
    Finally
      FreeLibrary( LibHandle );
      If DrawBox.GIS.ShowWaitCursor Then
        Screen.Cursor := Saved;
    End;

    filenam := changefileext( filenam, '.MIF' );
  End;
  cDecSep := DecimalSeparator;
  DecimalSeparator := '.';

  { Load MIF/MID TEXT file To Strings }
  gMIFlines.Clear;
  gMIFlines.LoadFromFile( FileNam );
  gMIDlines.Clear;
  If FileExists( ChangeFileExt( Filenam, '.mid' ) ) Then
    gMIDlines.LoadFromFile( ChangeFileExt( Filenam, '.mid' ) );
  giMIFLinePos := -1;
  giMIDLinePos := -1;

  MIFOpen;

  If HaveBound Then
  Begin
    emin.x := MifInfo.adBoundsMin[0];
    emin.y := MifInfo.adBoundsMin[1];
    emax.x := MifInfo.adBoundsMax[0];
    emax.y := MifInfo.adBoundsMax[1];
    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 := csLatLon;
    End;
  End;
  nEntities:= MIFInfo.nRecords;
  MyEntNo:= 0;
End;

Procedure TEzMifImport.GetSourceFieldList( FieldList: TStrings );
Begin
  FieldList.Assign(gslFields);
End;

Procedure TEzMifImport.ImportFirst;
Begin
  { CREATE THE NEW ENTITY }
  fOK:= FetchMIFdata( True );
End;

Function TEzMifImport.ImportEof: Boolean;
Begin
  Result:= (Not fOK) Or (EntitiesCount >= nEntities);
End;

Function TEzMifImport.GetNextEntity(var progress,entno: Integer): TEzEntity;

  Function CheckMifType( Const EntType: String ): boolean;
  Const
    MIFType: Array[0..10] Of String =
    ( 'NONE', 'POINT', 'REGION', 'LINE', 'PLINE', 'TEXT', 'ARC', 'ELLIPSE',
      'ELLIPSE', 'RECT', 'ROUNDRECT' );
  Var
    i: integer;
  Begin
    result := false;
    For i := 0 To high( miftype ) - 1 Do
      If uppercase( EntType ) = MIFType[i] Then
      Begin
        result := true;
        Exit;
      End;
  End;

Var
  sTmp: string;
Begin

  Inc(MyEntNo);
  progress:= Round((MyEntNo / nEntities) * 100);
  entno:= MyEntNo;

  Result:= Nil;
  sTmp := uppercase( gslMIF[0] );
  Inc( giMIDLinePos );
  If giMIDLinePos < gMIDLines.Count Then
    StrSplitToList2( Trim( gMIDLines[giMIDLinePos] ), gsMidSepChar, gslMID, True );

  EntityNo := 1;
  If AnsiCompareText( sTmp, 'NONE' ) = 0 Then
  Begin
    Result:= TEzNone.CreateEntity;
    fOK:= FetchMIFdata( True );
    If Not fOK Then Exit;
    //Inc(giMIDLinePos)
  End
  Else If AnsiCompareText( sTmp, 'Point' ) = 0 Then
  Begin
    // EntityID := idPlace ;
    Result := ReadPointObject( );
  End
  Else If AnsiCompareText( sTmp, 'Region' ) = 0 Then
  Begin
    // EntityID := idPolygon;
    Result := ReadRegionObject( );
  End
  Else If AnsiCompareText( sTmp, 'Line' ) = 0 Then
  Begin
    Result := ReadLineObject( );
  End
  Else If AnsiCompareText( sTmp, 'PLine' ) = 0 Then
  Begin
    // EntityID := idPolyline;
    Result := ReadPlineObject( );
  End
  Else If AnsiCompareText( sTmp, 'Text' ) = 0 Then
  Begin
    // EntityID := idText;
    Result := ReadTextObject( );
  End
  Else If ( AnsiCompareText( sTmp, 'Arc' ) = 0 ) Then
  Begin
    // EntityID := idarc;
    Result := ReadArcObject( );
  End
  Else If ( AnsiCompareText( sTmp, 'Ellipse' ) = 0 ) Then
  Begin
    //EntityID := idellipse ;
    Result := ReadellipseObject( );
  End
  Else If ( AnsiCompareText( sTmp, 'Rect' ) = 0 ) Then
  Begin
    // EntityID := idframe ;
    Result := ReadRectangleObject( );
  End
  Else If ( AnsiCompareText( sTmp, 'Roundrect' ) = 0 ) Then
  Begin
    // EntityID := idFrame;
    Result := ReadRectangleObject( );
  End
  Else
  Begin
    fOK:= FetchMIFdata( True );
    if Not fOK then Exit;
  End;
  ValidMifType:= CheckMifType( sTmp );
  Inc( EntitiesCount );
End;

Procedure TEzMifImport.AddSourceFieldData(DestLayer: TEzBaseLayer; DestRecno: Integer);
var
  j: integer;
  ps: integer;
  fs: string;
Begin
  If ValidMifType And (DestLayer.DBTable <> Nil) Then
  Begin
    If DestLayer.DBTable.FieldCount > gslmid.Count Then
    Begin
      DestLayer.DBTable.Recno:= DestRecno;
      DestLayer.DBTable.BeginTrans;
      try
        DestLayer.DBTable.Edit;
        For j := 0 To gslmid.Count - 1 Do
        Begin
          Try
            ps:= AnsiPos(';', gslFields[j+1]);
            fs:= Copy( gslFields[j+1], 1, ps - 1 );
            DestLayer.DBTable.FieldPut( fs, gslmid[j] );
          Except
            // ignore error in fields in DB file (wrong data)
          End;
        End;
        DestLayer.DBTable.Post;
        DestLayer.DBTable.EndTrans;
      except
        DestLayer.DBTable.RollbackTrans;
        raise;
      end;
    End;
  End;
End;

Procedure TEzMifImport.ImportNext;
Begin
  // nothing to do here
End;

Function TEzMifImport.GetSourceExtension: TEzRect;
Begin
  If HaveBound Then
  Begin
    Result.emin.x := MifInfo.adBoundsMin[0];
    Result.emin.y := MifInfo.adBoundsMin[1];
    Result.emax.x := MifInfo.adBoundsMax[0];
    Result.emax.y := MifInfo.adBoundsMax[1];
  End
  Else
  Begin
    Result.emin.x := minx;
    Result.emin.y := miny;
    Result.emax.x := maxx;
    Result.emax.y := maxy;
  End;
End;

Procedure TEzMifImport.ImportEnd;
Begin
  DecimalSeparator := cDecSep;
End;

Constructor TEzMifImport.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  { data needed when importing }
  gslMIF := TStringList.Create;
  gslMID := TStringList.Create;
  gMIFlines := TStringList.Create;
  gMIDlines := TStringList.Create;
  gslFields := TStringList.Create;

  gsMIDSepChar := #9;
  HaveBound := false;
  MinX := 9999999999.0;
  Miny := 9999999999.0;
  MaxX := -9999999999.0;
  Maxy := -9999999999.0;

End;

Destructor TEzMifImport.Destroy;