ezdims.pas

很管用的GIS控件

  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, TextLineX ) );
  FPoints.DisableEvents := false;
  FPoints.CanGrow := false;

  UpdateExtension;
End;

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

procedure TEzDimVertical.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 TEzDimVertical.BasicInfoAsString: string;
Begin
  Result:= Format(sDimVertInfo, [BaseLineFrom.X,BaseLineFrom.Y,
    BaseLineTo.X,BaseLineTo.Y,TextLineX]);
End;

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

Procedure TEzDimVertical.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 TEzDimVertical.IsTextOnLine( Const TextWidth: Double ): Boolean;
Var
  TextCoordX: Double;
  TextBasePoint: TEzPoint;
Begin
  If EqualPoint2d( TextBasePoint, Point2d( MAXCOORD, MAXCOORD ) ) Then
  Begin
    Result := true;
    exit;
  End;
  TextBasePoint := Points[2];
  TextCoordX := Points[3].X;
  Result := ( ( TextBasePoint.X >= TextCoordX - TextWidth / 2 ) And ( TextBasePoint.X <= TextCoordX + TextWidth / 2 ) ) Or
    ( ( TextBasePoint.X + TextWidth ) >= TextCoordX - TextWidth / 2 ) And ( ( TextBasePoint.X + TextWidth ) <= TextCoordX +
      TextWidth / 2 );
End;

Procedure TEzDimVertical.Calculate;
Var
  FromPt, ToPt: TEzPoint;
  TextCoordX: 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;
  BottomLine: TEzEntity;
  BottomArrow: TEzEntity;
  TopLine: TEzEntity;
  TopArrow: 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;
    TEzFittedVectorText( TmpEnt ).FontColor := FPenTool.Color;
    FEntities.Add( TmpEnt );
  End;

  FromPt := Points[0];
  ToPt := Points[1];
  TextBasePoint := Points[2];
  TextCoordX := Points[3].X;

  If EqualPoint2d( FromPt, ToPt ) Then
    Exit;

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

  TextLine := FEntities[0];
  TextLine2Text := FEntities[1];
  BottomArrow := FEntities[2];
  TopArrow := FEntities[3];
  BottomLine := FEntities[4];
  TopLine := FEntities[5];
  TextEnt := FEntities[6];

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

  // the text
  With TEzFittedVectorText( TextEnt ) Do
  Begin
    BeginUpdate;
    Text := Format( '%.*n', [FNumDecimals, Abs( Baseline[1].Y - BaseLine[0].Y )] );
    Height := FTextHeight;
    Width := -1; // force to calculate the text width
    MidPoint := Point2d( TextCoordX, ( Baseline[0].Y + BaseLine[1].Y ) / 2 );
    If EqualPoint2d( TextBasePoint, Point2d( MAXCOORD, MAXCOORD ) ) Then
    Begin
      BasePoint := Point2d( MidPoint.X - Width / 2, MidPoint.Y + Height / 2 );
      Self.Points.DisableEvents := true;
      Self.Points[2] := BasePoint;
      Self.Points.DisableEvents := false;
    End
    Else
      BasePoint := TextBasePoint;
    EndUpdate;

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

    TextLine2Text.Points[0] := MidPoint;
    If Self.IsTextOnLine( Width ) Then
    Begin
      BasePoint := Point2d( TextCoordX - Width / 2, BasePoint.Y );
      Self.Points.DisableEvents := true;
      Self.Points[2] := BasePoint;
      Self.Points.DisableEvents := false;
      { check if the text line and the vector text intersects }
      If ( Points[0].Y >= BaseLine[0].Y ) And ( Points[0].Y <= BaseLine[1].Y ) And
        ( Points[1].Y >= BaseLine[0].Y ) And ( Points[1].Y <= BaseLine[1].Y ) Then
      Begin
        TextLine2Text.Points[1] := TextLine2Text.Points[0];
        Delta := FTextHeight * 0.20;
        With TextLine.Points Do
        Begin
          Clear;
          Add( Point2d( TextCoordX, BaseLine[0].Y ) );
          Add( Point2d( TextCoordX, TextEnt.Points[1].Y - Delta ) );
          Add( Point2d( TextCoordX, TextEnt.Points[0].Y + Delta ) );
          Add( Point2d( TextCoordX, BaseLine[1].Y ) );
          Parts.Add( 0 );
          Parts.Add( 2 );
        End;
      End
      Else
        TextLine2Text.Points[1] := Point2d( TextCoordX, ( Points[0].Y + Points[1].Y ) / 2 );
    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;

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

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

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

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

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

End;

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

Function TEzDimVertical.GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector;
Begin
  Result := TEzVector.Create( 5 );
  Result.Add( Point2d( Points[3].X, Points[0].Y ) );
  Result.Add( Points[0] );
  Result.Add( Point2d( Points[3].X, Points[1].Y ) );
  Result.Add( Points[1] );
  Result.Add( Points[2] );
End;

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

Procedure TEzDimVertical.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 ) );