ezdgnlayer.pas

很管用的GIS控件

unit EzDGNLayer;

{$I EZ_FLAG.PAS}
interface

Uses
  SysUtils, Windows, Classes, Graphics, Controls, Forms,
  EzBaseGis, EzLib, EzBase, EzShpImport, EzRTree, EzBaseExpr, Dialogs, StdCtrls;

{$DEFINE CPL_LSB}
{$DEFINE WITH_TEMPLATE}   // export option: by using template or not
type

  TPaletteArray = Packed Array[0..255, 0..2] Of Byte;

  T4Byte = Packed Array[0..3] Of Byte;
  T8Byte = Packed Array[0..7] Of Byte;

  TElm_hdr = Packed Record {The element header}
    LevelCmplx: Byte; {Bits 0-6: Level, 7: Reserved, 8: Set if component part of complex elem}
    TypeDeleted: Byte; {Bits 1-7: Type, 8: Set if element is deleted}
    Words: Word; {Words to follow in element, to next element, excluding two words above}
    xLow: DWord; {Element extents - Low}
    yLow: DWord;
    zLow: DWord;
    xHigh: DWord; {Element extents - High}
    yHigh: DWord;
    zHigh: DWord;
  End;

  TDisp_hdr = Packed Record {The display header}
    grphgrp: Word; {Graphic group number}
    attindx: Smallint; {Words between this and attribute linkage}
    props: Word; {Bits 0-3: Class, 4-7: Reserved, 8: Locked, 9: New, 10: Modified, 11: Attrib present}
    {      12: View Independant, 13: Planar, 14: 1=nonsnappable, 15: hole/solid (usually)}
    symb: Word; {Bits 0-2: Line style, 3-7: Line weight, 8-15: Color}
  End;

  TDGNElemTCB = Record { The DGN File TCB }
    Head: TElm_hdr;
    Dimension: byte; // 2 or 3

    sub_per_master: longint; // Subunits per master unit.
    master_units: Array[0..2] Of char; // Name of Master units
    uor_per_subunit: longint; // UOR (Units Of Resolution per subunits.
    sub_units: Array[0..2] Of char; // Name of Sub units

    origin_x: LongInt; // X origin of UOR space in master units(?)
    origin_y: LongInt; // Y origin of UOR space in master units(?)
    origin_z: LongInt; // Z origin of UOR space in master units(?)
  End;

  TDGNPoint2D = Packed Record {A 2D Point}
    x, y: Longint;
  End;

  TDGNPoint3D = Packed Record {A 3D Point}
    x, y, z: Longint;
  End;

  TDPoint3D = Packed Record { A 3D DoublePoint}
    x, y, z: Double;
  End;

  TDPoint2D = TEzPoint;

  TEzConvertPoint = Procedure (Sender: TObject; Var P: TEzPoint ) Of Object;

  { this class is for reading DGN files }
  TEzDGNFile = Class
  Private
    FUseTrueType: Boolean;
    FUseDefaultColorTable: Boolean;
    FOffsets: TIntegerList;
    FFileName: string;
    FIncludedLevels: Array[0..63] Of Boolean;
    FXMin: Double;
    FYMin: Double;
    FXMax: Double;
    FYMax: Double;
    { memory loaded means all entities will be loaded to memory }
    FMemoryLoaded: Boolean;
    FElements: TEzEntityList;

    FActive: Boolean;
    FDGNInputStream: TStream;
    FScale: Double;
    FHeightQuotient: Double;
    FColorTable: TPaletteArray;
    FDGN_TCB: TDGNElemTCB;

    FOnConvertPoint: TEzConvertPoint;

    Procedure EvaluateDisp_Hdr( Const h: TDisp_Hdr;
      Var curpen: TEzPenStyle; Var curbrush: TEzBrushStyle );
    Function GetRecordCount: Integer;
    function GetIncludedLevels(Index: Integer): Boolean;
    procedure SetIncludedLevels(Index: Integer; const Value: Boolean);
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure Open;
    Procedure Close;
    Function GetElement( n: Integer;
      Var element_type, element_level, PlanOfEle: Integer;
      Var element_str: string; Var _3Dz: Double ): TEzEntity ;

    Property UseTrueType: Boolean read FUseTrueType write FUseTrueType;
    Property UseDefaultColorTable: Boolean read FUseDefaultColorTable write FUseDefaultColorTable;
    Property Offsets: TIntegerList read FOffsets write FOffsets;
    Property FileName: string read FFileName write FFileName;
    Property Active: Boolean read FActive write FActive;
    Property RecordCount : Integer read GetRecordCount ;
    Property IncludedLevels[Index: Integer]: Boolean read GetIncludedLevels write SetIncludedLevels;
    Property XMin: Double read FXMin write FXMin;
    Property YMin: Double read FYMin write FYMin;
    Property XMax: Double read FXMax write FXMax;
    Property YMax: Double read FYMax write FYMax;
    Property MemoryLoaded: Boolean read FMemoryLoaded write FMemoryLoaded;

    Property OnConvertPoint: TEzConvertPoint read FOnConvertPoint write FOnConvertPoint;
  End;


  { now a TDGNLayer class }

{-----------------------------------------------------------------------------}
//                    TDGNLayerInfo
{-----------------------------------------------------------------------------}

  TDGNLayerInfo = Class( TEzBaseLayerInfo )
  Protected
    Function GetOverlappedTextAction: TEzOverlappedTextAction; Override;
    Procedure SetOverlappedTextAction( Value: TEzOverlappedTextAction ); Override;
    Function GetOverlappedTextColor: TColor; Override;
    Procedure SetOverlappedTextColor( Value: TColor ); Override;
    Function GetTextHasShadow: Boolean; Override;
    Procedure SetTextHasShadow( Value: boolean ); Override;
    Function GetTextFixedSize: Byte; Override;
    Procedure SetTextFixedSize( Value: Byte ); Override;
    Function GetVisible: boolean; Override;
    Procedure SetVisible( Value: boolean ); Override;
    Function GetSelectable: boolean; Override;
    Procedure SetSelectable( Value: boolean ); Override;
    Function GetIsCosmethic: boolean; Override;
    Procedure SetIsCosmethic( value: boolean ); Override;
    Function GetExtension: TEzRect; Override;
    Procedure SetExtension( Const Value: TEzRect ); Override;
    Function GetIDCounter: integer; Override;
    Procedure SetIDCounter( Value: integer ); Override;
    Function GetIsAnimationLayer: boolean; Override;
    Procedure SetIsAnimationLayer( Value: boolean ); Override;
    Function GetIsIndexed: boolean; Override;
    Procedure SetIsIndexed( Value: boolean ); Override;
    Function GetCoordsUnits: TEzCoordsUnits; Override;
    Procedure SetCoordsUnits( Value: TEzCoordsUnits ); Override;
    Function GetCoordSystem: TEzCoordSystem; Override;
    Procedure SetCoordSystem( Value: TEzCoordSystem ); Override;
    Function GetUseAttachedDB: Boolean; Override;
    Procedure SetUseAttachedDB( Value: Boolean ); Override;
    Function GetLocked: Boolean; Override;
    Procedure SetLocked( Value: Boolean ); Override;
  End;

  {----------------------------------------------------------------------------}
  //                    TDGNLayer
  {----------------------------------------------------------------------------}

  TEzDGNHeader = Packed record
    IncludedLevels: Array[0..63] Of Boolean;
    UseTrueType: Boolean;
    UseDefaultColorTable: Boolean;
    MemoryLoaded: Boolean;
  end;

  TDGNLayer = Class( TEzBaseLayer )
  Private
    FDGNFile: TEzDGNFile;
    FHeader: TEzLayerHeader;
    FRecno: Integer;
    FDBTable: TEzBaseTable;
    FEofCrack: Boolean;
    FUpdateRtree: Boolean;
    { buffering }
    ol: TIntegerList;
    FFilterRecno: Integer;
    FFiltered: boolean;

    { Information specific to this layer }
    FDGNHeader: TEzDGNHeader;

    Function GetDGNFile: TEzDGNFile;
    //Procedure UpdateMapExtension( Const R: TEzRect );
  Protected
    Function GetRecno: Integer; Override;
    Procedure SetRecno( Value: Integer ); Override;
    Function GetRecordCount: Integer; Override;
    Function GetActive: Boolean; Override;
    Procedure SetActive( Value: Boolean ); Override;
    Function GetDBTable: TEzBaseTable; Override;
  Public
    Constructor Create( Layers: TEzBaseLayers; Const AFileName: String ); Override;
    Destructor Destroy; Override;
    Procedure InitializeOnCreate( Const FileName: String;
      AttachedDB, IsAnimation: Boolean; CoordSystem: TEzCoordSystem;
      CoordsUnits: TEzCoordsUnits; FieldList: TStrings ); Override;
    Procedure StartBatchInsert; Override;
    Procedure FinishBatchInsert; Override;
    Procedure SetGraphicFilter( s: TSearchType; Const VisualWindow: TEzRect ); Override;
    Procedure CancelFilter; Override;
    Procedure GetFieldList( Strings: TStrings ); Override;
    Procedure Assign( Source: TEzBaseLayer ); Override;
    Procedure Open; Override;
    Procedure Close; Override;
    Procedure ForceOpened; Override;
    Procedure WriteHeaders( FlushFiles: Boolean ); Override;
    Function AddEntity( Entity: TEzEntity ): Integer; Override;
    Procedure DeleteEntity( RecNo: Integer ); Override;
    Procedure UnDeleteEntity( RecNo: Integer ); Override;
    Function UpdateExtension: TEzRect; Override;
    Function QuickUpdateExtension: TEzRect; Override;
    Function LoadEntityWithRecNo( RecNo: Longint ): TEzEntity; Override;
    Procedure UpdateEntity( RecNo: Integer; Entity2D: TEzEntity ); Override;
    Procedure Pack( ShowMessages: Boolean ); Override;
    Procedure Repair; Override;
    Procedure Zap; Override;

    Function Eof: Boolean; Override;
    Procedure First; Override;
    Procedure Last; Override;
    Procedure Next; Override;
    Procedure StartBuffering; Override;
    Procedure EndBuffering; Override;
    Function ContainsDeleted: Boolean; Override;
    Procedure Recall; Override;

    Function GetBookmark: Pointer; Override;
    Procedure GotoBookmark( Bookmark: Pointer ); Override;
    Procedure FreeBookmark( Bookmark: Pointer ); Override;

    Function SendEntityToBack( ARecno: Integer ): Integer; Override;
    Function BringEntityToFront( ARecno: Integer ): Integer; Override;
    Function RecIsDeleted: boolean; Override;
    Procedure RecLoadEntity2( Entity: TEzEntity ); Override;
    Function RecLoadEntity: TEzEntity; Override;
    Function RecExtension: TEzRect; Override;
    Function RecEntityID: TEzEntityID; Override;
    Procedure RebuildTree; Override;
    Procedure CopyRecord( SourceRecno, DestRecno: Integer ); Override;
    Function DefineScope( Const Scope: String ): Boolean; Override;
    Function DefinePolygonScope( Polygon: TEzEntity; Const Scope: String;
      Operator: TEzGraphicOperator ): Boolean; Override;
    Procedure Synchronize; Override;
    function GetExtensionForRecords( List: TIntegerList ): TEzRect; Override;

    Property DGNFile: TEzDGNFile read GetDGNFile;
    Property DGNHeader: TEzDGNHeader read FDGNHeader write FDGNHeader;

  End;


  { Original C++ code translation, implementation and export functionality by :
    Luis Rodrigo Ya馿z Gutierrez }

  TDGNFileStream = class (TFileStream)
  Public
    constructor Create(const FileName: string; Mode: Word);
    function DGNRead(Buffer : Pointer; Count: Longint): Longint;
    function DGNWrite(Buffer : Pointer; Count: Longint): Longint;
  End;

  TEzDGNExport = Class(TComponent)
  private
    fp : TDGNFileStream;
    FColorTable : TPaletteArray;
    FUsedColors : SmallInt;
    FTableColorOffset : Longint;
    FTCBOffset: Longint;

    Fsubunits_per_master: integer;
    Fuor_per_subunit: integer;
    FMasterUnits: string;
    FSubUnits: string;
    FDgnScale: integer;

    FBuffer : PByteArray;
    FBuffSize : LongWord;

    Procedure CreateBuffer(Const Size : LongWord);
    Procedure ClearBuffer;
    Procedure FreeBuffer;

    Procedure SaveExtents( Buffer : PByteArray;  Const box: TEzRect );
    Procedure SavePointsToBuffer(Points : TEzVector; Idx1,Idx2: Integer; Buffer : PByteArray);
    Procedure SaveEllipse(Entity : TEzEntity; Level : Byte; var nWords : LongWord);
    Procedure SaveArc(Entity : TEzEntity; Level : Byte; var nWords : LongWord);
    Procedure SaveText(Entity : TEzEntity; Level : Byte; var nWords : LongWord);
    Procedure SavePlace(Entity : TEzEntity; Level : Byte; var nWords : LongWord);
    Procedure SaveComplex(Extension : TEzRect; Level : Byte; ElemCount, ElemLength : Integer; Closed : Boolean);
    Procedure SaveEntity(Points : TEzVector; Color : TColor; Level : Byte; idx1, idx2 : Integer; DGN_TYPE : Integer; Closed : Boolean);
    Procedure SaveMultiPointEntity(Entity : TEzEntity; Level : Byte);
  protected
    Procedure CreateNewTable;
    Function AddColorToTable(Color : TColor) : SmallInt;
    Procedure SetColor(Var Core : Byte; Color : TColor);
    Procedure SetType(Buffer : PByteArray; DGNType : Byte; Level : Byte = 1; Complex : Boolean = False);
    Procedure SetStyle(Pen : TEzPenTool; Core : PByteArray; Closed: Boolean);
    Procedure SaveTCB(Buffer : PByteArray; subunits_per_master, uor_per_subunit : Integer;
                      Const master_units, sub_units : String; const origin_x, origin_y : Double);
    Procedure SaveColorTable(Position : Integer);
    Procedure UpdateColorTable;

  public
    constructor Create(AOwner: TComponent); override;
    Procedure DGNExport(Gis : TEzBaseGis; Layers : TStrings;
      Const FileName, Template : String; ExplodeBlocks: Boolean );
  Published
    Property subunits_per_master: integer read Fsubunits_per_master write Fsubunits_per_master;
    Property uor_per_subunit: integer read Fuor_per_subunit write Fuor_per_subunit;
    Property MasterUnits: string read FMasterUnits write FMasterUnits;
    Property SubUnits: string read FSubUnits write FSubUnits;
  End;

  Procedure ImportDGN( pszFileName : PChar; Gis : TEzBaseGIS; Layer : TEzBaseLayer; Memo : TMemo);

  Procedure vax2ieee(dbl : Pointer);
  Function DGN_INT32(p : Pointer) : Integer;
  Procedure Swap8Bytes(dbl : Pointer);

implementation

uses
  Math, EzSystem, EzConsts, EzEntities, EzMiscelEntities, EzBasicCtrls, EzExpressions;

Const
  DefColorTable: TPaletteArray = (
    ( 0, 0, 0 ), ( 255, 255, 255 ), ( 0, 0, 255 ), ( 0, 255, 0 ), ( 255, 0, 0 ), ( 255, 255, 0 ), ( 255, 0, 255 ), ( 255, 127, 0  ),
    ( 0, 255, 255 ), ( 64, 64, 64 ), ( 192, 192, 192 ), ( 254, 0, 96 ), ( 160, 224, 0 ), ( 0, 254, 160 ), ( 128, 0, 160 ), ( 176, 176, 176 ),
    ( 0, 240, 240 ), ( 240, 240, 240 ), ( 0, 0, 240 ), ( 0, 240, 0 ), ( 240, 0, 0 ), ( 240, 240, 0 ), ( 240, 0, 240 ), ( 240, 122, 0 ),
    ( 0, 240, 240 ), ( 240, 240, 240 ), ( 0, 0, 240 ), ( 0, 240, 0 ), ( 240, 0, 0 ), ( 240, 240, 0 ), ( 240, 0, 240 ), ( 240, 122, 0 ),
    ( 0, 225, 225 ), ( 225, 225, 225 ), ( 0, 0, 225 ), ( 0, 225, 0 ), ( 225, 0, 0 ), ( 225, 225, 0 ), ( 225, 0, 225 ), ( 225, 117, 0 ),
    ( 0, 225, 225 ), ( 225, 225, 225 ), ( 0, 0, 225 ), ( 0, 225, 0 ), ( 225, 0, 0 ), ( 225, 225, 0 ), ( 225, 0, 225 ), ( 225, 117, 0 ),
    ( 0, 210, 210 ), ( 210, 210, 210 ), ( 0, 0, 210 ), ( 0, 210, 0 ), ( 210, 0, 0 ), ( 210, 210, 0 ), ( 210, 0, 210 ), ( 210, 112, 0 ),
    ( 0, 210, 210 ), ( 210, 210, 210 ), ( 0, 0, 210 ), ( 0, 210, 0 ), ( 210, 0, 0 ), ( 210, 210, 0 ), ( 210, 0, 210 ), ( 210, 112, 0 ),
    ( 0, 195, 195 ), ( 195, 195, 195 ), ( 0, 0, 195 ), ( 0, 195, 0 ), ( 195, 0, 0 ), ( 195, 195, 0 ), ( 195, 0, 195 ), ( 195, 107, 0 ),
    ( 0, 195, 195 ), ( 195, 195, 195 ), ( 0, 0, 195 ), ( 0, 195, 0 ), ( 195, 0, 0 ), ( 195, 195, 0 ), ( 195, 0, 195 ), ( 195, 107, 0 ),
    ( 0, 180, 180 ), ( 180, 180, 180 ), ( 0, 0, 180 ), ( 0, 180, 0 ), ( 180, 0, 0 ), ( 180, 180, 0 ), ( 180, 0, 180 ), ( 180, 102, 0 ),
    ( 0, 180, 180 ), ( 180, 180, 180 ), ( 0, 0, 180 ), ( 0, 180, 0 ), ( 180, 0, 0 ), ( 180, 180, 0 ), ( 180, 0, 180 ), ( 180, 102, 0 ),
    ( 0, 165, 165 ), ( 165, 165, 165 ), ( 0, 0, 165 ), ( 0, 165, 0 ), ( 165, 0, 0 ), ( 165, 165, 0 ), ( 165, 0, 165 ), ( 165, 97, 0 ),
    ( 0, 165, 165 ), ( 165, 165, 165 ), ( 0, 0, 165 ), ( 0, 165, 0 ), ( 165, 0, 0 ), ( 165, 165, 0 ), ( 165, 0, 165 ), ( 165, 97, 0 ),
    ( 0, 150, 150 ), ( 150, 150, 150 ), ( 0, 0, 150 ), ( 0, 150, 0 ), ( 150, 0, 0 ), ( 150, 150, 0 ), ( 150, 0, 150 ), ( 150, 92, 0 ),
    ( 0, 150, 150 ), ( 150, 150, 150 ), ( 0, 0, 150 ), ( 0, 150, 0 ), ( 150, 0, 0 ), ( 150, 150, 0 ), ( 150, 0, 150 ), ( 150, 92, 0 ),
    ( 0, 135, 135 ), ( 135, 135, 135 ), ( 0, 0, 135 ), ( 0, 135, 0 ), ( 135, 0, 0 ), ( 135, 135, 0 ), ( 135, 0, 135 ), ( 135, 87, 0 ),
    ( 0, 135, 135 ), ( 135, 135, 135 ), ( 0, 0, 135 ), ( 0, 135, 0 ), ( 135, 0, 0 ), ( 135, 135, 0 ), ( 135, 0, 135 ), ( 135, 87, 0 ),
    ( 0, 120, 120 ), ( 120, 120, 120 ), ( 0, 0, 120 ), ( 0, 120, 0 ), ( 120, 0, 0 ), ( 120, 120, 0 ), ( 120, 0, 120 ), ( 120, 82, 0 ),
    ( 0, 120, 120 ), ( 120, 120, 120 ), ( 0, 0, 120 ), ( 0, 120, 0 ), ( 120, 0, 0 ), ( 120, 120, 0 ), ( 120, 0, 120 ), ( 120, 82, 0 ),
    ( 0, 105, 105 ), ( 105, 105, 105 ), ( 0, 0, 105 ), ( 0, 105, 0 ), ( 105, 0, 0 ), ( 105, 105, 0 ), ( 105, 0, 105 ), ( 105, 77, 0 ),
    ( 0, 105, 105 ), ( 105, 105, 105 ), ( 0, 0, 105 ), ( 0, 105, 0 ), ( 105, 0, 0 ), ( 105, 105, 0 ), ( 105, 0, 105 ), ( 105, 77, 0 ),
    ( 0, 90, 90 ), ( 90, 90, 90 ), ( 0, 0, 90 ), ( 0, 90, 0 ), ( 90, 0, 0 ), ( 90, 90, 0 ), ( 90, 0, 90 ), ( 90, 72, 0 ),
    ( 0, 90, 90 ), ( 90, 90, 90 ), ( 0, 0, 90 ), ( 0, 90, 0 ), ( 90, 0, 0 ), ( 90, 90, 0 ), ( 90, 0, 90 ), ( 90, 72, 0 ),
    ( 0, 75, 75 ), ( 75, 75, 75 ), ( 0, 0, 75 ), ( 0, 75, 0 ), ( 75, 0, 0 ), ( 75, 75, 0 ), ( 75, 0, 75 ), ( 75, 67, 0 ),
    ( 0, 75, 75 ), ( 75, 75, 75 ), ( 0, 0, 75 ), ( 0, 75, 0 ), ( 75, 0, 0 ), ( 75, 75, 0 ), ( 75, 0, 75 ), ( 75, 67, 0 ),
    ( 0, 60, 60 ), ( 60, 60, 60 ), ( 0, 0, 60 ), ( 0, 60, 0 ), ( 60, 0, 0 ), ( 60, 60, 0 ), ( 60, 0, 60 ), ( 60, 62, 0 ),
    ( 0, 60, 60 ), ( 60, 60, 60 ), ( 0, 0, 60 ), ( 0, 60, 0 ), ( 60, 0, 0 ), ( 60, 60, 0 ), ( 60, 0, 60 ), ( 60, 62, 0 ),
    ( 0, 45, 45 ), ( 45, 45, 45 ), ( 0, 0, 45 ), ( 0, 45, 0 ), ( 45, 0, 0 ), ( 45, 45, 0 ), ( 45, 0, 45 ), ( 45, 57, 0 ),
    ( 0, 45, 45 ), ( 45, 45, 45 ), ( 0, 0, 45 ), ( 0, 45, 0 ), ( 45, 0, 0 ), ( 45, 45, 0 ), ( 45, 0, 45 ), ( 45, 57, 0 ),
    ( 0, 30, 30 ), ( 30, 30, 30 ), ( 0, 0, 30 ), ( 0, 30, 0 ), ( 30, 0, 0 ), ( 30, 30, 0 ), ( 30, 0, 30 ), ( 30, 52, 0 ),
    ( 0, 30, 30 ), ( 30, 30, 30 ), ( 0, 0, 30 ), ( 0, 30, 0 ), ( 30, 0, 0 ), ( 30, 30, 0 ), ( 30, 0, 30 ), ( 192, 192, 192 )
    );

Type
  TLA = Array[1..4] Of Byte;

  _dbl = Packed Record
    hi : LongWord;
    lo : LongWord;
  End;

  double64_t = _dbl;

{ helper procedures follows }


Function LSwap( l: Longint ): LongInt;
Begin
  TLA( Result )[1] := TLA( l )[3];
  TLA( Result )[2] := TLA( l )[4];
  TLA( Result )[3] := TLA( l )[1];
  TLA( Result )[4] := TLA( l )[2];

  //Result := TLA( Result )[3] + TLA( Result )[4] * 256 + TLA( Result )[2] * 65536 * 256 + TLA( Result )[1] * 65536 ;

End;

Function HighOf8Byte( Const src: T8Byte ): T4Byte;
Begin
  Result[0] := src[0];
  Result[1] := src[1];
  Result[2] := src[2];
  Result[3] := src[3];
End;

Function LowOf8Byte( Const src: T8Byte ): T4Byte;
Begin
  Result[0] := src[4];
  Result[1] := src[5];
  Result[2] := src[6];
  Result[3] := src[7];