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

📄 ezdims.pas

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

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

{$I EZ_FLAG.PAS}
Interface

Uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, ExtCtrls, Dialogs,
  Forms, EzBase, EzBaseGIS, EzLib, EzCmdLine, EzEntities, EzSystem;

Type

  { TEzDimHorizontal }

  TEzDimHorizontal = Class( TEzEntity )
  Private
    FPenTool: TEzPenTool;
    { Points has a fixed number of elements with the following meaning :
      Points[0] = BaseLineFrom
      Points[1] = BaseLineTo
      Points[2] = TextBasePoint
      Points[3] = TextLineY only Y abscisa is used
    }
    FFontName: String;
    FTextHeight: Double;
    FNumDecimals: Integer;
    { the list of entities (all are calculated from basic info), where:
      0 = the text line
      1 = line from the center of the text line to the text entity
      2 = the left arrow
      3 = the right arrow
      4 = the left line
      5 = the right line
      6 = the text entity
    }
    FEntities: TList;
    Function IsTextOnLine: Boolean;
    Procedure ClearEntities;
    Procedure SetNumDecimals( Value: Integer );
    Procedure SetTextHeight( Const Value: Double );
    Procedure SetTextLineY( Const Value: Double );
    Function GetBaseLineFrom: TEzPoint;
    Function GetBaseLineTo: TEzPoint;
    Function GetTextBasePoint: TEzPoint;
    Function GetTextLineY: Double;
    Procedure SetBaseLineFrom( Const Value: TEzPoint );
    Procedure SetBaseLineTo( Const Value: TEzPoint );
    Procedure SetFontName( Const Value: String );
    Procedure SetTextBasePoint( Const Value: TEzPoint );
  {$IFDEF BCB}
    function GetFontName: String;
    function GetNumDecimals: Integer;
    function GetTextHeight: Double;
  {$ENDIF}
  Protected
    Function GetEntityID: TEzEntityID; Override;
    Function BasicInfoAsString: string; Override;
    Function AttribsAsString: string; Override;
  Public
    Constructor CreateEntity( Const BaseLineFrom, BaseLineTo: TEzPoint;
      Const TextLineY: Double );
    Destructor Destroy; Override;
    procedure Initialize; Override;
    Procedure LoadFromStream( Stream: TStream ); Override;
    Procedure SaveToStream( Stream: TStream ); Override;
    Procedure UpdateExtension; Override;
    Function StorageSize: Integer; Override;
    Procedure Draw( Grapher: TEzGrapher; Canvas: TCanvas; Const Clip: TEzRect;
      DrawMode: TEzDrawMode; Data: Pointer = Nil ); Override;
    Procedure UpdateControlPoint( Index: Integer; Const Value: TEzPoint; Grapher: TEzGrapher=Nil); Override;
    Function PointCode( Const Pt: TEzPoint; Const Aperture: Double;
      Var Distance: Double; SelectPickingInside: Boolean; UseDrawPoints: Boolean=True ): Integer; Override;
    Procedure Calculate;
    Function GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector; Override;
    Function IsEqualTo( Entity: TEzEntity; IncludeAttribs: Boolean  = False ): Boolean; Override;

    Property TextLineY: Double Read GetTextLineY Write SetTextLineY;
    Property TextHeight: Double  {$IFDEF BCB} Read GetTextHeight  {$ELSE} Read FTextHeight {$ENDIF} Write SetTextHeight;
    Property NumDecimals: Integer  {$IFDEF BCB} Read GetNumDecimals   {$ELSE} Read FNumDecimals {$ENDIF} Write SetNumDecimals;
    Property FontName: String  {$IFDEF BCB} Read GetFontName   {$ELSE} Read FFontName {$ENDIF} Write SetFontName;
    Property BaseLineFrom: TEzPoint Read GetBaseLineFrom Write SetBaseLineFrom;
    Property BaseLineTo: TEzPoint Read GetBaseLineTo Write SetBaseLineTo;
    Property TextBasePoint: TEzPoint Read GetTextBasePoint Write SetTextBasePoint;
    Property PenTool: TEzPenTool  {$IFDEF BCB} Read GetPenTool  {$ELSE} Read FPenTool {$ENDIF};
  End;

  { TEzDimVertical }

  TEzDimVertical = Class( TEzEntity )
  Private
    FPenTool: TEzPenTool;
    { Points has a fixed number of elements with the following meaning :
      Points[0] = BaseLineFrom
      Points[1] = BaseLineTo
      Points[2] = TextBasePoint
      Points[3] = TextLineX only X abscisa is used
    }
    FFontName: String;
    FTextHeight: Double;
    FNumDecimals: Integer;
    { the list of entities (all are calculated from basic info), where:
      0 = the text line
      1 = line from the center of the text line to the text entity
      2 = the left arrow
      3 = the right arrow
      4 = the left line
      5 = the right line
      6 = the text entity
    }
    FEntities: TList;
    Function IsTextOnLine( Const TextWidth: Double ): Boolean;
    Procedure ClearEntities;
    Procedure SetNumDecimals( Value: Integer );
    Procedure SetTextHeight( Const Value: Double );
    Procedure SetTextLineX( Const Value: Double );
    Function GetBaseLineFrom: TEzPoint;
    Function GetBaseLineTo: TEzPoint;
    Function GetTextBasePoint: TEzPoint;
    Function GetTextLineX: Double;
    Procedure SetBaseLineFrom( Const Value: TEzPoint );
    Procedure SetBaseLineTo( Const Value: TEzPoint );
    Procedure SetFontName( Const Value: String );
    Procedure SetTextBasePoint( Const Value: TEzPoint );
  {$IFDEF BCB}
    function GetFontName: String;
    function GetNumDecimals: Integer;
    function GetTextHeight: Double;
  {$ENDIF}
  Protected
    Function GetEntityID: TEzEntityID; Override;
    Function BasicInfoAsString: string; Override;
    Function AttribsAsString: string; Override;
  Public
    Constructor CreateEntity( Const BaseLineFrom, BaseLineTo: TEzPoint;
      Const TextLineX: Double );
    Destructor Destroy; Override;
    procedure Initialize; Override;
    Procedure LoadFromStream( Stream: TStream ); Override;
    Procedure SaveToStream( Stream: TStream ); Override;
    Procedure UpdateExtension; Override;
    Function StorageSize: Integer; Override;
    Procedure Draw( Grapher: TEzGrapher; Canvas: TCanvas; Const Clip: TEzRect;
      DrawMode: TEzDrawMode; Data: Pointer = Nil ); Override;
    Procedure UpdateControlPoint( Index: Integer; Const Value: TEzPoint; Grapher: TEzGrapher=Nil); Override;
    Function PointCode( Const Pt: TEzPoint; Const Aperture: Double;
      Var Distance: Double; SelectPickingInside: Boolean; UseDrawPoints: Boolean=True ): Integer; Override;
    Procedure Calculate;
    Function GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector; Override;
    Function IsEqualTo( Entity: TEzEntity; IncludeAttribs: Boolean  = False ): Boolean; Override;

    Property TextLineX: Double Read GetTextLineX Write SetTextLineX;
    Property TextHeight: Double {$IFDEF BCB} Read GetTextHeight {$ELSE} Read FTextHeight {$ENDIF} Write SetTextHeight;
    Property NumDecimals: Integer {$IFDEF BCB} Read GetNumDecimals {$ELSE} Read FNumDecimals {$ENDIF} Write SetNumDecimals;
    Property FontName: String {$IFDEF BCB} Read GetFontName {$ELSE} Read FFontName {$ENDIF} Write SetFontName;
    Property BaseLineFrom: TEzPoint Read GetBaseLineFrom Write SetBaseLineFrom;
    Property BaseLineTo: TEzPoint Read GetBaseLineTo Write SetBaseLineTo;
    Property TextBasePoint: TEzPoint Read GetTextBasePoint Write SetTextBasePoint;
    Property PenTool: TEzPenTool  {$IFDEF BCB} Read GetPenTool  {$ELSE} Read FPenTool {$ENDIF};

  End;

  { TEzDimParallel }
  TEzDimParallel = Class( TEzEntity )
  Private
    FPenTool: TEzPenTool;
    { Points has a fixed number of elements with the following meaning :
      Points[0] = BaseLineFrom
      Points[1] = BaseLineTo
      Points[2] = TextBasePoint
    }
    FTextLineDistanceApart: Double;
    FFontName: String;
    FTextHeight: Double;
    FNumDecimals: Integer;
    { the list of entities (all are calculated from basic info), where:
      0 = the text line
      1 = line from the center of the text line to the text entity
      2 = the left arrow
      3 = the right arrow
      4 = the left line
      5 = the right line
      6 = the text entity
    }
    FEntities: TList;
    Function IsTextOnLine: Boolean;
    Procedure ClearEntities;
    Procedure SetNumDecimals( Value: Integer );
    Procedure SetTextHeight( Const Value: Double );
    Procedure SetTextLineDistanceApart( Const Value: Double );
    Function GetBaseLineFrom: TEzPoint;
    Function GetBaseLineTo: TEzPoint;
    Function GetTextBasePoint: TEzPoint;
    Procedure SetBaseLineFrom( Const Value: TEzPoint );
    Procedure SetBaseLineTo( Const Value: TEzPoint );
    Procedure SetFontName( Const Value: String );
    Procedure SetTextBasePoint( Const Value: TEzPoint );
{$IFDEF BCB}
    function GetFontName: String;
    function GetNumDecimals: Integer;
    function GetTextHeight: Double;
    function GetTextLineDistanceApart: Double;
{$ENDIF}
  Protected
    Function GetEntityID: TEzEntityID; Override;
    Function BasicInfoAsString: string; Override;
    Function AttribsAsString: string; Override;
  Public
    Constructor CreateEntity( Const BaseLineFrom, BaseLineTo: TEzPoint;
      Const TextLineDistanceApart: Double );
    Destructor Destroy; Override;
    procedure Initialize; Override;
    Procedure LoadFromStream( Stream: TStream ); Override;
    Procedure SaveToStream( Stream: TStream ); Override;
    Procedure UpdateExtension; Override;
    Function StorageSize: Integer; Override;
    Procedure Draw( Grapher: TEzGrapher; Canvas: TCanvas;
      Const Clip: TEzRect; DrawMode: TEzDrawMode; Data: Pointer = Nil ); Override;
    Procedure UpdateControlPoint( Index: Integer; Const Value: TEzPoint; Grapher: TEzGrapher=Nil); Override;
    Function PointCode( Const Pt: TEzPoint;  Const Aperture: Double;
      Var Distance: Double; SelectPickingInside: Boolean; UseDrawPoints: Boolean=True ): Integer; Override;
    Procedure Calculate;
    Function GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector; Override;
    Function IsEqualTo( Entity: TEzEntity; IncludeAttribs: Boolean = False  ): Boolean; Override;

    Property TextLineDistanceApart: Double  {$IFDEF BCB} Read GetTextLineDistanceApart {$ELSE} Read FTextLineDistanceApart {$ENDIF} Write SetTextLineDistanceApart;
    Property TextHeight: Double  {$IFDEF BCB} Read GetTextHeight  {$ELSE} Read FTextHeight {$ENDIF} Write SetTextHeight;
    Property NumDecimals: Integer  {$IFDEF BCB} Read GetNumDecimals {$ELSE} Read FNumDecimals {$ENDIF} Write SetNumDecimals;
    Property FontName: String  {$IFDEF BCB} Read GetFontName {$ELSE} Read FFontName {$ENDIF} Write SetFontName;
    Property BaseLineFrom: TEzPoint Read GetBaseLineFrom Write SetBaseLineFrom;
    Property BaseLineTo: TEzPoint Read GetBaseLineTo Write SetBaseLineTo;
    Property TextBasePoint: TEzPoint Read GetTextBasePoint Write SetTextBasePoint;
    Property PenTool: TEzPenTool  {$IFDEF BCB} Read GetPenTool  {$ELSE} Read FPenTool {$ENDIF};

  End;

Implementation

Uses
  EzPolyClip, EzBaseExpr, ezConsts, EzRtree;

{ TEzDimHorizontal }

Constructor TEzDimHorizontal.CreateEntity( Const BaseLineFrom, BaseLineTo: TEzPoint;
  Const TextLineY: Double );
Begin
  Inherited Create( 4 );
  FPoints.DisableEvents := true;
  FPoints.Add( BaseLineFrom );
  FPoints.Add( BaseLineTo );
  { when text base point is (MAXCOORD,MAXCOORD) then it must be recalculated }
  FPoints.Add( Point2d( MAXCOORD, MAXCOORD ) );
  FPoints.Add( Point2d( 0, TextLineY ) );
  FPoints.DisableEvents := false;
  FPoints.CanGrow:= False;

  UpdateExtension;
End;

Destructor TEzDimHorizontal.Destroy;
Begin
  FPenTool.Free;
  If FEntities <> Nil Then
  Begin
    ClearEntities;
    FEntities.Free;
  End;
  Inherited Destroy;
End;

procedure TEzDimHorizontal.Initialize;
begin
  FEntities := TList.Create;
  FPenTool := TEzPenTool.Create;
  With Ez_Preferences Do
  Begin
    FFontName := DefFontStyle.Name;
    FTextHeight := DefFontStyle.Height;
    FNumDecimals := NumDecimals;
    FPenTool.Assign( DefPenStyle );
  End;
  FPenTool.Style := 1;
end;

Function TEzDimHorizontal.BasicInfoAsString: string;
Begin
  Result:= Format(sDimHorizInfo, [BaseLineFrom.X,BaseLineFrom.Y,
    BaseLineTo.X,BaseLineTo.Y,TextLineY]);
End;

Function TEzDimHorizontal.AttribsAsString: string;
Begin
  Result:= Format( sPenInfo, [Pentool.Style, Pentool.Color, Pentool.Width]) + CrLf +
    Format(sVectorFontInfo, [FontName]);
End;

Procedure TEzDimHorizontal.ClearEntities;
Var
  I: Integer;
Begin
  If FEntities = Nil Then
    exit;
  For I := 0 To FEntities.Count - 1 Do
    TEzEntity( FEntities[I] ).Free;
  FEntities.Clear;
End;

Function TEzDimHorizontal.IsTextOnLine: Boolean;
Var
  temp: Double;
Begin
  If EqualPoint2d( TextBasePoint, Point2d( MAXCOORD, MAXCOORD ) ) Then
  Begin
    Result := true;
    exit;
  End;
  temp := Points[2].Y - FTextHeight / 2;
  Result := ( temp >= Points[3].Y ) And ( temp <= ( Points[3].Y + 1.25 * FTextHeight ) );
End;

Procedure TEzDimHorizontal.Calculate;
Var
  FromPt, ToPt: TEzPoint;
  TextCoordY: Double;
  TextBasePoint: TEzPoint;
  ArrowHeight, ArrowLength, Delta: Double;
  ArrowPt, MidPoint, p: TEzPoint;
  TmpHeight: Double;
  OuterArrows: Boolean;
  BaseLine: Array[0..1] Of TEzPoint;
  TmpEnt: TEzEntity;
  TextEnt: TEzEntity;
  TextLine: TEzEntity;
  LeftLine: TEzEntity;
  LeftArrow: TEzEntity;
  RightLine: TEzEntity;
  RightArrow: TEzEntity;
  TextLine2Text: TEzEntity;
  IntersVect, Vect1, Vect2: TEzVector;
Begin
  If FEntities = Nil Then
    FEntities := TList.Create;
  If FPenTool = Nil Then
    FPenTool := TEzPenTool.Create;
  p := NULL_POINT;
  If Points.Count = 0 Then
  Begin
    Points.Add( p );
    Points.Add( p );
    Points.Add( p );
    Points.Add( p );
  End;
  If FEntities.Count = 0 Then
  Begin
    // text line
    TmpEnt := TEzPolyLine.CreateEntity( [p, p] );
    TEzPolyLine( TmpEnt ).PenTool.Assign( FPenTool );
    FEntities.Add( TmpEnt );
    // line from center of text line to text entity
    TmpEnt := TEzPolyLine.CreateEntity( [p, p] );
    TEzPolyLine( TmpEnt ).PenTool.Assign( FPenTool );
    FEntities.Add( TmpEnt );
    // left arrow
    TmpEnt := TEzPolygon.CreateEntity( [p, p, p, p] );
    With TEzPolygon( TmpEnt ) Do
    Begin
      PenTool.Assign( Self.FPenTool );
      BrushTool.Pattern := 1;
      BrushTool.ForeColor := FPenTool.Color;
    End;
    FEntities.Add( TmpEnt );
    // right arrow
    TmpEnt := TEzPolygon.CreateEntity( [p, p, p, p] );
    With TEzPolygon( TmpEnt ) Do
    Begin
      PenTool.Assign( Self.FPenTool );
      BrushTool.Pattern := 1;
      BrushTool.ForeColor := FPenTool.Color;
    End;
    FEntities.Add( TmpEnt );
    // left line
    TmpEnt := TEzPolyLine.CreateEntity( [p, p] );
    TEzPolyLine( TmpEnt ).PenTool.Assign( Self.FPenTool );
    FEntities.Add( TmpEnt );
    // right line
    TmpEnt := TEzPolyLine.CreateEntity( [p, p] );
    TEzPolyLine( TmpEnt ).PenTool.Assign( Self.FPenTool );
    FEntities.Add( TmpEnt );
    // text entity
    TmpEnt := TEzFittedVectorText.CreateEntity( NULL_POINT, '', 1, -1, 0 );
    TEzFittedVectorText( TmpEnt ).FontName := self.FFontName;

⌨️ 快捷键说明

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