ezdxfutil.pas

很管用的GIS控件

  result.val[1, 1] := Ay.y;
  result.val[2, 1] := Az.y;
  result.val[0, 2] := Ax.z;
  result.val[1, 2] := Ay.z;
  result.val[2, 2] := Az.z;
End;

Function TransformPoint( TM: Matrix; p: Point3D ): Point3D;
Begin
  With TM Do
  Begin
    result.x := p.x * val[0, 0] + p.y * val[1, 0] + p.z * val[2, 0] + val[3, 0];
    result.y := p.x * val[0, 1] + p.y * val[1, 1] + p.z * val[2, 1] + val[3, 1];
    result.z := p.x * val[0, 2] + p.y * val[1, 2] + p.z * val[2, 2] + val[3, 2];
  End;
End;

Function RotationAxis( const A: Point3D; angle: Double ): Matrix;
Var
  sin_a, cos_a: Double;
Begin
  result := Identity;
  sin_a := sin( angle );
  cos_a := cos( angle );
  result.val[0][0] := ( A.x * A.x + ( 1. - A.x * A.x ) * cos_a );
  result.val[1][0] := ( A.x * A.y * ( 1. - cos_a ) + A.z * sin_a );
  result.val[2][0] := ( A.x * A.z * ( 1. - cos_a ) - A.y * sin_a );

  result.val[0][1] := ( A.x * A.y * ( 1. - cos_a ) - A.z * sin_a );
  result.val[1][1] := ( A.y * A.y + ( 1. - A.y * A.y ) * cos_a );
  result.val[2][1] := ( A.y * A.z * ( 1. - cos_a ) + A.x * sin_a );

  result.val[0][2] := ( A.x * A.z * ( 1. - cos_a ) + A.y * sin_a );
  result.val[1][2] := ( A.y * A.z * ( 1. - cos_a ) - A.x * sin_a );
  result.val[2][2] := ( A.z * A.z + ( 1. - A.z * A.z ) * cos_a );
End;
///////////////////////////////////////////////////////////////////////////////
// Bounds
///////////////////////////////////////////////////////////////////////////////

Procedure max_bound( Var bounds: Point3D; point: Point3D );
Begin
  Try
    If point.x > bounds.x Then
      bounds.x := point.x;
  Except
    bounds.x := bounds.x;
  End;
  Try
    If point.y > bounds.y Then
      bounds.y := point.y;
  Except
    bounds.y := bounds.y;
  End;
  Try
    If point.z > bounds.z Then
      bounds.z := point.z;
  Except
    bounds.z := bounds.z;
  End;
End;

Procedure min_bound( Var bounds: Point3D; point: Point3D );
Begin
  Try
    If point.x < bounds.x Then
      bounds.x := point.x;
  Except
    bounds.x := bounds.x;
  End;
  Try
    If point.y < bounds.y Then
      bounds.y := point.y;
  Except
    bounds.y := bounds.y;
  End;
  Try
    If point.z < bounds.z Then
      bounds.z := point.z;
  Except
    bounds.z := bounds.z;
  End;
End;

///////////////////////////////////////////////////////////////////////////////
// Memory
///////////////////////////////////////////////////////////////////////////////

Function allocate_points( n: integer ): ppointlist;
Begin
  Getmem( result, n * SizeOf( Point3D ) );
End;

Procedure deallocate_points( Var pts: ppointlist; n: integer );
Begin
  Freemem( pts, n * SizeOf( Point3D ) );
  pts := Nil;
End;

Function allocate_matrix: pMatrix;
Begin
  Getmem( result, SizeOf( Matrix ) );
End;

Procedure deallocate_matrix( Var m: pMatrix );
Begin
  Freemem( m, SizeOf( Matrix ) );
  m := Nil;
End;
///////////////////////////////////////////////////////////////////////////////
// String
///////////////////////////////////////////////////////////////////////////////

Function float_out( f: Double ): String;
Begin
  result := FloatToStrF( f, ffFixed, 7, 3 );
  //result := FloatToStr(f);
End;

Function BoolToStr( b: boolean ): String;
Begin
  If b Then
    result := 'TRUE'
  Else
    result := 'FALSE';
End;

Function NPoint2D( X, Y: Double ): Point2D;
Begin
  NPoint2D.X := X;
  NPoint2D.Y := Y;
End;

Function NPoint3D( X, Y, Z: Double ): Point3D;
Begin
  NPoint3D.X := X;
  NPoint3D.Y := Y;
  NPoint3D.Z := Z;
End;

Function RoundPoint( P: Point2D ): TPoint;
Begin
  RoundPoint.X := Round( P.X );
  RoundPoint.Y := Round( P.Y );
End;

Function FloatPoint( P: TPoint ): Point2D;
Begin
  FloatPoint.X := P.X;
  FloatPoint.Y := P.Y;
End;

Function Angle2D( P: Point2D ): Double;
Begin
  Result := 0;
  If P.X = 0 Then
  Begin
    If P.Y > 0 Then
      Result := Pi / 2;
    If P.Y = 0 Then
      Result := 0;
    If P.Y < 0 Then
      Result := Pi / -2;
  End
  Else
    Result := Arctan( P.Y / P.X );

  If P.X < 0 Then
  Begin
    If P.Y < 0 Then
      Result := Result + Pi;
    If P.Y >= 0 Then
      Result := Result - Pi;
  End;

  If Result < 0 Then
    Result := Result + 2 * Pi;
End;

Function NDist2D( P: Point2D ): Double;
Begin
  Result := Sqrt( P.X * P.X + P.Y * P.Y );
End;

Function NDist3D( P: Point3D ): Double;
Begin
  Result := Sqrt( P.X * P.X + P.Y * P.Y + P.Z * P.Z );
End;

Function RelAngle2D( PA, PB: Point2D ): Double;
Begin
  RelAngle2D := Angle2D( NPoint2D( PB.X - PA.X, PB.Y - PA.Y ) );
End;

Function RelDist2D( PA, PB: Point2D ): Double;
Begin
  Result := NDist2D( NPoint2D( PB.X - PA.X, PB.Y - PA.Y ) );
End;

Function RelDist3D( PA, PB: Point3D ): Double;
Begin
  RelDist3D := NDist3D( NPoint3D( PB.X - PA.X, PB.Y - PA.Y, PB.Z - PA.Z ) );
End;

Procedure Rotate2D( Var P: Point2D; Angle2D: Double );
Var
  Temp: Point2D;
Begin
  Temp.X := P.X * Cos( Angle2D ) - P.Y * Sin( Angle2D );
  Temp.Y := P.X * Sin( Angle2D ) + P.Y * Cos( Angle2D );
  P := Temp;
End;

Function AddPoints( P1, P2: Point2D ): Point2D;
Begin
  Result := NPoint2D( P1.X + P2.X, P1.Y + P2.Y );
End;

Function SubPoints( P1, P2: Point2D ): Point2D;
Begin
  Result := NPoint2D( P1.X - P2.X, P1.Y - P2.Y );
End;

Procedure RelRotate2D( Var P: Point2D; PCentr: Point2D; Angle2D: Double );
Var
  Temp: Point2D;
Begin
  Temp := SubPoints( P, PCentr );
  Rotate2D( Temp, Angle2D );
  P := AddPoints( Temp, PCentr );
End;

Procedure Move2D( Var P: Point2D; Angle2D, Distance: Double );
Var
  Temp: Point2D;
Begin
  Temp.X := P.X + ( Cos( Angle2D ) * Distance );
  Temp.Y := P.Y + ( Sin( Angle2D ) * Distance );
  P := Temp;
End;

Function Between( PA, PB: Point2D; Preference: Double ): Point2D;
Begin
  Between.X := PA.X * Preference + PB.X * ( 1 - Preference );
  Between.Y := PA.Y * Preference + PB.Y * ( 1 - Preference );
End;

Function DistLine( A, B, C: Double; P: Point2D ): Double;
Begin
  Result := ( A * P.X + B * P.Y + C ) / Sqrt( Sqr( A ) + Sqr( B ) );
End;

Function Dist2P( P, P1, P2: Point2D ): Double;
Begin
  Result := DistLine( P1.Y - P2.Y, P2.X - P1.X, -P1.Y * P2.X + P1.X * P2.Y, P );
End;

Function DistD1P( DX, DY: Double; P1, P: Point2D ): Double;
Begin
  Result := DistLine( DY, -DX, -DY * P1.X + DX * P1.Y, P );
End;

Function NearLine2P( P, P1, P2: Point2D; D: Double ): Boolean;
Begin
  Result := False;
  If DistD1P( -( P2.Y - P1.Y ), P2.X - P1.X, P1, P ) * DistD1P( -( P2.Y - P1.Y ), P2.X - P1.X, P2, P ) <= 0 Then
    If Abs( Dist2P( P, P1, P2 ) ) < D Then
      Result := True;
End;

Function Invert( Col: TColor ): TColor;
Begin
  Result := Not Col;
End;

Function Dark( Col: TColor; Percentage: Byte ): TColor;
Var
  R, G, B: Byte;
Begin
  R := GetRValue( Col );
  G := GetGValue( Col );
  B := GetBValue( Col );
  R := Round( R * Percentage / 100 );
  G := Round( G * Percentage / 100 );
  B := Round( B * Percentage / 100 );
  Dark := RGB( R, G, B );
End;

Function Light( Col: TColor; Percentage: Byte ): TColor;
Var
  R, G, B: Byte;
Begin
  R := GetRValue( Col );
  G := GetGValue( Col );
  B := GetBValue( Col );
  R := Round( R * Percentage / 100 ) + Round( 255 - Percentage / 100 * 255 );
  G := Round( G * Percentage / 100 ) + Round( 255 - Percentage / 100 * 255 );
  B := Round( B * Percentage / 100 ) + Round( 255 - Percentage / 100 * 255 );
  Light := RGB( R, G, B );
End;

Function Mix( Col1, Col2: TColor; Percentage: Byte ): TColor;
Var
  R, G, B: Byte;
Begin
  R := Round( ( GetRValue( Col1 ) * Percentage / 100 ) + ( GetRValue( Col2 ) * ( 100 - Percentage ) / 100 ) );
  G := Round( ( GetGValue( Col1 ) * Percentage / 100 ) + ( GetGValue( Col2 ) * ( 100 - Percentage ) / 100 ) );
  B := Round( ( GetBValue( Col1 ) * Percentage / 100 ) + ( GetBValue( Col2 ) * ( 100 - Percentage ) / 100 ) );
  Mix := RGB( R, G, B );
End;

Function MMix( Cols: Array Of TColor ): TColor;
Var
  I, R, G, B, Length: Integer;
Begin
  Length := High( Cols ) - Low( Cols ) + 1;
  R := 0;
  G := 0;
  B := 0;
  For I := Low( Cols ) To High( Cols ) Do
  Begin
    R := R + GetRValue( Cols[I] );
    G := G + GetGValue( Cols[I] );
    B := B + GetBValue( Cols[I] );
  End;
  R := R Div Length;
  G := G Div Length;
  B := B Div Length;
  MMix := RGB( R, G, B );
End;

Function Log( Base, Value: Double ): Double;
Begin
  Log := Ln( Value ) / Ln( Base );
End;

Function Power( Base, Exponent: Double ): Double;
Begin
  Power := Ln( Base ) * Exp( Exponent );
End;

Function Modulator( Val, Max: Double ): Double;
Begin
  Modulator := ( Val / Max - Round( Val / Max ) ) * Max;
End;

Function M( I, J: Integer ): Integer;
Begin
  M := ( ( I Mod J ) + J ) Mod J;
End;

Function Tan( Angle2D: Double ): Double;
Begin
  Tan := Sin( Angle2D ) / Cos( Angle2D );
End;

Procedure Limit( Var Value: Integer; Min, Max: Integer );
Begin
  If Value < Min Then
    Value := Min;
  If Value > Max Then
    Value := Max;
End;

Function Exp2( Exponent: Byte ): Word;
Var
  Temp, I: Word;
Begin
  Temp := 1;
  For I := 1 To Exponent Do
    Temp := Temp * 2;
  Result := Temp;
End;

End.