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

📄 ezdgnlayer.pas

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

Procedure Make8Byte( Var Dest: T8Byte; Const High, Low: T4Byte );
Begin
  Dest[0] := High[0];
  Dest[1] := High[1];
  Dest[2] := High[2];
  Dest[3] := High[3];
  Dest[4] := Low[0];
  Dest[5] := Low[1];
  Dest[6] := Low[2];
  Dest[7] := Low[3];
End;

(******************************************************************)

Procedure Swap8Bytes(dbl : Pointer);
var
    src : PByteArray;
    dest : PByteArray;
    dt : double64_t;
Begin

(* -------------------------------------------------------------------- *)
(* 	Arrange the VAX double so that it may be accessed by a 		*)
(*	double64_t structure, (two GUInt32s).				*)
(* -------------------------------------------------------------------- *)
    src :=   dbl;
    dest := @dt;
{$IFDEF CPL_LSB}
    dest[2] := src[0];
    dest[3] := src[1];
    dest[0] := src[2];
    dest[1] := src[3];
    dest[6] := src[4];
    dest[7] := src[5];
    dest[4] := src[6];
    dest[5] := src[7];
{$ELSE}
    dest[1] := src[0];
    dest[0] := src[1];
    dest[3] := src[2];
    dest[2] := src[3];
    dest[5] := src[4];
    dest[4] := src[5];
    dest[7] := src[6];
    dest[6] := src[7];
{$ENDIF}
  CopyMemory(dbl, @dt, 8);
end;


(******************************************************************)

Procedure vax2ieee(dbl : Pointer);
var
    dt : double64_t;
    sign : Cardinal;
    exponent : Cardinal;
    rndbits : Cardinal;
    src : PByteArray;
    dest : PByteArray;
Begin

(* -------------------------------------------------------------------- *)
(* 	Arrange the VAX double so that it may be accessed by a 		*)
(*	double64_t structure, (two GUInt32s).				*)
(* -------------------------------------------------------------------- *)
    src :=   dbl;
    dest := @dt;
{$IFDEF CPL_LSB}
    dest[2] := src[0];
    dest[3] := src[1];
    dest[0] := src[2];
    dest[1] := src[3];
    dest[6] := src[4];
    dest[7] := src[5];
    dest[4] := src[6];
    dest[5] := src[7];
{$ELSE}
    dest[1] := src[0];
    dest[0] := src[1];
    dest[3] := src[2];
    dest[2] := src[3];
    dest[5] := src[4];
    dest[4] := src[5];
    dest[7] := src[6];
    dest[6] := src[7];
{$ENDIF}

(* -------------------------------------------------------------------- *)
(*	Save the sign of the double					*)
(* -------------------------------------------------------------------- *)
    sign 	 := dt.hi And $80000000;

(* -------------------------------------------------------------------- *)
(*	Adjust the exponent so that we may work with it			*)
(* -------------------------------------------------------------------- *)
    exponent := dt.hi Shr 23;
    exponent := exponent And $000000ff;

    if (exponent <> 0) Then
        exponent := exponent -129 + 1023;

(* -------------------------------------------------------------------- *)
(*	Save the bits that we are discarding so we can round properly	*)
(* -------------------------------------------------------------------- *)
    rndbits := dt.lo And $00000007;

    dt.lo := dt.lo Shr 3;
    dt.lo := (dt.lo And $1fffffff) Or (dt.hi Shl 29);

    if (rndbits <> 0) Then
        dt.lo := dt.lo Or $00000001;

(* -------------------------------------------------------------------- *)
(*	Shift the hi-order int over 3 and insert the exponent and sign	*)
(* -------------------------------------------------------------------- *)
    dt.hi := dt.hi Shr 3;
    dt.hi := dt.hi And $000fffff;
    dt.hi := dt.hi Or (exponent shl 20) Or sign;



{$IFDEF CPL_LSB}
(* -------------------------------------------------------------------- *)
(*	Change the number to a byte swapped format			*)
(* -------------------------------------------------------------------- *)
    src := @dt;
    dest := dbl;

    dest[0] := src[4];
    dest[1] := src[5];
    dest[2] := src[6];
    dest[3] := src[7];
    dest[4] := src[0];
    dest[5] := src[1];
    dest[6] := src[2];
    dest[7] := src[3];
{$ELSE}
    CopyMemory( dbl, @dt, 8 );
{$ENDIF}
End;

Procedure SWAP(Var A, B : Byte);
Var
  t : Byte;
Begin
  t := A;
  A := B;
  B := t;
End;


Procedure ieee2vax ( d : Pointer );
Type
  _ieee = Record
    Case Integer Of
    0 : (b : Array [0..7] of Byte);
  End;

// VAX format variables.
  _vax = Record
    Case Integer Of
      0 : (b : Array [0..7] Of Byte);
      1 : (w : Array [0..3] Of Word);
  End;

Var
  i : SmallInt;

// IEEE format variables.
			// bits
  sign,		// 0
  expo : Word;		// 1  -  11

  ieee : _ieee;
  vax  : _vax;


Begin

  if( PDouble(d)^ = 0.0) Then 		// both IEEE and VAX zeros have all 8 bytes == 0.
    Exit;

  CopyMemory(@ieee, d, 8);			// "unionize" IEEE format input.

// reverse order of bytes from intel storage method.

  for i := 0 to 3 Do
    SWAP (ieee.b[7-i], ieee.b[i]);

// extract bit patterns.

  sign := Ord((ieee.b[0] And $80) <> 0);
  expo := ((ieee.b[0] And $7f) Shl 4) Or ((ieee.b[1] And $f0) Shr 4);

// fix up first word with sign, exponent and first 7 bits of fraction.

  expo := expo + 128 - 1022;
  vax.w[0] := (expo shl 7) Or ((ieee.b[1] And $0f) shl 3) Or
             (sign shl 15) Or ((ieee.b[2] And $e0) shr 5);

// swap byte order.

  SWAP( vax.b[0], vax.b[1] );

  for i := 2 To  6 Do
    vax.b[i] := ((ieee.b[i] And $1f) Shl 3) Or ((ieee.b[i+1] And $e0) Shr 5);

  vax.b[7] := ((ieee.b[7] And $1f) shl 3);

  i := 0;
  While i < 8 Do Begin
    SWAP( vax.b[i], vax.b[i+1] );
    inc(i, 2);
  End;

  CopyMemory(d, @vax, 8);

End;


{ TEzDGNFile }

constructor TEzDGNFile.Create;
begin
  Inherited;
  FMemoryLoaded:= False;
  FOffsets:= TIntegerList.Create;
  FHeightQuotient := 0.006;
  FScale := 1.0;
  FUseTrueType:= True;
  FillChar( FIncludedLevels, SizeOf( FIncludedLevels ), Ord( True ) );
  FElements:= TEzEntityList.Create;
end;

destructor TEzDGNFile.Destroy;
begin
  If Assigned( FDGNInputStream ) then
    FreeAndNil( FDGNInputStream );
  FOffsets.Free;
  FElements.Free;
  inherited;
end;

Procedure TEzDGNFile.EvaluateDisp_Hdr( Const h: TDisp_Hdr; Var curpen: TEzPenStyle;
  Var curbrush: TEzBrushStyle );
Var
  ColorIndex: Byte;

  Function getColor( index: byte ): TColor;
  Begin
    Result := RGB( FColorTable[index, 0], FColorTable[Index, 1], FColorTable[Index, 2] );
  End;

Begin
  curpen := Ez_Preferences.DefPenStyle.FPenStyle;
  curbrush := Ez_Preferences.DefBrushStyle.FBrushStyle;

  //
  Case h.symb And $7 Of
    0: curpen.style := 1;
    1: curpen.Style := 3;
    2: curpen.Style := 4;
    3: curpen.Style := 6;
    4: curpen.Style := 13;
    5: curpen.Style := 10;
    6: curpen.Style := 19;
    7: curpen.Style := 61;
  End;

  //  curPen.WidthPts := (h.symb and $F8) shr 3;
  //  curpen.Width := (h.symb and $F8) shr 3;
  //  penwidth := trunc((h.symb and $F8) shr 3);
  //  curpen.Widthpts := trunc(FDrawBox.Grapher.PointsToDistY((h.symb and $F8) shr 3));
  //  curpen.Widthpts := trunc((h.symb and $F8) shr 3);
  curpen.scale := ( ( h.symb And $F8 ) Shr 3 ) / 100 - 0.01; //
  If curpen.scale < 0 then curpen.scale:= 0.0;

  ColorIndex := ( h.symb And $FF00 ) Shr 8;
  curPen.Color := getColor( ColorIndex + 1 );
  if curPen.Color = clWhite then
    curPen.Color:= ezsystem.ComplColor(curPen.Color);
End;

procedure TEzDGNFile.Open;
var
  Elm_hdr: TElm_hdr ;
  p: Longint;
  l: Longint;
  b: Byte;
  element_type: Byte;
  element_level: byte;
  element_deleted: Boolean;
  OldCursor: TCursor;
  Extents, CurExtents: TEzRect;
  TmpEntity: TEzEntity;
  _3Dz: Double;
  ele_type, ele_level, PlanOfEle: integer;
  element_str: String;
  I: Integer;
  BadList: TIntegerList;
  temp: Boolean;
  origin_x : double;
  origin_y : double;
  origin_z : double;
begin

  Close;

  If Not FileExists( FFileName ) Then
  Begin
    MessageToUser( Format( SShpFileNotFound, [FFileName] ), smsgerror, MB_ICONERROR );
    Exit;
  End;

  FOffsets.Clear;

  FDGNInputStream := TFileStream.Create( FFileName, fmOpenRead Or fmShareDenyNone );

  FDGNInputStream.Position := 0;

  While FDGNInputStream.Position < FDGNInputStream.Size Do
  begin
    p := FDGNInputStream.Position;

    FDGNInputStream.Read( Elm_hdr, SizeOf( Elm_Hdr ) );
    element_Type := Elm_hdr.TypeDeleted And $7F;
    If element_Type = 9 Then // is TCB
    Begin

      FDGN_TCB.Head := Elm_hdr;

      FDGN_TCB.origin_x := FDGN_TCB.Head.xLow;
      FDGN_TCB.origin_y := FDGN_TCB.Head.yLow;
      FDGN_TCB.origin_z := FDGN_TCB.Head.zLow;

      // Units of resolution per subunit.
      FDGNInputStream.Position := 1112;

      FDGNInputStream.Read( l, SizeOf( l ) );
      FDGN_TCB.uor_per_subunit := LSwap( l );

      // Subunits per master unit.
      FDGNInputStream.Read( l, SizeOf( l ) );
      FDGN_TCB.sub_per_master := LSwap( l );

      // Name of subunits
      FDGNInputStream.Read( FDGN_TCB.sub_units, SizeOf( FDGN_TCB.sub_units ) - 1 );
      FDGN_TCB.sub_units[2] := #0;

      // Name of master units
      FDGNInputStream.Read( FDGN_TCB.master_units, SizeOf( FDGN_TCB.master_units ) - 1 );
      FDGN_TCB.master_units[2] := #0;

      FDGNInputStream.Position := 1214;
      FDGNInputStream.Read( b, SizeOf( b ) );

      If ( ( b And $40 ) = $40 ) Then
      Begin
        FDGN_TCB.Dimension := 3;
        //MessageToUser( 'This DGN File is 3-Dimension !!', SMsgWarning, MB_ICONWARNING );
      End
      Else
        FDGN_TCB.Dimension := 2;

      FScale := 1.0 / ( FDGN_TCB.uor_per_subunit * FDGN_TCB.sub_per_master );
      If AnsiCompareText( FDGN_TCB.sub_units , 'M') = 0  Then
      Else If AnsiCompareText( FDGN_TCB.sub_units, 'FT' ) = 0 Then
        FScale := FScale * 0.3048
      Else If AnsiCompareText( FDGN_TCB.sub_units, '''' ) = 0 Then
        FScale := FScale * 0.0254;

      FDGNInputStream.Position := 1240;
      FDGNInputStream.Read( origin_x, sizeof(double) );
      FDGNInputStream.Read( origin_y, sizeof(double) );
      FDGNInputStream.Read( origin_z, sizeof(double) );
      vax2ieee( @origin_x );
      vax2ieee( @origin_y );
      vax2ieee( @origin_z );

      Break;  // no more search

    End;

    FDGNInputStream.Position := p + ( ( Elm_Hdr.Words + 2 ) * SizeOf( Word ) );

  End;

  // Get Color Table
  FDGNInputStream.Position := 0;

  { read color table }
  FColorTable := DefColorTable;
  If Not FUseDefaultColorTable Then
  Begin
    While FDGNInputStream.Position < FDGNInputStream.Size Do
    Begin
      p := FDGNInputStream.Position;
      FDGNInputStream.Read( Elm_hdr, SizeOf( Elm_Hdr ) );
      element_Type := Elm_hdr.TypeDeleted And $7F;
      element_level := Elm_Hdr.LevelCmplx AND $3F;

      If ( element_Type = 5 ) And ( element_level = 1 ) Then
      Begin {Group data elements}
        FDGNInputStream.Position := FDGNInputStream.Position + SizeOf( TDisp_Hdr ) + 2;
        FDGNInputStream.Read( FColorTable, SizeOf( FColorTable ) );

⌨️ 快捷键说明

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