ezactionlaunch.pas

很管用的GIS控件

Procedure TAddEntityAction.MyMouseMove( Sender: TObject; Shift: TShiftState;
  X, Y: Integer; Const WX, WY: Double );
Var
  CurrPoint, P1, P2: TEzPoint;
  DX, DY, Area, Perimeter, Angle: Double;
  nd: Integer;
Begin
  With CmdLine Do
  Begin
    if FDrawImmediately Or Not EqualPoint2d( Self.LastClicked, INVALID_POINT) Then
      DrawEntityRubberToAll(Nil);

    CurrPoint := CmdLine.GetSnappedPoint;
    SetCurrentPoint( CurrPoint, CmdLine.UseOrto );

    DrawEntityRubberToAll(Nil);

    // show some info
    If FCurrentIndex > 0 Then
    Begin
      P1 := FEntity.Points[FCurrentIndex - 1];
      P2 := FEntity.Points[FCurrentIndex];
      DX := Abs( P2.X - P1.X );
      DY := Abs( P2.Y - P1.Y );
      If ( DX = 0 ) And ( DY = 0 ) Then
      Begin
        Angle := 0;
        Area := 0;
        Perimeter := 0;
      End
      Else
      Begin
        If (FCurrentIndex > 1) And
          Not ((FEntity.EntityID = idArc) and TEzArc(FEntity).IsColinear) Then
        Begin
          Angle := RadToDeg( Angle2D( P1, P2 ) );
          Area := FEntity.Area( );
          Perimeter := FEntity.Perimeter( );
        End Else
        Begin
          Angle := 0;
          Area := 0;
          Perimeter := 0;
        End;
      End;
      nd:= CmdLine.ActiveDrawBox.NumDecimals;
      CmdLine.StatusMessage := Format( SNewEntityInfo,
        [nd, Angle, nd, DX, nd, DY, nd, Area, nd, Perimeter] );
    End
    Else
      CmdLine.StatusMessage := '';
  End;
End;

Procedure TAddEntityAction.MyPaint( Sender: TObject );
Begin
  If FDrawImmediately Or (FEntity <> Nil) Then
    DrawEntityRubberToAll((Sender as TEzBaseDrawBox));
End;

Procedure TAddEntityAction.MyKeyPress( Sender: TObject; Var Key: Char );
Begin
  With CmdLine Do
    Case Key Of
      #13:
        If FEntity.Points.CanGrow Then
        Begin
          If ( FEntity.IsClosed And ( fCurrentIndex < 2 ) ) Or
            ( Not FEntity.IsClosed And ( fCurrentIndex < 2 ) ) Then
          Begin
            MessageToUser( SNotEnoughData, smsgerror, MB_ICONERROR );
            Exit;
          End;
          (* Erase entity from screen and last point *)
          DrawEntityRubberToAll(Nil);
          FEntity.Points.Delete( fCurrentIndex );
          if Assigned( Launcher ) then
          begin
            if Assigned( TEzActionLauncher( Launcher ).OnTrackedEntity ) then
              TEzActionLauncher( Launcher ).OnTrackedEntity( Launcher, Self.ActionID, FEntity );
            All_Refresh;
          end else
            ActionAddNewEntity( CmdLine, FEntity );
          Self.Finished := true;
          Key := #0;
          Exit;
        End;
      #27:
        Begin
          DrawEntityRubberToAll(Nil);
          If FCurrentIndex = 0 Then
          Begin
            FreeAndNil( FEntity );
            Self.Finished := true;
            Exit;
          End;
          Dec( FCurrentIndex );
          FEntity.Points.Count:= FCurrentIndex;
          { update the last clicked point (used when snapping to paraller, perpendicular,etc) }
          If FEntity.Points.Count = 0 Then
            Self.LastClicked:= INVALID_POINT
          Else
            Self.LastClicked:= FEntity.Points[FCurrentIndex-1];
          SetCurrentPoint( CurrentPoint, UseOrto );
          DrawEntityRubberToAll(Nil);
          If (FEntity.EntityID in [idPolyline,idPolygon,idArc,idSpline,idNodeLink]) then
          begin
            If FCurrentIndex = 1 Then
              AccuDraw.UpdatePosition( FEntity.Points[0], FEntity.Points[0] )
            Else If FCurrentIndex > 0 Then
              AccuDraw.UpdatePosition( FEntity.Points[FCurrentIndex-2], FEntity.Points[FCurrentIndex-1] );
          end;
        End;
    End;
End;

procedure TAddEntityAction.SuspendOperation(Sender: TObject);
begin
  with CmdLine do
  begin
    If Assigned( FEntity ) And (FDrawImmediately Or
       Not EqualPoint2d( Self.LastClicked, INVALID_POINT)) Then
      DrawEntityRubberToAll(Nil);
  end;
end;

procedure TAddEntityAction.ContinueOperation(Sender: TObject);
begin
  with CmdLine do
  begin
    If Assigned( FEntity ) And (FDrawImmediately Or
       Not EqualPoint2d( Self.LastClicked, INVALID_POINT)) Then
      DrawEntityRubberToAll(Nil);
  end;
end;

{-------------------------------------------------------------------------------}
//                  TSketchAction - class implementation
{-------------------------------------------------------------------------------}

Constructor TSketchAction.CreateAction( CmdLine: TEzCmdLine; Ent: TEzEntity );
Begin
  Inherited CreateAction( CmdLine );

  FEntity := Ent;

  CanDoOsnap := False;
  CanDoAccuDraw:= False;
  If CmdLine.UseFullViewCursor Then
    MouseDrawElements:= [mdCursorFrame, mdFullViewCursor]
  Else
    MouseDrawElements:= [mdCursor];

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

  // set line width to the default
  If Ent Is TEzOpenedEntity Then
    TEzOpenedEntity(Ent).Pentool.Width := Ez_Preferences.DefPenStyle.Width;

  { This is used for snapping to this entity also because this entity is not yet
    saved to the database }
  EzSystem.GlobalTempEntity:= Ent;

  // define the cursor for this action
  Cursor:= crDrawCross;

  WaitingMouseClick := True;
  Caption := SFirstPoint;
  CmdLine.All_Invalidate;
End;

Destructor TSketchAction.Destroy;
Begin
  { If not nil then the entity was not added to the file/symbol and we must delete it }
  If FEntity <> Nil Then FEntity.Free;
  EzSystem.GlobalTempEntity:= Nil;
  Inherited Destroy;
End;

Procedure TSketchAction.SetCurrentPoint( Pt: TEzPoint);
Var
  I: Integer;
Begin
  FEntity.Points[FCurrentIndex] := Pt;
  For I := FCurrentIndex + 1 To FEntity.Points.Count - 1 Do
    FEntity.Points[I] := Pt;
End;

Procedure TSketchAction.AddPoint( const CurrPoint: TEzPoint );
Begin
  with CmdLine.ActiveDrawBox do
  begin
    SetCurrentPoint(CurrPoint);

    { Set AccuDraw position }
    //If FCurrentIndex = 0 Then
    //  CmdLine.AccuDraw.UpdatePosition( CurrPoint, CurrPoint );  // this activates AccuDraw

    Inc( FCurrentIndex );

  end;
End;

Procedure TSketchAction.CleanEntity;
var
  I: Integer;
  TempV: TEzVector;
  Pivot: TEzPoint;
  OldAngle,Angle: Double;
  found: Boolean;
Begin
  If FEntity.Points.Count < 3 then Exit;
  { erase all repeated points and also points that have the same slope }
  TempV:= TEzVector.Create(FEntity.Points.Count);
  try
    Pivot:= FEntity.Points[0];
    TempV.Add(Pivot);
    OldAngle:= Angle2d( Pivot, FEntity.Points[1] );
    I:= 1;
    while I <= FEntity.Points.Count-1 do
    begin
      Angle:= Angle2d(Pivot, FEntity.Points[I]);
      If Angle <> OldAngle Then
      Begin
        Pivot:= FEntity.Points[I-1];
        TempV.Add(Pivot);
        OldAngle:= Angle2d(Pivot, FEntity.Points[I]);
      End;
      Inc(I);
    end;
    { now delete repeated vertices }
    repeat
      found:= false;
      for I:= 1 to TempV.Count-1 do
        If EqualPoint2d( TempV[I-1], TempV[I]) then
        begin
          TempV.Delete(I);
          found:= true;
          break;
        end;
    until not found;
    FEntity.Points.Assign( TempV );
  finally
    TempV.Free;
  end;
End;

Procedure TSketchAction.MyMouseDown( Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
Var
  CurrPoint: TEzPoint;
Begin
  If Not FIsDrawing And (Button = mbRight) Then
  begin
    Self.Finished:= True;
    Exit;
  end;
  CurrPoint := CmdLine.CurrentPoint;  //CmdLine.GetSnappedPoint;

  AddPoint( CurrPoint );

  If FIsDrawing Then
  Begin
    If ( FEntity.IsClosed And ( fCurrentIndex < 3 ) ) Or
      ( Not FEntity.IsClosed And ( fCurrentIndex < 2 ) ) Then
    Begin
      Self.Finished:= True;
      Exit;
    End;
    CmdLine.All_DrawEntity2DRubberBand( FEntity);
    CleanEntity;
    if Assigned( Launcher ) then
    begin
      if Assigned( TEzActionLauncher( Launcher ).OnTrackedEntity ) then
        TEzActionLauncher( Launcher ).OnTrackedEntity( Launcher, Self.ActionID, FEntity );
      CmdLine.All_Refresh;
    end else
      ActionAddNewEntity( CmdLine, FEntity );
    Self.Finished:= True;
    Exit;
  End;

  FIsDrawing:= True;

End;

Procedure TSketchAction.MyMouseMove( Sender: TObject; Shift: TShiftState;
  X, Y: Integer; Const WX, WY: Double );
Var
  CurrPoint: TEzPoint;
Begin
  If Not FIsDrawing Then Exit;
  With CmdLine Do
  Begin
    if Not EqualPoint2d( Self.LastClicked, INVALID_POINT) Then
      All_DrawEntity2DRubberBand( FEntity );

    CurrPoint := CmdLine.CurrentPoint;  //CmdLine.GetSnappedPoint;
    SetCurrentPoint(CurrPoint);

    AddPoint( CurrPoint );

    All_DrawEntity2DRubberBand( FEntity );

  End;
End;

Procedure TSketchAction.MyKeyPress( Sender: TObject; Var Key: Char );
Begin
  If Key=#27 then
  begin
    CmdLine.All_DrawEntity2DRubberBand( FEntity);
    FreeAndNil( FEntity );
    Self.Finished:= true
  end;
End;

Procedure TSketchAction.MyPaint( Sender: TObject );
Begin
  If FEntity <> Nil Then
    (Sender as TEzBaseDrawBox).DrawEntity2DRubberBand( FEntity );
End;

procedure TSketchAction.SuspendOperation(Sender: TObject);
begin
  with CmdLine do
  begin
    If Assigned( FEntity ) And Not EqualPoint2d( Self.LastClicked, INVALID_POINT) Then
      All_DrawEntity2DRubberBand( FEntity);
  end;
end;

procedure TSketchAction.ContinueOperation(Sender: TObject);
begin
  with CmdLine do
  begin
    If Assigned( FEntity ) And Not EqualPoint2d( Self.LastClicked, INVALID_POINT) Then
      All_DrawEntity2DRubberBand( FEntity);
  end;
end;

{ TDrawCircleAction }

Constructor TDrawCircleAction.CreateAction( CmdLine: TEzCmdLine;
  CircleDrawType: TEzCircleDrawType );
Var
  p: TEzPoint;
Begin
  Inherited CreateAction( CmdLine );

  FCircleDrawType := CircleDrawType;

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

  CanDoOsnap := True;
  CanDoAccuDraw:= True;
  MouseDrawElements:= [mdCursorFrame, mdFullViewCursor];

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

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

Destructor TDrawCircleAction.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 );
  Inherited Destroy;
End;