ezmifimport.pas

很管用的GIS控件

Begin
  gslMIF.Free;
  gslMID.Free;
  gMIFlines.Free;
  gMIDlines.Free;
  gslFields.Free;
  Inherited;
End;

{ TEzMifExport - class implementation }

Const
  //for Export
  ffloatlen: integer = 21;
  fDecsize: integer = 9;

Procedure TEzMIFExport.ExportInitialize;

  Procedure Headerwrite;
  Var
    i: integer;
    S, T: String;
  Begin
    WMIF( 'Version 300' );

    Case CharSet Of
      0: SCharSet := 'WindowsEnglish';
    Else
      SCharSet := 'WindowsEnglish';
    End;

    WMIF( 'Charset "' + SCharSet + '"' );
    WMIF( 'Delimiter ","' );

    //Coordinates section.
    S := 'CoordSys ';
    Case FLayer.LayerInfo.CoordSystem Of
      csCartesian: s := s + 'NonEarth Units "mm" ';
      csLatLon, csProjection:
        Begin
          T := 'Earth Projection 1, 1 ';
          If DrawBox.Gis.ProjectionParams.Count > 0 Then
          Begin
            TS := TStringlist.Create;
            Ts.Assign( DrawBox.Gis.ProjectionParams );
            //Japanese NormalLat/Long
            {if (TS[1]='proj=tmerc')and(ts[2]='ellps=bessel')and(Ts[3]='untis=m')and
               (TS[4]='lon_0=139.83333')and(TS[5]='lat_0=36')and(ts[6]='lat_ts=0.9999')
            then T := 'Earth Projection 1, 97 '; }
          End;
          S := S + T;
        End;
    End;

    S := S + 'Bounds (';
    FLayer.MaxMinExtents( X1, Y1, X2, Y2 );
    S := S + FloatToStrF( X1, fffixed, ffloatlen, fdecsize ) + ', ';
    S := S + FloatToStrF( Y1, fffixed, ffloatlen, fdecsize ) + ') (';
    S := S + FloatToStrF( X2, fffixed, ffloatlen, fdecsize ) + ', ';
    S := S + FloatToStrF( Y2, ffFixed, ffloatlen, fdecsize ) + ')';
    WMIF( S );

    //Field1 Char(10) Field2 Integer Field3 Decimal(10, 2) Field4 Date Field5 Logical
    If FLayer.DBTable <> Nil Then
    Begin
      //Columm writing.
      If FLayer.DBTable.FieldCount > 1 Then
        S := 'Columns ' + IntToStr( FLayer.DBTable.FieldCount - 1 )
      Else
        S := 'Columns ' + IntToStr( FLayer.DBTable.FieldCount );
      WMIF( S );

      If FLayer.DBTable.fieldCount > 1 Then //Exclude UID Field.
      Begin
        For i := 2 To FLayer.DBTable.FieldCount Do
        Begin
          //err s := '  '+FLayer.DBTable.Fields[i].FieldName+ ' ';
          s := '  ' + FLayer.DBTable.Field( i ) + ' ';
          Case FLayer.DBTable.FieldType( i ) Of
            'L': s := s + 'Logical';
            'N':
              Begin
                If FLayer.DBTable.FieldDec( i ) > 0 Then
                  s := s + 'Decimal(' + IntToStr( FLayer.DBTable.FieldLen( i ) ) + ', ' +
                    IntToStr( FLayer.DBTable.FieldDec( i ) ) + ')'
                Else
                  s := s + 'Integer';
              End;
            'C': s := s + 'Char(' + IntToStr( FLayer.DBTable.FieldLen( i ) ) + ')';
            'D': s := s + 'Date';
          End;
          WMIF( S );
        End;
      End
      Else
        WMIF( '  UID Integer' );
    End
    Else
    Begin //2002-2-19 for avoid Mif Export error
      WMIF( 'Columns 1' );
      WMIF( '  UID Integer' );
    End;

    WMIF( 'Data' );
    WMIF( '' );
  End;

Begin
  FLayer:= DrawBox.GIS.Layers.LayerByName( LayerName );
  If FLayer = Nil Then Exit;

  CharSet := 129;

  FMifName := Changefileext( Filename, '.MIF' );
  FMiDName := Changefileext( Filename, '.MID' );
  Assignfile( FMiF, FMifName );
  Assignfile( FMiD, FMidName );

  rewrite( Fmif );
  rewrite( Fmid );
  //Header writeing
  HeaderWrite;

End;

Function TEzMIFExport.WMIF( const S: String ): boolean;
Begin
  result := false;
  Try
    writeln( FMIF, S );
  Except
    result := true;
  End
End;

Function TEzMIFExport.WMID( const S: String ): boolean;
Begin
  result := false;
  Try
    writeln( FMID, S );
  Except
    result := true;
  End
End;

Procedure TEzMIFExport.ExportEnd;
Begin
  Closefile( fmif );
  Closefile( fmid );
End;

Function TEzMIFExport.WriteMid( RecNo: Integer ): Boolean;
Var
  i: integer;
  s, t: String;
  f: Double;
  year, month, day: word;
Begin
  If ( FLayer.DbTable = Nil ) Or ( FLayer.DBTable.FieldCount = 1 ) Then
  Begin
    If FLayer.DBTable <> Nil Then
      Result:=WMID( IntToStr( FLayer.DBTable.IntegerGetN( 1 ) ) )
    Else
      Result:=WMID( IntToStr( RecNO ) );
    Exit; //SKIP UID
  End;
  s := '';
  For i := 2 To FLayer.DBTable.FieldCount Do
  Begin
    Case FLayer.DBTable.FieldType( i ) Of
      'L': If FLayer.DBTable.LogicGetN( i ) Then
          t := 'T'
        Else
          t := 'F';
      'N':
        Begin
          If FLayer.DBTable.FieldDec( i ) > 0 Then
          Begin
            f := FLayer.DBTable.FloatGetN( i );
            t := FloatToStrF( f, fffixed, FLayer.DBTable.FieldLen( i ),
              FLayer.DBTable.FieldDec( i ) );
          End
          Else
            t := IntToStr( FLayer.DBTable.IntegerGetN( i ) );
        End;
      'C': t := '"' + FLayer.DBTable.StringGetN( i ) + '"';
      'D':
        Begin
          If FLayer.DBTable.DateGetN( i ) <> 0 Then
          Begin
            DecodeDate( FLayer.DBTable.DateGetN( i ), Year, Month, Day );
            T := IntToStr( year ) + IntToStr( month ) + IntToStr( day );
          End
          Else
            t := '';
        End;
      'M': t := IntToStr( 0 );
    End;
    If i < FLayer.DBTable.FieldCount Then
      s := s + t + ','
    Else
      s := s + t;
  End;
  Result:=WMID( S );
End;

Procedure TEzMIFExport.ExportEntity( SourceLayer: TEzBaseLayer; Entity: TEzEntity );
Var
  i: integer;
  Err: boolean;

  Function WritePolygonStyle( Ent: TEzEntity ): Boolean;
  Var
    Penwidth, PenPattern, BPattern: integer;
    PenColor, BForeColor, BBackColor: TColor;
    s: String;
    Cx, Cy: Double;
  Begin
    PenWidth := DrawBox.Grapher.RealToDistX( TEzOpenedEntity( Ent ).Pentool.Width );
    If PenWidth = 0 Then
      PenWidth := 1;
    PenPattern := TEzOpenedEntity( Ent ).PenTool.Style + 1;
    PenColor := MIF2DelphiColor( TEzOpenedEntity( Ent ).PenTool.Color );
    BPattern := TEzClosedEntity( Ent ).BrushTool.Pattern + 1;
    BForeColor := MIF2DelphiColor( TEzClosedEntity( Ent ).Brushtool.ForeColor );
    BBackColor := MIF2DelphiColor( TEzClosedEntity( Ent ).Brushtool.BackColor );
    WMIF( '    Pen (' + IntToStr( PenWidth ) + ',' + IntToStr( PenPattern ) + ',' + IntToStr( PenColor ) + ')' );
    Result := WMIF( '    Brush (' + IntToStr( BPattern ) + ',' + IntToStr( BForeColor ) + ',' + IntToStr( BBackColor ) + ')' );
    If Ent.EntityID = idpolygon Then
    Begin
      s := '    Center ';
      Ent.Centroid( CX, CY );
      s := s + FloatToStrF( CX, fffixed, ffloatlen, fdecsize ) + ' ';
      s := s + FloatToStrF( CY, fffixed, ffloatlen, fdecsize );
      Result := WMIF( S );
    End;
  End;

  Function WritePolygon( Ent: TEzEntity ): Boolean;
  Var
    i, j, temp, Parts: integer;
    s: String;
    PartCount, PrvCount: Longint;
  Begin
    Parts := Ent.DrawPoints.Parts.Count;
    //Prevent Wrong Exporting.
    If ( Parts = 0 ) And ( Ent.points.Count = 2 ) Then
      Ent.Points.Add( Ent.points[0] );

    If Parts = 0 Then
      Parts := 1;
    WMIF( 'Region  ' + IntToStr( Parts ) );
    PrvCount := 0;
    For i := 0 To Parts - 1 Do
    Begin
      If Parts = 1 Then
        PartCount := Ent.Points.Count
      Else
      Begin
        If i < ( Parts - 1 ) Then
          PartCount := Ent.Points.Parts[i + 1] - Ent.Points.Parts[i]
        Else
          PartCount := Ent.Points.Count - Ent.Points.Parts[i];
      End;
      WMIF( '  ' + IntToStr( PartCount ) );

      temp:=0;
      For j := PrvCount To PrvCount + PartCount - 1 Do
      Begin
        s := FloatToStrF( Ent.Points.X[j], fffixed, ffloatlen, fdecsize ) + ' ';
        S := S + FloatToStrF( Ent.Points.Y[j], fffixed, ffloatlen, fdecsize );
        Result := WMIF( S );
        temp:=j;
        If Result Then Exit;
      End;
      PrvCount := temp;
    End;
    Result:=WritePolygonStyle( Ent );
  End;

  Function writepolylineStyle( Ent: TEzEntity ): boolean;
  Var
    Penwidth, PenPattern: integer;
    PenColor: TColor;
  Begin
    PenWidth := DrawBox.Grapher.RealToDistX( TEzOpenedEntity( Ent ).Pentool.Width );
    If PenWidth = 0 Then
      PenWidth := 1;
    PenPattern := TEzClosedEntity( Ent ).Pentool.Style + 1;
    PenColor := MIF2DelphiColor( TEzClosedEntity( Ent ).Pentool.Color );
    Result := WMIF( '    Pen (' + IntToStr( PenWidth ) + ',' + IntToStr( PenPattern ) + ',' + IntToStr( PenColor ) + ')' );
    //Spline processing here.
    If Ent.EntityID = idspline Then
      Result := WMIF( '    Smooth' );
  End;

  Function WritePolyline( Ent: TEzEntity ): Boolean;
  Var
    i, j, temp,Parts: integer;
    s: String;
    PartCount, PrvCount: Longint;
  Begin
    Parts := Ent.Points.Parts.Count;
    If Parts = 0 Then
      Parts := 1;
    If Parts > 1 Then
      Result := WMIF( 'Pline Multiple ' + IntToStr( Parts ) )
    Else
      Result := WMIF( 'Pline ' + IntToStr( Ent.Points.Count ) );
    PrvCount := 0;
    For i := 0 To Parts - 1 Do
    Begin
      If Parts = 1 Then
        PartCount := Ent.Points.Count
      Else
      Begin
        If i < ( Parts - 1 ) Then
          PartCount := Ent.Points.Parts[i + 1] - Ent.Points.Parts[i]
        Else
          PartCount := Ent.Points.Count - Ent.Points.Parts[i];
      End;
      If Parts > 1 Then
        Result := WMIF( '  ' + IntToStr( PartCount ) );

      temp:=0;
      For j := PrvCount To PrvCount + PartCount - 1 Do
      Begin
        s := FloatToStrF( Ent.Points.X[j], fffixed, ffloatlen, fdecsize ) + ' ';
        S := S + FloatToStrF( Ent.Points.Y[j], fffixed, ffloatlen, fdecsize );
        Result := WMIF( S );
        temp:=j;
        If Result Then Exit;
      End;
      PrvCount := temp;
    End;
    WritePolylineStyle( ENT );
  End;

  Function WritePoint( Ent: TEzEntity ): Boolean;
  Var
    s: String;
    Style, Size: Integer;
    Color: TColor;
    CX, CY: Double;
  Begin
    s := 'Point ';
    Ent.Centroid( CX, CY );
    s := s + FloatToStrF( CX, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( CY, fffixed, ffloatlen, fdecsize );
    WMIF( S );
    //31 is blank, from 32 mapinfo's symol start.
    Style := 32 + TEzPlace( Ent ).SymbolTool.Index;
    Color := MIF2DelphiColor( clBlack );
    Size := Round( DrawBox.Grapher.DistToPointsY( TEzPlace( Ent ).Symboltool.Height ) );
    Result := WMIF( '    Symbol (' + IntToStr( Style ) + ',' + IntToStr( Color ) + ',' + IntToStr( Size ) + ')' );
  End;

  Function WriteRect( Ent: TEzEntity ): Boolean;
  Var
    s: String;
    X1, Y1, X2, Y2: Double;
  Begin
    s := 'Rect ';
    x1 := Ent.Points.X[0];
    Y1 := Ent.Points.Y[0];
    x2 := Ent.Points.X[1];
    Y2 := Ent.Points.Y[1];
    s := s + FloatToStrF( X1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( X2, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y2, fffixed, ffloatlen, fdecsize );
    WMIF( S );
    Result := WritePolygonStyle( ENT );
  End;

  Function WriteEllipse( Ent: TEzEntity ): Boolean;
  Var
    s: String;
    X1, Y1, X2, Y2: Double;
  Begin
    s := 'Ellipse ';
    x1 := Ent.Points.X[0];
    Y1 := Ent.Points.Y[0];
    x2 := Ent.Points.X[1];
    Y2 := Ent.Points.Y[1];
    s := s + FloatToStrF( X1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( X2, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y2, fffixed, ffloatlen, fdecsize );
    WMIF( S );
    Result := WritePolygonStyle( ENT );
  End;

  Function WriteText( Ent: TEzEntity ): Boolean;
  Var
    s, txt: String;
    X1, Y1, X2, Y2: Double;
    FontStyle, FontSize: Integer;
    FontColor: TColor;
    FontAngle: Double;
    FontName: String;
    FontHeight: Double;
  Begin
    s := 'Text  ';
    Result:= WMIF( S );
    Case Ent.EntityID Of
      idTrueTypeText:
        Begin
          txt := TEzTrueTypeText( Ent ).Text;
          FontAngle := RadToDeg( TEzTrueTypeText( Ent ).Fonttool.Angle );
        End;
      idJustifVectText:
        Begin
          txt := TEzJustifVectorText( Ent ).Text;
          FontAngle := RadToDeg( TEzJustifVectorText( Ent ).Angle );
          FontName := EzSystem.DefaultFontName;
        End;
      idFittedVectText:
        Begin
          txt := TEzFittedVectorText( Ent ).Text;
          FontAngle := RadToDeg( TEzFittedVectorText( Ent ).Angle );
          FontName := EzSystem.DefaultFontName;
        End;
    Else
      exit;
    End;
    //for multiline. Amap used #13#10 for Next line. but Mapinfo used \n.
    Txt := '"' + StringReplace( Txt, #13 + #10, '\n', [rfReplaceAll] ) + '"';
    WMIF( '    ' + Txt );
    x1 := Ent.Points.X[0];
    Y1 := Ent.Points.Y[0];
    x2 := Ent.Points.X[1];
    Y2 := Ent.Points.Y[1];
    s := '    ';
    s := s + FloatToStrF( X1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( X2, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y2, fffixed, ffloatlen, fdecsize );
    WMIF( S );

    //Check Font Style
    FontStyle := 0;
    FontHeight := 0;
    If Ent.EntityID = idTrueTypeText Then
    Begin
      If fsbold In TEzTrueTypeText( Ent ).Fonttool.Style Then
        FontStyle := FontStyle Or 1;
      If fsitalic In TEzTrueTypeText( Ent ).Fonttool.Style Then
        FontStyle := FontStyle Or 2;
      If fsunderline In TEzTrueTypeText( Ent ).Fonttool.Style Then
        FontStyle := FontStyle Or 4;
      FontName := TEzTrueTypeText( Ent ).Fonttool.Name;
      FontHeight := TEzTrueTypeText( Ent ).Fonttool.Height;
    End;
    FontSize := DrawBox.Grapher.RealToDistY( FontHeight );
    FontColor := MIF2DelphiColor( TEzTrueTypeText( ent ).Fonttool.Color );

    S := '    Font ("' + Trim( FontName ) + '",' + IntToStr( FontStyle ) + ',' +
      IntToStr( fontsize ) + ',' + IntToStr( FontColor ) + ')';
    WMIF( S );
    S := '    Angle ' + FloatToStrF( FontAngle, fffixed, ffloatlen, fdecsize );
    Result:=WMIF( S );
  End;

  Function WriteArc( Ent: TEzEntity ): Boolean;
  Var
    s: String;
    X1, Y1, X2, Y2: Double;
    CX, CY, Rad, sangle, eangle, ca: Double;
    pu, pv: TEzPoint;

  Begin
    s := 'Arc ';

    sangle := radtodeg( TEzArc( Ent ).StartAngle );
    eangle := radtodeg( TEzArc( Ent ).EndAngle );
    Rad := TEzArc( Ent ).Radius;
    CX := TEzArc( Ent ).CenterX;
    CY := TEzArc( Ent ).CenterY;

    pu := Point2d( CX - rad, CY - rad );
    pv := Point2d( CX + rad, CY + rad );

    X1 := PU.X;
    Y1 := PU.Y;
    X2 := PV.X;
    Y2 := PV.Y;

    If radtodeg( Angle2D( Ent.Points[0], ent.Points[2] ) ) > 0 Then
    Begin
      ca := sangle;
      sangle := eangle;
      eangle := ca;
    End;

    s := s + FloatToStrF( X1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y1, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( X2, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( Y2, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( sangle, fffixed, ffloatlen, fdecsize ) + ' ';
    s := s + FloatToStrF( eangle, fffixed, ffloatlen, fdecsize ) + ' ';
    WMIF( S );
    Result := WritePolylineStyle( ENT );
  End;

Begin
  Err := false;
  i:= 0;
  Case Entity.EntityID Of
    idpolygon: Err := Writepolygon( Entity );
    idnone:
      Begin
        WMIF( 'none' );
        Err := False;
      End;
    idPolyline, idSpline: Err := WritePolyline( Entity );
    idPlace, idPoint: Err := WritePoint( Entity );
    idRectangle, idPersistBitmap, idBandsBitmap, idPictureRef,
      idTable: Err := WriteRect( Entity );
    idArc: Err := WriteArc( Entity );
    idEllipse: Err := WriteEllipse( Entity );
    idTrueTypeText, idJustifVectText, idFittedVectText: Err := WriteText( Entity );
    idGroup: ;
  End;

  If Not Err Then WriteMid( i );
End;

End.