ezmifimport.pas

很管用的GIS控件

Unit EzMIFImport;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}
Interface

Uses
  Windows, Forms, Controls, SysUtils, Classes, Graphics,
  ezLib, ezbasegis, ezshpimport, ezbase, EzImportBase;

Type

  TEzMIFInfo = Record
    nRecords: integer;
    nMaxRecords: integer;
    ProjectionType: String;
    ProjectionUnit: String;
    ProjectionParam: Array[0..3] Of String;
    adBoundsMin: Array[0..1] Of double;
    adBoundsMax: Array[0..1] Of double;
  End;

  TEzMifImport = Class(TEzBaseImport)
  Private
    { data needed when importing }
    MIFInfo: TEzMIFInfo;
    gsMIDSepChar: String;
    giMIFVersion: integer;

    gslFields, gslMIF, gslMID: TStrings;
    gMIFlines, gMIDlines: TStringList;
    giMIFLinePos, giMIDLinePos: integer;

    {default style set}
    defPen: TEzPenStyle;
    defbrush: TEzBrushStyle;
    deffont: TEzFontStyle;
    defsymbol: TEzSymbolStyle;

    HaveBound: boolean;
    MinX: double;
    Miny: double;
    MaxX: double;
    Maxy: double;
    EntityNo: integer;
    EntitiesCount: integer;

    cDecSep: Char;
    fOK: Boolean;
    ValidMifType: Boolean;
    nEntities: Integer;

    { for progress messages }
    MyEntNo: Integer;

    Procedure CompareBoundary( x, y: double );
    Function FetchMIFdata( bSplit: Boolean ): Boolean;
    Function ReadSymbolObject: Boolean;
    Function ReadPenObject: Boolean;
    Function ReadBrushObject: Boolean;
    Function ReadFontObject: Boolean;
    Function ReadPointObject: TEzEntity;
    Function ReadRegionObject: TEzEntity;
    Function ReadPLineObject: TEzEntity;
    Function ReadLineObject: TEzEntity;
    Function ReadTextObject: TEzEntity;
    Function ReadArcObject: TEzEntity;
    Function ReadEllipseObject: TEzEntity;
    Function ReadRectangleObject: TEzEntity;
    Function MIFDataCount: Longint;
    Procedure MIFOpen;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Procedure ImportInitialize; Override;
    Procedure GetSourceFieldList( FieldList: TStrings ); Override;
    Procedure ImportFirst; Override;
    Procedure AddSourceFieldData(DestLayer: TEzBaseLayer; DestRecno: Integer); Override;
    Function GetSourceExtension: TEzRect; Override;
    Function ImportEof: Boolean; Override;
    Function GetNextEntity(var progress,entno: Integer): TEzEntity; Override;
    Procedure ImportNext; Override;
    Procedure ImportEnd; Override;
  End;

  { TEzMIFExport}
  TEzMIFExport = Class( TEzBaseExport )
  Private
    CharSet: TFontCharSet;
    FMif, FMid: Text;
    SCharset, FMifName, FMidName: String;
    TS: TStringList;
    X1, Y1, X2, Y2: Double;
    FLayer: TEzBaseLayer;
    Function WriteMid( RecNo: Integer ): Boolean;
    Function WMIF( const S: String ): boolean;
    Function WMID( const S: String ): boolean;
  Public
    Procedure ExportInitialize; Override;
    Procedure ExportEntity( SourceLayer: TEzBaseLayer; Entity: TEzEntity ); Override;
    Procedure ExportEnd; Override;
  End;

Implementation

Uses
  ezimpl, ezConsts, ezSystem, ezbasicctrls, ezentities, Math ;

{$R-}
Type

  // for mapinfo.dll
  Ttab2mif = Function( Const fn1, fn2: pchar ): integer; stdcall;

  {------------------------------------------------------------------------------
   StrSplitToList
  ------------------------------------------------------------------------------}

Function StrSplitToList( Const sToSplit, sSeparator: String; tsStrList: TStrings;
  bAllowEmpty: Boolean ): Integer;
Var
  iCurPos, iNoStrings: Integer;
  sTmpRet, sTmpStr: String;
Begin
  sTmpRet := Copy( sToSplit, 1, Length( sToSplit ) );
  iCurPos := AnsiPos( sSeparator, sToSplit );
  tsStrList.Clear;
  iNoStrings := 0;
  If iCurPos > 0 Then
  Begin
    While iCurPos > 0 Do
    Begin
      sTmpStr := Copy( sTmpRet, 0, iCurPos - 1 );
      If ( Length( sTmpStr ) > 0 ) Or bAllowEmpty Then { let user choose to get empty strings}
      Begin
        tsStrList.Add( sTmpStr );
        Inc( iNoStrings, 1 );
      End;
      sTmpRet := Copy( sTmpRet, iCurPos + Length( sSeparator ), Length( sTmpRet ) );
      iCurPos := AnsiPos( sSeparator, sTmpRet );
    End;
    If Length( sTmpRet ) > 0 Then
    Begin
      tsStrList.Add( sTmpRet );
      Inc( iNoStrings, 1 );
    End;
  End
  Else
  Begin
    If ( Length( sTmpRet ) > 0 ) Or bAllowEmpty Then
    Begin
      tsStrList.Add( sTmpRet );
      Inc( iNoStrings, 1 );
    End;
  End;
  Result := iNoStrings;
End;

{------------------------------------------------------------------------------
 StrSplitToList2 MID DataConversion
------------------------------------------------------------------------------}

Function StrSplitToList2( Const sToSplit, sSeparator: String; tsStrList: TStrings;
  bAllowEmpty: Boolean ): Integer;
Var
  iCurPos, iNoStrings: Integer;
  sTmpRet, sTmpStr: String;

  Function CheckString( s1: String ): String;
  Var
    i: integer;
    qc: boolean;
  Begin
    qc := false;
    For i := 1 To length( s1 ) Do
    Begin
      If s1[i] = '"' Then
      Begin
        qc := Not qc;
        continue;
      End;
      If ( qc = true ) And ( s1[i] = ',' ) Then
      Begin
        s1[i] := #1;
        continue;
      End;
    End;
    Result := s1;
  End;

  Function RestoreString( s1: String ): String;
  Var
    i: integer;
  Begin
    For i := 1 To length( s1 ) Do
    Begin
      If s1[i] = #1 Then
      Begin
        s1[i] := ',';
      End;
    End;
    result := s1;
  End;

  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;

Begin
  sTmpRet := CheckString( Copy( sToSplit, 1, Length( sToSplit ) ) );
  iCurPos := AnsiPos( sSeparator, StmpRet );
  tsStrList.Clear;
  iNoStrings := 0;
  If iCurPos > 0 Then
  Begin
    While iCurPos > 0 Do
    Begin
      sTmpStr := Copy( sTmpRet, 0, iCurPos - 1 );
      If ( Length( sTmpStr ) > 0 ) Or bAllowEmpty Then { let user choose to get empty strings}
      Begin
        tsStrList.Add( EraseChar( RestoreString( sTmpStr ) ) );
        Inc( iNoStrings, 1 );
      End;
      sTmpRet := Copy( sTmpRet, iCurPos + Length( sSeparator ), Length( sTmpRet ) );
      iCurPos := AnsiPos( sSeparator, sTmpRet );
    End;
    If Length( sTmpRet ) > 0 Then
    Begin
      tsStrList.Add( EraseChar( RestoreString( sTmpRet ) ) );
      Inc( iNoStrings, 1 );
    End;
  End
  Else
  Begin
    If ( Length( sTmpRet ) > 0 ) Or bAllowEmpty Then
    Begin
      tsStrList.Add( EraseChar( RestoreString( sTmpRet ) ) );
      Inc( iNoStrings, 1 );
    End;
  End;
  Result := iNoStrings;
End;

{------------------------------------------------------------------------------
 MIF2DelphiBrush
------------------------------------------------------------------------------}

Function MIF2DelphiBrush( iStyle: Integer ): TBrushStyle;
Begin
  Case iStyle Of
    1: Result := bsClear;
    3, 19..23: Result := bsHorizontal;
    4, 24..28: Result := bsVertical;
    5, 29..33: Result := bsBDiagonal;
    6, 34..38: Result := bsFDiagonal;
    7, 39..43, 56..60: Result := bsCross;
    8, 44..52, 55, 61..70: Result := bsDiagCross;
  Else
    Result := bsSolid;
  End;
End;

{------------------------------------------------------------------------------
  MIF2DelphiColor
------------------------------------------------------------------------------}

Function MIF2DelphiColor( iColor: Integer ): Integer;
Var
  sTmp: String;
  code: integer;
Begin
  sTmp := IntToHex( iColor, 6 );
  val( '$' + Copy( sTmp, 5, 2 ) + Copy( sTmp, 3, 2 ) + Copy( sTmp, 1, 2 ), result, code );
End;

{------------------------------------------------------------------------------
  FetchMIFdata
------------------------------------------------------------------------------}

Procedure TEzMifImport.CompareBoundary( x, y: double );
Begin
  If x < minx Then
    minx := x;
  If y < miny Then
    miny := y;
  If x > maxx Then
    maxx := x;
  If y > maxy Then
    maxy := y;
End;

Function TEzMifImport.FetchMIFdata( bSplit: Boolean ): Boolean;
Var
  sTmp: String;

  //for Some odd mif compatible files.

  Function MakeSpace( Const S1, S2: String ): String;
  Var
    i: integer;
    ss1, ss2: String;
  Begin
    result := s2;
    i := AnsiPos( s1, AnsiUpperCase( s2 ) ) + Length( s1 );
    If i <> 0 Then
      If S2[i] <> ' ' Then
      Begin
        ss1 := copy( s2, 1, i - 1 );
        ss2 := copy( s2, i, length( s2 ) - i + 1 );
        result := ss1 + ' ' + ss2;
      End;
  End;

  Function strproc( const s: String ): String;
  Begin
    Result := S;
    If AnsiPos( 'PEN', AnsiUpperCase( s ) ) <> 0 Then
    Begin
      Result := MakeSpace( 'PEN', S );
      Exit;
    End
    Else If AnsiPos( 'BRUSH', AnsiUpperCase( S ) ) <> 0 Then
    Begin
      Result := MakeSpace( 'BRUSH', S );
      Exit;
    End;
  End;

Begin
  Repeat
    Inc( giMIFLinePos );
    Result := giMIFLinePos < gMIFlines.Count;
    If Not Result Then
      Exit;
    sTmp := Trim( gMIFlines[giMIFLinePos] );
  Until Length( sTmp ) <> 0;
  If Result And bSplit Then
  Begin
    sTmp := StrProc( sTmp );
    StrSplitToList( sTmp, ' ', gslMIF, False );
  End;
End;

{------------------------------------------------------------------------------
  ReadSymbolObject
------------------------------------------------------------------------------}

Function TEzMifImport.ReadSymbolObject: Boolean;
Var
  sTmp, Stmp2: String;
  i, j,code: integer;
  tempf:double;
Begin
  Result := AnsiCompareText( gslMIF[0], 'Symbol' ) = 0;
  //add for geomania
  If Result = false Then
    result := Pos( 'SYMBOL', uppercase( gslMIF[0] ) ) <> 0;
  If Not Result Then
    Exit;
  Defsymbol.Index := 0;
  Defsymbol.Rotangle := 0;
  //Defsymbol.Height := 0;
  Defsymbol.height := -12;

  sTmp := gslMIF[1];
  stmp2 := '';
  If gslmif.Count = 3 Then
    STmp2 := gslMIF[2]
  Else If gslmif.count = 5 Then
    Stmp := gslMIF[1] + gslMIF[2] + gslMIF[3]; //add for geomania

  StrSplitToList( Copy( sTmp, 2, Length( sTmp ) - 2 ), ',', gslMIF, True );

  Try
    //Defsymbol.Index := (StrToInt(gslMIF[0])) mod Globalinfo.symbols.Count; //index
    //fix for Mif Bitmap Symbol name 2001-10-14 nakijun
    val( gslMIF[0], i, j );
    If j = 0 Then
      Defsymbol.Index := abs( i - 32 )
    Else
      Defsymbol.Index := 0;
    val(gslMIF[2],tempf,code);
    DefSymbol.Height := Round( tempf );

    If Stmp2 <> '' Then
    Begin
      StrSplitToList( Copy( sTmp2, 2, Length( sTmp2 ) - 2 ), ',', gslMIF, True );
      val(gslMIF[2],tempf,code); //rotation
      DefSymbol.Rotangle := tempf;
    End;
  Except
  End;

  FetchMIFdata( True );
End;

{------------------------------------------------------------------------------
  ReadPenObject
------------------------------------------------------------------------------}

Function TEzMifImport.ReadPenObject: Boolean;
Var
  sTmp: String;
  clr,code:integer;
Begin
  Result := AnsiCompareText( gslMIF[0], 'Pen' ) = 0;
  If Not Result Then Exit;
  sTmp := gslMIF[1];
  StrSplitToList( Copy( sTmp, 2, Length( sTmp ) - 2 ), ',', gslMIF, True );

  Try
    val(gslMIF[2],clr,code );
    defpen.Color := MIF2DelphiColor( clr );
    defpen.Style := 1; //StrToInt(gslMIF[1]) - 1;
    defpen.Width := StrToIntDef( gslMIF[0], 0 );
    {If defpen.Width < 8 Then
      defpen.Width := 0
    else
      defpen.Width := defpen.Width / 100 - 0.01; }
    defpen.Width := 0
  Except
  End;

  FetchMIFdata( True );
End;

{------------------------------------------------------------------------------
 ReadBrushObject
------------------------------------------------------------------------------}

Function TEzMifImport.ReadBrushObject: Boolean;
Var
  sTmp: String;
  temp,code:integer;
Begin
  Result := AnsiCompareText( gslMIF[0], 'Brush' ) = 0;
  If Not Result Then
    Exit;
  sTmp := gslMIF[1];
  StrSplitToList( Copy( sTmp, 2, Length( sTmp ) - 2 ), ',', gslMIF, True );

  With DefBrush Do
  Try
    val(gslMIF[0],temp,code); if temp=0 then temp:=1;
    defbrush.Pattern := temp - 1;
    val(gslMIF[1],temp,code);
    defbrush.Color := MIF2DelphiColor( temp );
    //defbrush.BackColor := MIF2DelphiColor(StrToInt(gslMIF[2]));
  Except
    defbrush.Pattern := 0;
    defbrush.ForeColor := clBlack;
  End;
  FetchMIFdata( True );
End;

{------------------------------------------------------------------------------
  ReadFontObject
------------------------------------------------------------------------------}

Function TEzMifImport.ReadFontObject: Boolean;
Var
  sTmp: String;
  idx, temp,code,fstyle: integer;
Begin
  Result := AnsiCompareText( gslMIF[0], 'Font' ) = 0;
  If Result Then
  Begin
    sTmp := gslMIF[1];
    For idx := 2 To gslMIF.Count - 1 Do { put the font line back together }
      sTmp := sTmp + ' ' + gslMIF[idx];

    StrSplitToList( Copy( sTmp, 2, Length( sTmp ) - 2 ), ',', gslMIF, True );
    Try
      deffont.Name := StringReplace( gslMIF[0], '"', '', [rfReplaceAll]);

      // Mapinfo Text style
      // 1 - Bold
      // 2 - Italic
      // 4 - underline
      // 32- shadow
      // 512- All Capitals display
      // 1024 - Expand space
      deffont.Style := [];
      val(gslMIF[1],fstyle,code);
      If ( fstyle Div 1024 ) = 1 Then
        fstyle := fstyle - 1024;
      If ( fstyle Div 512 ) = 1 Then
      Begin
        deffont.Name := AnsiUppercase( deffont.Name );
        fstyle := fstyle - 512;
      End;
      If ( fstyle Div 4 ) = 1 Then
      Begin
        deffont.style := deffont.style + [fsUnderline];
        fstyle := fstyle - 4;
      End;
      If ( fstyle Div 2 ) = 1 Then
      Begin
        deffont.style := deffont.style + [fsitalic];
        fstyle := fstyle - 2;
      End;
      If fstyle = 1 Then
        deffont.style := deffont.style + [fsbold];

      val(gslMIF[2],temp,code);
      deffont.height := temp;
      If deffont.height = 0 Then
        deffont.height := -8;
      val(gslMIF[3],temp,code);
      Deffont.Color := MIF2DelphiColor( temp );
      DefFont.Angle := 0;
    Except
    End;
  End;

  //for Autodesk World Mif!!!
  If AnsiCompareText( gslMIF[0], 'Angle' ) = 0 Then
    dec( giMIFLinePos );
  While FetchMIFdata( True ) Do
  Begin