ezactions.pas

很管用的GIS控件

Unit EzActions;

{***********************************************************}
{     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, EzDanHint;

Type

  { The action for selecting entities }
  TEzSelectionMode = ( smPicking, smWindow, smReshaping );
  { Group mode specifies how the object are picked in a box. }
  TEzGroupMode = ( gmAllInside, gmCrossFrame );
  TEzScaleAxis = ( saBoth, saX, saY );

  {----------------------------------------------------------------------------}
  {                  TTheDefaultAction                                         }
  {----------------------------------------------------------------------------}

  TTheDefaultAction = Class( TEzAction )
  Private
    FAperture: Byte;
    { used for stacked select}
    FStackedSelList: TStringList;
    FSelMode: TEzSelectionMode;
    FFrame: TEzEntity;
    FCurrentIndex: Integer;
    FUsedPts: Array[0..1] Of TEzPoint;
    FIsMouseDown: Boolean;
    FMouseDownPos: TPoint;
    FRealMouseDownPos: TEzPoint;
    FReferenceStart: TEzPoint;
    FReferenceEnd: TEzPoint;
    //FDrawBoxWithSel: TEzBaseDrawBox;
    FScaleAxis: TEzScaleAxis;
    FCanMove: Boolean;
    FSizer: TEzEntity;
    FSizerDrawBox: TEzBaseDrawBox;
    FTransformType: TEzTransformType; { solo ttRotate y ttScale con esta herramienta }
    FReferenceLength: Double;
    FShowingSizer: Boolean;
    FShowingRubberSelection: Boolean;
    Function MyOwnPointCode( Ent: TEzEntity;
      Const Pt: TEzPoint; Const Aperture: Double; Var Distance: Double;
      SelectPickingInside: Boolean ): Integer;
    procedure ShowRubberSelection(AlsoShowSizer: Boolean = True);
    procedure HideRubberSelection(ApplyTransform: Boolean = False);
    procedure ShowSizer(UpdateDrawBox: Boolean = True);
    procedure HideSizer;
    Procedure DrawSelectionRubberBanding(ApplyTransform: Boolean);
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseUp( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyDblClick( Sender: TObject );
    Procedure SetCurrentPoint( Grapher: TEzGrapher; Pt: TEzPoint; Orto: Boolean );
    procedure MyPaint(Sender: TObject);
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TRotateAccuDrawAction
  {----------------------------------------------------------------------------}

  TRotateAccuDrawAction = Class( TEzAction )
  Private
    Procedure MyMouseUp( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer;
      Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
  End;

  {----------------------------------------------------------------------------}
  //                  TZoomWindowAction
  {----------------------------------------------------------------------------}

  TZoomWindowAction = Class( TEzAction )
  Private
    FFrame: TEzRectangle;
    FOuterFrame: TEzRectangle;
    FAuxLine: TEzPolyline;
    FCurrentIndex: Integer;
    FOrigin: TPoint;
    FIsZooming: Boolean;
    FTargetDrawBox: TEzBaseDrawBox;
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
    Procedure DoFinishZooming;
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseUp( Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer;
      Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyPaint( Sender: TObject );
    Procedure DrawRubbers(Sender: TObject=Nil);
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TPanningAction
  {----------------------------------------------------------------------------}

  TPanningAction = Class( TEzAction )
  Private
    FLine: TEzPolyLine;
    FCurrentIndex: Integer;
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyPaint( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TEzTransformSelectionAction
  {----------------------------------------------------------------------------}

  TTransformSelectionAction = Class( TEzAction )
  Private
    FLine: TEzPolyLine;
    FCurrentIndex: Integer;
    FTransformType: TEzTransformType;
    FReferenceStart: TEzPoint;
    FReferenceEnd: TEzPoint;
    FReferenceLength: Double;
    FReferenceDefined: Boolean;
    FOffsetCmd: Boolean;
    FScaleAxxis: TEzScaleAxis;
    FOldHiliteSnapped: Boolean;
    FDrawBoxWithSel: TEzBaseDrawBox;
    procedure DrawRubberLine(Sender: TObject=Nil);
    Procedure DrawSelectionRubberBanding( ApplyTransform: Boolean;
      Sender: TObject=Nil );
    Procedure SetCurrentPoint( Var Pt: TEzPoint; Orto: Boolean );
    Procedure MyActionDoCommand( Sender: TObject );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyPaint( Sender: TObject );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine;
      TransformType: TEzTransformType; OffsetCmd: Boolean; ScaleAxxis: TEzScaleAxis );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TSelectAction
  {----------------------------------------------------------------------------}

  TSelectAction = Class( TEzAction )
  Private
    fFrame: TEzRectangle;
    FAperture: Integer;
    fCurrentIndex: Integer;
    fSelMode: TEzSelectionMode;
    Procedure SetCurrentPoint( Grapher: TEzGrapher; Const Pt: TEzPoint );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyPaint( Sender: TObject );
  {$IFDEF BCB} (*_*)
    function GetAperture: Integer;
    procedure SetAperture(const Value: Integer);
  {$ENDIF}
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; Aperture: Integer );
    Destructor Destroy; Override;
    Property Aperture: Integer Read {$IFDEF BCB} GetAperture {$ELSE} FAperture {$ENDIF}
      Write {$IFDEF BCB} SetAperture {$ELSE} FAperture {$ENDIF}; (*_*)
  End;

  {----------------------------------------------------------------------------}
  //                  TInsertVertexAction
  {----------------------------------------------------------------------------}

    { action for Insert vertex in Polylines or Polygons }
  TInsertVertexAction = Class( TEzAction )
  Private
    fEntity: TEzEntity;
    fLayer: TEzBaseLayer;
    fRecno: Integer;
    FModified:Boolean;
    FAperture: Byte;
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyPaint( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TChangeGridOriginAction
  {----------------------------------------------------------------------------}

  TChangeGridOriginAction = Class( TEzAction )
  Private
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
  End;

  {----------------------------------------------------------------------------}
  //                  TShowHintAction
  {----------------------------------------------------------------------------}

  { The action for showing hints on layer磗 entities }

  TShowHintAction = Class( TEzAction )
  Private
    { for handling the hint window }
    hintW: TNewHint;
    fLayer: TEzBaseLayer;
    //fTimer: TTimer;
    fLastLayer: TEzBaseLayer;
    fLastRecno: Integer;
    fSaveOnDeactivate: TNotifyEvent;
    fSaveOnHint: TNotifyEvent;
    FStackedSelList: TStringList;
    FHighlightClicked: Boolean;
    FTempUsed: Boolean;
    FTempEnt: TEzEntity;
    Procedure HiliteClickedEntity( Layer: TEzBaseLayer; Recno: Integer );
    Procedure DisposeTempUsed;
    Procedure MyDeactivate( Sender: TObject );
    Procedure MyOnHint( Sender: TObject );
    Procedure DisplayHintWindow( Const TmpHint: String; p: TPoint );
    //Procedure MyTimer( Sender: TObject );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    //Procedure SuspendOperation( Sender: TObject );
    //Procedure ContinueOperation( Sender: TObject );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TPolygonFromBufferAction
  {----------------------------------------------------------------------------}

  { draw a polygon by using a polyline as a buffer }
  TPolygonFromBufferAction = Class( TEzAction )
  Private
    fLine: TEzPolyLine;
    fPolyline: TEzPolyLine;
    fPolygon: TEzPolygon;
    fCurrentIndex: Integer;
    fDistance: Double;
    fReferenceDefined: Boolean;
    Procedure DrawRubberEntityDotted(Entity: TEzEntity;Sender: TObject=Nil);
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
    Procedure CalcPolygon;
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyPaint( Sender: TObject );
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
    Procedure UndoOperation; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TRealTimeZoomAction
  {----------------------------------------------------------------------------}

    // action for zooming in real time
  TRealTimeZoomAction = Class( TEzAction )
  Private
    FStartPoint: TPoint;
    FSaveParams: TEzTransformParams;
    FRealTimeZooming: Boolean;
    FSaveShowWaitCursor: Boolean;
    FCursorGIS: TEzBaseGIS;
    FWorkDrawBox: TEzBaseDrawBox;

    FUseThread: Boolean;
    FPaintingThread: TEzPainterThread;

    Procedure MyThreadDone(Sender: TObject);
    procedure MyStopRepaintThread;

    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseUp( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; UseThread: Boolean );
    Destructor Destroy; override;
  End;

  {----------------------------------------------------------------------------}
  //                  TRealTimeZoomActionB
  {----------------------------------------------------------------------------}