ezactionlaunch.pas

很管用的GIS控件

Function TDrawCircleAction.IndexLimit: Integer;
Begin
  Case FCircleDrawType Of
    ct2P: result := 1;
    ct3P: result := 2;
    ctCR: result := 1;
  Else
    result := 2;
  End;
End;

Procedure TDrawCircleAction.SetCurrentPoint( Pt: TEzPoint; Orto: Boolean );
Begin
  If Orto And ( FCurrentIndex > 0 ) Then
    Pt := ChangeToOrtogonal( FPts[FCurrentIndex - 1], Pt );
  FPts[FCurrentIndex] := Pt;
  If FCurrentIndex = 0 Then
    WaitingMouseClick := False;
End;

// create the circle through three points

Procedure TDrawCircleAction.CreateCircle;
Var
  MidPt, RotPt, TestPt: TEzPoint;
  V1, V2, IntersV: TEzVector;
  Radius: Double;
  Center: TEzPoint;
Begin
  If FCurrentIndex < IndexLimit Then Exit;
  If ( IndexLimit = 2 ) And EqualPoint2d( FPts[0], Fpts[1] ) Or
    EqualPoint2d( FPts[0], FPts[2] ) Or EqualPoint2d( FPts[1], FPts[2] ) Then Exit;

  If FCircleDrawType = ct2P Then
  Begin
    Center := Point2d( ( FPts[0].X + FPts[1].X ) / 2, ( FPts[0].Y + FPts[1].Y ) / 2 );
    Radius := Dist2d( FPts[0], FPts[1] ) / 2;
    FCircle.BeginUpdate;
    FCircle.Points[0] := Point2d( Center.X - Radius, Center.Y - Radius );
    FCircle.Points[1] := Point2d( Center.X + Radius, Center.Y + Radius );
    FCircle.EndUpdate;
  End
  Else If FCircleDrawType = ctCR Then
  Begin
    Center := FPts[0];
    Radius := Dist2d( FPts[0], FPts[1] );
    FCircle.BeginUpdate;
    FCircle.Points[0] := Point2d( Center.X - Radius, Center.Y - Radius );
    FCircle.Points[1] := Point2d( Center.X + Radius, Center.Y + Radius );
    FCircle.EndUpdate;
  End
  Else If FCircleDrawType = ct3P Then
  Begin
    // check if 3 points are colinear
    TestPt := Perpend( FPts[2], FPts[0], FPts[1] );
    If EqualPoint2d( FPts[2], TestPt ) Then
    Begin
      FCircle.BeginUpdate;
      FCircle.Points[0] := Point2d( 0, 0 );
      FCircle.Points[1] := Point2d( 0, 0 );
      FCircle.EndUpdate;
      exit;
    End;
    V1 := TEzVector.Create( 2 );
    V2 := TEzVector.Create( 2 );
    IntersV := TEzVector.Create( 2 );
    Try
      MidPt := Point2d( ( FPts[0].X + FPts[1].X ) / 2, ( FPts[0].Y + FPts[1].Y ) / 2 );
      RotPt := TransformPoint2d( FPts[0], Rotate2d( System.Pi / 2, MidPt ) );
      V1.Add( MidPt );
      V1.Add( RotPt );

      MidPt := Point2d( ( FPts[1].X + FPts[2].X ) / 2, ( FPts[1].Y + FPts[2].Y ) / 2 );
      RotPt := TransformPoint2d( FPts[1], Rotate2d( System.Pi / 2, MidPt ) );
      V2.Add( MidPt );
      V2.Add( RotPt );

      If Not VectIntersect( V1, V2, IntersV, false ) Then Exit;

      Center := IntersV[0];
      Radius := Dist2d( FPts[0], Center );
      FCircle.BeginUpdate;
      FCircle.Points[0] := Point2d( Center.X - Radius, Center.Y - Radius );
      FCircle.Points[1] := Point2d( Center.X + Radius, Center.Y + Radius );
      FCircle.EndUpdate;
    Finally
      V1.Free;
      V2.Free;
      IntersV.Free;
    End;
  End;
End;

Procedure TDrawCircleAction.MyMouseDown( Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
Var
  CurrPoint: TEzPoint;
Begin
  If Button = mbRight Then Exit;
  With CmdLine Do
  Begin
    CurrPoint := CmdLine.GetSnappedPoint;
    with ActiveDrawBox do
      DrawCross( Canvas, Grapher.RealToPoint( CurrPoint ) );
    SetCurrentPoint( CurrPoint, UseOrto );

    { ** AccuDraw **}
    If FCurrentIndex = 0 Then
      AccuDraw.UpdatePosition( CurrPoint, CurrPoint )  // this activates AccuDraw
    Else If FCurrentIndex > 0 Then
      AccuDraw.UpdatePosition( FPts[FCurrentIndex], CurrPoint );

    If FCurrentIndex >= IndexLimit Then
    Begin
      All_DrawEntity2DRubberBand( FCircle);
      CreateCircle;
      if Assigned( Launcher ) then
      begin
        if Assigned( TEzActionLauncher( Launcher ).OnTrackedEntity ) then
          TEzActionLauncher( Launcher ).OnTrackedEntity( Launcher, Self.ActionID, FCircle );
        All_Invalidate;
      end else
        ActionAddNewEntity( CmdLine, FCircle );
      Self.Finished := true;
      Exit;
    End
    Else
      Inc( fCurrentIndex );
    SetAddActionCaption;
  End;
End;

Procedure TDrawCircleAction.SetAddActionCaption;
Begin
  Case fCurrentIndex Of
    0: Caption := SFirstPoint;
    1: Caption := SSecondPoint;
    2: Caption := SThirdPoint;
  Else
    Caption := '';
  End;
End;

Procedure TDrawCircleAction.MyMouseMove( Sender: TObject; Shift: TShiftState;
  X, Y: Integer; Const WX, WY: Double );
Var
  CurrPoint: TEzPoint;
  Radiusx: Double;
  nd: Integer;
Begin
  With CmdLine Do
  Begin
    If FCurrentIndex >= IndexLimit Then
      All_DrawEntity2DRubberBand( FCircle );
    CurrPoint := GetSnappedPoint;
    SetCurrentPoint( CurrPoint, UseOrto );
    If FCurrentIndex >= IndexLimit Then
    Begin
      CreateCircle;
      All_DrawEntity2DRubberBand( FCircle );
    End;
    If FCircle.Points.Count >= 2 Then
    Begin
      RadiusX:= Dist2d( FCircle.Points[0], Point2d( FCircle.Points[1].X, FCircle.Points[0].Y) ) / 2;
      //RadiusY:= Dist2d( FCircle.Points[0], Point2d( FCircle.Points[0].X, FCircle.Points[1].Y) ) / 2;
      nd:= ActiveDrawBox.NumDecimals;
      StatusMessage := Format( SCircleInfo, [ nd, RadiusX, nd, FCircle.Area, nd, FCircle.Perimeter ] );
    End;
  End;
End;

Procedure TDrawCircleAction.MyPaint( Sender: TObject );
Begin
  If FCurrentIndex >= IndexLimit Then
    (Sender as TEzBaseDrawBox).DrawEntity2DRubberBand( FCircle );
End;

Procedure TDrawCircleAction.MyKeyPress( Sender: TObject; Var Key: Char );
Begin
  If Key = #27 Then
    Self.FInished := true;
End;

procedure TDrawCircleAction.ContinueOperation(Sender: TObject);
begin
  If Assigned( FCircle ) Then
    CmdLine.All_DrawEntity2DRubberBand( FCircle );
end;

procedure TDrawCircleAction.SuspendOperation(Sender: TObject);
begin
  If Assigned( FCircle ) Then
    CmdLine.All_DrawEntity2DRubberBand( FCircle );
end;

{ TDrawArcAction }

Constructor TDrawArcAction.CreateAction( CmdLine: TEzCmdLine;
  Method: TDrawArcMethod = damCRS );
Var
  p: TEzPoint;
Begin
  Inherited CreateAction( CmdLine );

  FMethod:= Method;

  P := Point2d( 0, 0 );
  FCircle := TEzEllipse.CreateEntity( p, p );
  FArc:= TEzArc.CreateEntity( Point2d(0,0),Point2d(0,0),Point2d(0,0));

  FRadiusLines:= TEzPolyline.CreateEntity( [p,p] );

  FDefiningCircle:= true;
  FLastPoint:= INVALID_POINT;

  CanDoOsnap := True;
  CanDoAccuDraw:= True;
  MouseDrawElements:= [mdCursorFrame, mdFullViewCursor];
  CmdLine.AccuDraw.FrameStyle:= fsPolar;

  OnMouseDown := MyMouseDown;
  OnMouseMove := MyMouseMove;
  OnKeyPress := MyKeyPress;
  OnPaint := MyPaint;
  OnSuspendOperation := Self.SuspendOperation;
  OnContinueOperation := Self.ContinueOperation;

  Cursor := crDrawCross;
  WaitingMouseClick := True;
  SetAddActionCaption;
End;

Destructor TDrawArcAction.Destroy;
Begin
  { If not nil then the entity was not added to the file/symbol
    and we must delete it }
  if Assigned(FCircle) then FreeAndNil( FCircle );
  FreeAndNil( FArc );
  FreeAndNil( FRadiusLines );
  Inherited Destroy;
End;

Procedure TDrawArcAction.SetAddActionCaption;
Begin
  If FMethod = damCRS then
  begin
    Case fCurrentIndex Of
      0: Caption := SCircleCenter;
      1: Caption := SCircleRadius;
    Else
      Caption := '';
    End;
  end else
  begin
    Case fCurrentIndex Of
      0: Caption := SCircleEndPoint;
      1: Caption := SCircleCenter;
    Else
      Caption := '';
    End;
  end;
End;

procedure TDrawArcAction.DrawRubberCircle(Sender: TObject = Nil);
var
  OldPenStyle: TPenStyle;
  dbox: TEzBaseDrawbox;
begin
  If Not Assigned( FCircle ) then Exit;
  If Sender = Nil Then
    dbox:= CmdLine.ActiveDrawBox
  else
    dbox:= (Sender As TEzBaseDrawbox);
  with dbox do
  Begin
    OldPenStyle:= RubberPen.Style;
    RubberPen.Style:= psDot;
    If Sender = Nil then
    begin
      CmdLine.All_DrawEntity2DRubberBand( FCircle );
      CmdLine.All_DrawEntity2DRubberBand( FRadiusLines );
    end else
    begin
      DrawEntity2DRubberBand( FCircle );
      DrawEntity2DRubberBand( FRadiusLines );
    end;
    RubberPen.Style:= OldPenStyle;
  end;
end;

procedure TDrawArcAction.DrawRubberArc(Sender: TObject = Nil);
begin
  If Not Assigned( FArc ) then Exit;
  If Sender = Nil Then
    CmdLine.All_DrawEntity2DRubberBand( FArc )
  Else
    (Sender As TEzBaseDrawbox).DrawEntity2DRubberBand( FArc )
end;

procedure TDrawArcAction.ContinueOperation(Sender: TObject);
begin
  if FDefiningCircle then
    DrawRubberCircle
  else
    DrawRubberArc;
end;

procedure TDrawArcAction.SuspendOperation(Sender: TObject);
begin
  if FDefiningCircle then
    DrawRubberCircle
  else
    DrawRubberArc;
end;

Procedure TDrawArcAction.SetCurrentPoint( Pt: TEzPoint; Orto: Boolean );
Begin
  If Orto And ( FCurrentIndex > 0 ) Then
    Pt := ChangeToOrtogonal( FPts[FCurrentIndex - 1], Pt );
  FPts[FCurrentIndex] := Pt;

  FRadiusLines.Points[0]:= FPts[0];
  FRadiusLines.Points[1]:= Pt;
  If FCurrentIndex = 0 Then
    WaitingMouseClick := False;
End;

// create the circle through three points
Procedure TDrawArcAction.CreateCircle;
Var
  Radius: Double;
  Center: TEzPoint;
Begin
  If FCurrentIndex < 1 Then Exit;

  If FMethod = damCRS then
    Center := FPts[0]
  else
    Center := FPts[1];

  Radius := Dist2d( FPts[0], FPts[1] );

  FCircle.BeginUpdate;
  FCircle.Points[0] := Point2d( Center.X - Radius, Center.Y - Radius );
  FCircle.Points[1] := Point2d( Center.X + Radius, Center.Y + Radius );
  FCircle.EndUpdate;
End;

Procedure TDrawArcAction.MyMouseDown( Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
Var
  CurrPoint, Center: TEzPoint;
  StartAng, EndAng, NumRads: double;
Begin
  With CmdLine Do
  Begin
    CurrPoint := GetSnappedPoint;
    with ActiveDrawBox do
      DrawCross( Canvas, Grapher.RealToPoint( CurrPoint ) );

    If FCurrentIndex=0 then
      AccuDraw.UpdatePosition(CurrPoint, CurrPoint);  // activate AccuDraw

    If FDefiningCircle then
    Begin
      SetCurrentPoint( CurrPoint, UseOrto );
      If FCurrentIndex >= 1 Then
      Begin
        DrawRubberCircle;
        FPts[1] := CurrPoint;
        If FMethod = damFCS Then
          AccuDraw.UpdatePosition(Fpts[1], FPts[0], True);
        FDefiningCircle := false;
        If FMethod = damCRS then
          Center:= FPts[0]
        Else
          Center:= FPts[1];
        TEzArc( FArc ).SetArc( Center.X, Center.Y, Dist2d( FPts[0], FPts[1] ),
            Angle2d(FPts[0],FPts[1]), 0, true );
        DrawRubberArc;