⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ezsdlimport.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit EzSDLImport;

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

{$I EZ_FLAG.PAS}
Interface

Uses
  Controls, SysUtils, Classes, Windows, Dialogs,
  EzLib, EzBase, EzBaseGIS, EzProjections, EzImportBase;

type

  SDLError = class(Exception);

  TSDLObjType = ( soPoint, soLine, soPolygon );

  TSDLPointList = Class
  Private
    FType: TSDLObjType;
    FPoints: TEzVector;
    FVectorList: TList;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure Clear;
    procedure ClearVectorList;
    Function ArrangePartPos: integer;
  End;

  TEzSDLImport = Class( TEzBaseImport )
  Private
    SDLInputFile: TextFile;
    SDLPtList: TSDLPointList;
    SDLObjType: tSDLObjType;
    defPen: TEzPenStyle;
    defbrush: TEzBrushStyle;
    defsymbol: TEzsymbolstyle;
    ColumnInfo: TStringList;
    fOK: Boolean;
    LastPointCount: Integer;
    MinX :Double;
    Miny :Double;
    MaxX :Double;
    Maxy :Double;
    Line: string;
    { for progress messages }
    nFileSize: Integer;
    Function GetNextSDLObjectType( Var Line: String; Var SDLObjType: tSDLObjType ): boolean;
    function GetField(const line: string; No: Integer; Del: Char): string;
    function ReadSDLLine(var Line: string): boolean; { returns false if end-of-file before reading }
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure ImportInitialize; Override;
    Procedure GetSourceFieldList( FieldList: TStrings ); Override;
    Procedure ImportFirst; Override;
    Function ImportEof: Boolean; Override;
    Function GetNextEntity(var progress,entno: Integer): TEzEntity; Override;
    Procedure AddSourceFieldData(DestLayer: TEzBaseLayer; DestRecno: Integer); Override;
    Procedure ImportNext; Override;
    Function GetSourceExtension: TEzRect; Override;
    Procedure ImportEnd; Override;
  End;

  TEzSDLExport = Class( TEzBaseExport )
  Private
    FCanceled: Boolean;
    FCoordList : TStringList;
    SDLOutfileL: Text;
    SDLOutfileM: Text;
    SDLOutfileP: Text;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Procedure ExportInitialize; Override;
    Procedure ExportEntity( SourceLayer: TEzBaseLayer; Entity: TEzEntity ); Override;
    Procedure ExportEnd; Override;
  End;

implementation

uses
  EzEntities, EzSystem;

Const
  SDLDelim = ',';
  SDLObjStr: Array[tSDLObjType] Of String = ( 'M', 'L', 'P' );

{ TEzSDLImport }

constructor TEzSDLImport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ColumnInfo := TStringList.Create;
  SDLPtList := TSDLPointList.Create;
  defPen:= Ez_Preferences.DefPenStyle.FPenStyle;
  defbrush:= Ez_Preferences.DefBrushStyle.FBrushStyle;
  defsymbol:= Ez_Preferences.DefSymbolStyle.FSymbolStyle;
end;

destructor TEzSDLImport.Destroy;
begin
  ColumnInfo.Free;
  SDLPtList.Free;
  inherited;
end;

procedure TEzSDLImport.ImportInitialize;
begin
  MinX := 1E+10;
  Miny := 1E+10;
  MaxX := -1E+10;
  Maxy := -1E+10;

  AssignFile( SDLInputFile, FileName );
  Reset( SDLInputFile );
  nFileSize:= FileSize(SDLInputFile);

end;

procedure TEzSDLImport.ImportFirst;
begin
  fOK := GetNextSDLObjectType(Line, SDLObjType);
end;

function TEzSDLImport.ImportEof: Boolean;
begin
  Result:= Not fOK;
end;

Function TEzSDLImport.GetNextSDLObjectType( Var Line: String; Var SDLObjType: tSDLObjType ): boolean;
Var
  GotIt: boolean;
  ObjStr: String;
  ObjType: tSDLObjType;

Begin

  GotIt := false;
  Result := true;

  Line := '';
  Repeat
    ObjStr := uppercase( GetField( Line, 1, SDLDelim ) );
    For ObjType := low( tSDLObjType ) To high( tSDLObjType ) Do
    Begin
      If ObjStr = SDLObjStr[ObjType] Then
      Begin
        GotIt := true;
        SDLObjType := ObjType;
      End;
    End;
    If Not GotIt Then
      Result := ReadSDLLine( Line );
  Until GotIt Or Not Result;

End;

procedure TEzSDLImport.ImportNext;
begin
  fOK := GetNextSDLObjectType(Line, SDLObjType);
end;

function TEzSDLImport.GetField(const line: string; No: Integer; Del: Char): string;

var
  i, Delimeter_pos, end_pos: integer;
  tmp_line: string;

begin
  tmp_line := line;

  if No > 1 then
    for i := 0 to No - 2 do
    begin
      Delimeter_pos := Pos(Del, tmp_line);
      tmp_line := Copy(tmp_line, Delimeter_pos + 1, length(tmp_line) - Delimeter_pos)
    end;

  end_pos := Pos(Del, tmp_line);
  if end_pos <> 0 then
    tmp_line := Copy(tmp_line, 1, end_pos - 1);

  Result := tmp_line;
  if not (tmp_line = '') then
    if tmp_line[1] = '"' then
      Result := Copy(tmp_line, 2, Length(Result) - 2);

end;

function TEzSDLImport.ReadSDLLine(var Line: string): boolean; { returns false if end-of-file before reading }
begin
  Result := false;
  if not eof(SDLInputFile) then begin
    Result := true;
    readln(SDLInputFile, Line);

    //Check For Header Skipping.
    if (Copy(Line, 1, 1) = ';') or (Copy(Line, 1, 1) = '#') then
      while (not Eof(SDLInputfile)) and ((Copy(Line, 1, 1) = ';') or (Copy(Line, 1, 1) = '#')) do
        readln(SDLInputFile, Line);

    if Eof(SDLinputfile) then Result := false;
  end;
end;

function TEzSDLImport.GetNextEntity(var progress,entno: Integer): TEzEntity;

  Procedure CompareBoundary( Const 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 ReadSDLCommand(var Command, Line: string): boolean;
  begin
    Result := ReadSDLLine(Line);
    Line := lowercase(Line);
    Command := GetField(Line, 1, SDLDelim);
  end;

  function GetSDLCoord(const Line: string; FieldPos: byte): TEzPoint;
  begin
    try
      Result.Y := StrToFloat(GetField(Line, FieldPos, SDLDelim));
      Result.X := StrToFloat(GetField(Line, FieldPos + 1, SDLDelim));
    except
      on e: Exception do begin
        raise SDLError.Create(e.Message + ' - Import terminated');
      end;
    end;
  end;

  function GetSDLCoordWithString(const Line: string; FieldPos: byte): string;
  begin
    try Result := GetField(line, FieldPos, SDLDelim);
    except
      on e: EXCEPTION do begin
        raise SDLError.Create(e.Message + ' - Import terminated');
      end;
    end;
  end;

Var
  pointCount: Integer;
  TmpEntity: TEzEntity;
  i, j, PartOffset: integer;
  TmpPt: TEzPoint;
  V: TEzVector;
begin

  entno:= FilePos(SDLInputFile);
  progress:= Round((entno / nFileSize) * 100);

  Result:= Nil;
  pointCount := StrToInt( GetField( line, 5, SDLDelim ) );
  Case SDLObjType Of
    // M, Points
    soPoint:
      Begin
        TmpEntity := TEzPlace.Create( pointCount );
        TEzPlace( TmpEntity ).Symboltool.FSymbolStyle := defsymbol;
        SDLPtList.FType := soPoint;
      End;
    // L, Polylines
    soLine:
      Begin
        TmpEntity := TEzPolyline.Create( pointCount );
        TEzPolyline( TmpEntity ).Pentool.FPenStyle := defPen;
        SDLPtList.FType := soLine;
      End;
    // P, Polygons
    soPolygon:
      Begin
        TmpEntity := TEzPolygon.Create( pointCount );
        TEzPolygon( TmpEntity ).Pentool.FPenStyle := defPen;
        TEzPolygon( TmpEntity ).Brushtool.FBrushStyle := defbrush;
        SDLPtList.FType := soPolygon;
      End;
  Else
    Exit;
  End;

  ColumnInfo.Clear;
  Columninfo.Add( GetField( line, 1, SDLDelim ) );
  Columninfo.Add( GetField( line, 2, SDLDelim ) );
  Columninfo.Add( GetField( line, 3, SDLDelim ) );
  Columninfo.Add( GetField( line, 4, SDLDelim ) );
  Columninfo.Add( GetField( line, 5, SDLDelim ) );

  For i := 0 To pointCount - 1 Do
  Begin
    ReadSDLLine( line );
    TmpPt := GetSDLCoord( line, 1 );
    SDLPtList.FPoints.Add( TmpPt );
  End;

  If SDLPtList.FType <> soPoint Then
  Begin
    SDLPtList.ArrangePartPos;
    PartOffset:= 0;
    For i:= 0 to SDLPtList.FVectorList.Count - 1 do
    begin
      V:= TEzVector(SDLPtList.FVectorList[i]);
      for j:= 0 to V.Count - 1 do
      begin
        TmpPt:= V[j];
        Compareboundary( TmpPt.X, TmpPt.Y );
        TmpEntity.Points.Add( TmpPt );
      end;
      If SDLPtList.FVectorList.Count > 1 Then
        TmpEntity.Points.Parts.Add(PartOffset);
      Inc(PartOffset, V.Count);
    end;
  End Else
    TmpEntity.Points.Add( SDLPtList.FPoints[0] );

  LastPointCount:= TmpEntity.Points.Count;
  If LastPointCount > 0 Then
    Result:= TmpEntity
  Else
  Begin
    Result:= Nil;
    TmpEntity.Free;

⌨️ 快捷键说明

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