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

📄 ezdims.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    TEzFittedVectorText( TmpEnt ).FontColor := FPenTool.Color;
    FEntities.Add( TmpEnt );
  End;

  FromPt := Points[0];
  ToPt := Points[1];
  TextBasePoint := Points[2];
  TextCoordY := Points[3].Y;

  If EqualPoint2d( FromPt, ToPt ) Then
    Exit;

  If FromPt.X < ToPt.X Then
  Begin
    BaseLine[0] := FromPt;
    BaseLine[1] := ToPt;
  End
  Else
  Begin
    BaseLine[0] := ToPt;
    BaseLine[1] := FromPt;
  End;

  TextLine := FEntities[0];
  TextLine2Text := FEntities[1];
  LeftArrow := FEntities[2];
  RightArrow := FEntities[3];
  LeftLine := FEntities[4];
  RightLine := FEntities[5];
  TextEnt := FEntities[6];

  // the text line
  TextLine.Points[0] := Point2d( BaseLine[0].X, TextCoordY );
  TextLine.Points[1] := Point2d( BaseLine[1].X, TextCoordY );

  // the text
  With TEzFittedVectorText( TextEnt ) Do
  Begin
    BeginUpdate;
    Text := Format( '%.*n', [FNumDecimals, Abs( Baseline[1].X - BaseLine[0].X )] );
    Height := FTextHeight;
    Width := -1; // force to calculate the text width
    MidPoint := Point2d( ( Baseline[0].X + BaseLine[1].X ) / 2, TextCoordY );
    If EqualPoint2d( TextBasePoint, Point2d( MAXCOORD, MAXCOORD ) ) Then
    Begin
      BasePoint := Point2d( MidPoint.X - Width / 2, MidPoint.Y + Height * ( 1.25 ) );
      Self.Points.DisableEvents := true;
      Self.Points[2] := BasePoint;
      Self.Points.DisableEvents := false;
    End
    Else
      BasePoint := TextBasePoint;
    EndUpdate;
    TextLine2Text.Points[0] := MidPoint;
    If Self.IsTextOnLine Then
    Begin
      BasePoint := Point2d( BasePoint.X, TextCoordY + 1.25 * FTextHeight );
      TextLine2Text.Points[1] := Point2d( ( Points[0].X + Points[3].X ) / 2, TextCoordY );
    End
    Else
    Begin
      IntersVect := TEzVector.Create( 2 );
      Vect1 := TEzVector.Create( Points.Count );
      Vect2 := TEzVector.Create( 2 );
      Try
        Vect1.Assign( Points );
        Delta := FTextHeight * 0.20;
        Vect1[0] := Point2d( Vect1[0].X - Delta, Vect1[0].Y + Delta );
        Vect1[1] := Point2d( Vect1[1].X - Delta, Vect1[1].Y - Delta );
        Vect1[2] := Point2d( Vect1[2].X + Delta, Vect1[2].Y - Delta );
        Vect1[3] := Point2d( Vect1[3].X + Delta, Vect1[3].Y + Delta );
        Vect1[4] := Vect1[0];
        Vect2.Add( MidPoint );
        Vect2.Add( Point2d( ( Points[0].X + Points[3].X ) / 2, ( Points[0].Y + Points[1].Y ) / 2 ) );
        If EzLib.VectIntersect( Vect1, Vect2, IntersVect, true ) Then
        Begin
          TextLine2Text.Points[1] := IntersVect[0];
        End;
      Finally
        IntersVect.Free;
        Vect1.Free;
        Vect2.Free;
      End;
    End;
  End;

  { fix the text line if not enough distance }
  ArrowHeight := FTextHeight / 2;
  ArrowLength := FTextHeight;
  OuterArrows := false;
  If Abs( Baseline[1].X - BaseLine[0].X ) <= ( TEzFittedVectorText( TextEnt ).Width + ArrowLength * 2 ) Then
  Begin
    OuterArrows := true;
    TextLine.Points[0] := Point2d( TextLine.Points[0].X - ArrowLength * 2, TextLine.Points[0].Y );
    TextLine.Points[1] := Point2d( TextLine.Points[1].X + ArrowLength * 2, TextLine.Points[1].Y );
  End;

  // left line
  If Abs( BaseLine[0].Y - TextCoordY ) < FTextHeight Then
  Begin
    LeftLine.Points[0] := Point2d( BaseLine[0].X, TextCoordY + FTextHeight / 2 );
    LeftLine.Points[1] := Point2d( BaseLine[0].X, TextCoordY - FTextHeight / 2 );
  End
  Else
  Begin
    If TextCoordY > BaseLine[0].Y Then
      TmpHeight := FTextHeight / 2
    Else
      TmpHeight := -FTextHeight / 2;
    LeftLine.Points[0] := BaseLine[0];
    LeftLine.Points[1] := Point2d( BaseLine[0].X, TextCoordY + TmpHeight );
    If Abs( BaseLine[0].Y - TextCoordY ) < FTextHeight Then
    Begin
      LeftLine.Points[0] := Point2d( BaseLine[0].X, BaseLine[0].Y - TmpHeight );
      LeftLine.Points[1] := Point2d( BaseLine[0].X, BaseLine[0].Y + TmpHeight );
    End;
  End;

  // right line
  If Abs( BaseLine[1].Y - TextCoordY ) < FTextHeight Then
  Begin
    RightLine.Points[0] := Point2d( BaseLine[1].X, TextCoordY + FTextHeight / 2 );
    RightLine.Points[1] := Point2d( BaseLine[1].X, TextCoordY - FTextHeight / 2 );
  End
  Else
  Begin
    If TextCoordY > BaseLine[1].Y Then
      TmpHeight := FTextHeight / 2
    Else
      TmpHeight := -FTextHeight / 2;
    RightLine.Points[0] := BaseLine[1];
    RightLine.Points[1] := Point2d( BaseLine[1].X, TextCoordY + TmpHeight );
    If Abs( BaseLine[1].Y - TextCoordY ) < FTextHeight Then
    Begin
      RightLine.Points[0] := Point2d( BaseLine[1].X, BaseLine[1].Y - TmpHeight );
      RightLine.Points[1] := Point2d( BaseLine[1].X, BaseLine[1].Y + TmpHeight );
    End;
  End;

  If OuterArrows Then
    Delta := -ArrowLength
  Else
    Delta := ArrowLength;

  // left arrow
  ArrowPt := Point2d( BaseLine[0].X, TextCoordY );
  With LeftArrow Do
  Begin
    Points[0] := ArrowPt;
    Points[1] := Point2d( ArrowPt.X + Delta, ArrowPt.Y + ArrowHeight / 2 );
    Points[2] := Point2d( ArrowPt.X + Delta, ArrowPt.Y - ArrowHeight / 2 );
    Points[3] := ArrowPt;
  End;

  // right arrow
  ArrowPt := Point2d( BaseLine[1].X, TextCoordY );
  With RightArrow Do
  Begin
    Points[0] := ArrowPt;
    Points[1] := Point2d( ArrowPt.X - Delta, ArrowPt.Y + ArrowHeight / 2 );
    Points[2] := Point2d( ArrowPt.X - Delta, ArrowPt.Y - ArrowHeight / 2 );
    Points[3] := ArrowPt;
  End;

End;

Procedure TEzDimHorizontal.Draw( Grapher: TEzGrapher;
  Canvas: TCanvas; Const Clip: TEzRect; DrawMode: TEzDrawMode; Data: Pointer = Nil );
Var
  i: Integer;
Begin
  For i := 0 To FEntities.Count - 1 Do
  Begin
    With TEzEntity( FEntities[i] ) Do
    Begin
      SetTransformMatrix( Self.GetTransformMatrix );
      Draw( Grapher, Canvas, Clip, DrawMode );
    End;
  End;
End;

Function TEzDimHorizontal.GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector;
Begin
  Result := TEzVector.Create( 5 );
  { 1 +   4 +----+
      | \   |text|
      |  \  +----+
    0 +---\--+ 2
           \ |
            \|
             + 3
  }
  Result.Add( Point2d( Points[0].X, Points[3].Y ) );
  Result.Add( Points[0] );
  Result.Add( Point2d( Points[1].X, Points[3].Y ) );
  Result.Add( Points[1] );
  Result.Add( Points[2] );
End;

Procedure TEzDimHorizontal.UpdateControlPoint( Index: Integer;
  Const Value: TEzPoint; Grapher: TEzGrapher=Nil);
Begin
  FPoints.DisableEvents := true;
  Try
    Case Index Of
      0: Points[3] := Point2d( 0, Value.Y );
      1: Points[0] := Value;
      2: Points[3] := Point2d( 0, Value.Y );
      3: Points[1] := Value;
      4: Points[2] := Value;
    End;
    UpdateExtension;
  Finally
    FPoints.DisableEvents := false;
  End;
End;

Procedure TEzDimHorizontal.LoadFromStream( Stream: TStream );
Begin
  If FPenTool = Nil Then
    FPenTool := TEzPenTool.Create;
  If FEntities = Nil Then
    FEntities := TList.Create;
  ClearEntities;
  FPoints.DisableEvents := true;
  Try
    Inherited LoadFromStream( Stream );
    With Stream Do
    Begin
      FFontName := EzReadStrFromStream( stream );
      FPenTool.LoadFromStream( Stream );
      Read( FTextHeight, sizeof( FTextHeight ) );
      Read( FNumDecimals, sizeof( FNumDecimals ) );
    End;
    FPoints.CanGrow := False;
    FPoints.OnChange := UpdateExtension;
    FOriginalSize := StorageSize;
  Finally
    FPoints.DisableEvents := false;
  End;
  UpdateExtension;
End;

Procedure TEzDimHorizontal.SaveToStream( Stream: TStream );
Begin
  Inherited SaveToStream( Stream );
  With Stream Do
  Begin
    EzWriteStrToStream( FFontName, stream );
    FPenTool.SaveToStream( Stream );
    Write( FTextHeight, sizeof( FTextHeight ) );
    Write( FNumDecimals, sizeof( FNumDecimals ) );
  End;
  FOriginalSize := StorageSize;
End;

Procedure TEzDimHorizontal.SetNumDecimals( Value: Integer );
Begin
  FNumDecimals := Value;
  UpdateExtension;
End;

Procedure TEzDimHorizontal.SetTextHeight( Const Value: Double );
Begin
  FTextHeight := Value;
  UpdateExtension;
End;

Procedure TEzDimHorizontal.SetTextLineY( Const Value: Double );
Begin
  Points[3] := Point2d( 0, Value );
  UpdateExtension;
End;

Procedure TEzDimHorizontal.UpdateExtension;
Var
  i: integer;
  TmpR: TEzRect;
Begin
  If FPoints.DisableEvents then Exit;
  Calculate;
  FBox := INVALID_EXTENSION;
  For i := 0 To FEntities.Count - 1 Do
  Begin
    TmpR := TEzEntity( FEntities[i] ).FBox;
    FBox.Emin.X := dMin( FBox.Emin.X, TmpR.Emin.X );
    FBox.Emin.Y := dMin( FBox.Emin.Y, TmpR.Emin.Y );
    FBox.Emax.X := dMax( FBox.Emax.X, TmpR.Emax.X );
    FBox.Emax.Y := dMax( FBox.Emax.Y, TmpR.Emax.Y );
  End;
End;

Function TEzDimHorizontal.GetBaseLineFrom: TEzPoint;
Begin
  Result := Points[0];
End;

Function TEzDimHorizontal.GetBaseLineTo: TEzPoint;
Begin
  Result := Points[1];
End;

Function TEzDimHorizontal.GetTextBasePoint: TEzPoint;
Begin
  Result := Points[2]
End;

Function TEzDimHorizontal.GetTextLineY: Double;
Begin
  Result := Points[3].Y;
End;

Procedure TEzDimHorizontal.SetBaseLineFrom( Const Value: TEzPoint );
Begin
  Points[0] := Value;
  UpdateExtension;
End;

Procedure TEzDimHorizontal.SetBaseLineTo( Const Value: TEzPoint );
Begin
  Points[1] := Value;
  UpdateExtension;
End;

Procedure TEzDimHorizontal.SetFontName( Const Value: String );
Begin
  FFontName := Value;
  UpdateExtension;
End;

Procedure TEzDimHorizontal.SetTextBasePoint( Const Value: TEzPoint );
Begin
  Points[2] := Value;
  UpdateExtension;
End;

Function TEzDimHorizontal.StorageSize: Integer;
Begin
  result := Length( FFontName );
End;

Function TEzDimHorizontal.GetEntityID: TEzEntityID;
Begin
  result := idDimHorizontal;
End;

Function TEzDimHorizontal.PointCode( Const Pt: TEzPoint; Const Aperture: Double;
  Var Distance: Double; SelectPickingInside: Boolean; UseDrawPoints: Boolean=True ): Integer;
Var
  I: Integer;
Begin
  Result := PICKED_NONE;
  If ( FEntities = Nil ) Or ( FEntities.Count = 0 ) Then Exit;
  For I := 0 To FEntities.Count - 1 Do
  Begin
    Result := TEzEntity( FEntities[I] ).PointCode( Pt, Aperture, Distance, SelectPickingInside, UseDrawPoints );
    If Result >= PICKED_INTERIOR Then Exit;
  End;
End;

function TEzDimHorizontal.IsEqualTo(Entity: TEzEntity; IncludeAttribs: Boolean = False ): Boolean;
begin
  Result:= False;
  if ( Entity.EntityID <> idDimHorizontal ) Or Not FPoints.IsEqualTo( Entity.Points ) Or
     ( IncludeAttribs And (
         Not CompareMem( @FPenTool.FPenStyle,
                         @TEzDimHorizontal(Entity).FPenTool.FPenStyle,
                         SizeOf( TEzPenStyle ) ) Or
         (AnsiCompareText(FFontName, TEzDimHorizontal(Entity).FFontName) <> 0) Or
         (FTextHeight <> TEzDimHorizontal(Entity).FTextHeight) ) ) Then Exit;
  Result:= True;
end;

{$IFDEF BCB}
function TEzDimHorizontal.GetFontName: String;
begin
  Result := FFontName;
end;

function TEzDimHorizontal.GetNumDecimals: Integer;
begin
  Result := FNumDecimals;
end;

function TEzDimHorizontal.GetTextHeight: Double;
begin
  Result := FTextHeight;
end;
{$ENDIF}

{ TEzDimVertical }

Constructor TEzDimVertical.CreateEntity( Const BaseLineFrom, BaseLineTo: TEzPoint;
  Const TextLineX: Double );
Begin

⌨️ 快捷键说明

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