ezactions.pas

很管用的GIS控件

  // action for zooming in real time by scaling the current internal buffer bitmap
  TRealTimeZoomActionB = Class( TEzAction )
  Private
    FWorkBmp: TBitmap;
    FStartPoint: TPoint;
    FSaveParams: TEzTransformParams;
    FRealTimeZooming: Boolean;
    FSaveShowWaitCursor: Boolean;
    FCursorGIS: TEzBaseGIS;
    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 );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    destructor Destroy; override;
  End;

  {----------------------------------------------------------------------------}
  //                  TClipPolyAction
  {----------------------------------------------------------------------------}

  // Polygon clipping action
  TClipPolyAction = Class( TEzAction )
  Private
    FEntity: TEzEntity;
    FCurrentIndex: Integer;
    Procedure SetCurrentPoint( Pt: TEzPoint; Orto: Boolean );
    Procedure SetAddActionCaption;
    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;

  {----------------------------------------------------------------------------}
  //                  TBreakAction
  {----------------------------------------------------------------------------}

  TBreakAction = Class( TEzAction )
  Private
    FAperture: Integer;
    FCurrent: Integer;
    FBreakPoints: Array[0..1] Of TEzPoint;
    FSegment: Array[0..1] Of Integer;
    FLayer: TEzBaseLayer;
    FRecNo: Integer;
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
  End;

  {----------------------------------------------------------------------------}
  //                  TTrimAction
  {----------------------------------------------------------------------------}

  TTrimAction = Class( TEzAction )
  Private
    FPickFrame: TEzRectangle;
    FAperture: Integer;
    FIsButtonUp: Boolean;
    Procedure SetCurrentPoint( Grapher: TEzGrapher; Const Pt: TEzPoint );
    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 SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TExtendAction
  {----------------------------------------------------------------------------}

  TExtendAction = Class( TEzAction )
  Private
    FPickFrame: TEzRectangle;
    FAperture: Integer;
    FIsButtonUp: Boolean;
    Procedure SetCurrentPoint( Grapher: TEzGrapher; Const Pt: TEzPoint );
    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 SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TFilletAction
  {----------------------------------------------------------------------------}

  TFilletAction = Class( TEzAction )
  Private
    FPickFrame: TEzRectangle;
    FAperture: Integer;
    FCurrent: Integer;
    FFilletPoints: Array[0..1] Of TEzPoint;
    FSegment, FPickedPoints: Array[0..1] Of Integer;
    FLayer: TEzBaseLayer;
    FRecNo: Integer;
    FDefiningCurve: Boolean;
    FArc: TEzArc;
    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 );
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TPolygonSelectAction
  {----------------------------------------------------------------------------}

  { The action for selecting entities that lies inside a polygon}
  TPolygonSelectAction = Class( TEzAction )
  Private
    FPolygon: TEzPolygon;
    FCurrentIndex: Integer;
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
  Protected
    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 );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TCircleSelectAction
  {----------------------------------------------------------------------------}

  { The action for selecting inside a circle
    Note: actually I will use a polygon to draw the circle and to
    simplify the selection }
  TCircleSelectAction = Class( TEzAction )
  Private
    FPolygon: TEzPolygon;
    FCenter: TEzPoint;
    FCenterDefined: Boolean;
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
  Protected
    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 );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TMeasuresAction
  {----------------------------------------------------------------------------}

    { The action for measuring areas and perimeters in the drawing }
  TMeasuresAction = Class( TEzAction )
  Private
    FPolyline: TEzEntity;
    FCurrentIndex: Integer;
    {for handling the hint window}
    hintW: THintWindow;
    Procedure SetCurrentPoint( Pt: TEzPoint; Orto: Boolean );
    Procedure ShowAreaAndPerimeter;
  Protected
    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;

  {----------------------------------------------------------------------------}
  //                  TZoomInOutAction
  {----------------------------------------------------------------------------}

    { The action for zooming/unzooming by clicking in the drawing }
  TEzZoomAction = ( zaZoomIn, zaZoomOut );

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

  {----------------------------------------------------------------------------}
  //                  THandScrollAction
  {----------------------------------------------------------------------------}

  { The action for scrolling the drawing with a hand cursor (also known as panning) }
  THandScrollAction = Class( TEzAction )
  Private
    FOrigin: TPoint;
    FDownX, FDownY: Integer;
    FScrolling: Boolean;
    { for scrolling a preview }
    FPickedPreview: Boolean;
    FPreviewLayer: TEzBaseLayer;
    FPreviewRecno: Integer;
    FPreviewRect: TRect;
    FSavedShowWaitCursor: Boolean;
  Protected
    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 );
    destructor Destroy; override;
  End;

  {----------------------------------------------------------------------------}
  //                  TGuideLineAction
  {----------------------------------------------------------------------------}

  { the action for inserting guidelines in the drawing }
  TGuideLineAction = Class( TEzAction )
  Private
    FLine: TEzPolyLine;
    FOrientation: Integer; // 0=horizontal,1=vertical
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
  Protected
    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 MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyPaint( Sender: TObject );
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; Orientation: Integer );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TMoveGuideLineAction
  {----------------------------------------------------------------------------}

  TMoveGuideLineAction = Class( TEzAction )
  Private
    FLine: TEzPolyLine;
    FOrientation: Integer;
    FIndex: Integer;
    FDetected: Boolean;
    FMoving: Boolean;
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
    Function IsGuidelineVisible( Orientation: Integer; Index: Integer ): boolean;
  Protected
    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 DoMoveGuideline( Const P: TEzPoint );
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TSetClipAreaAction
  {----------------------------------------------------------------------------}

  TSetClipAreaAction = Class( TEzAction )
  Private
    FFrame: TEzRectangle;
    FCurrentIndex: Integer;
    FOrigin: TPoint;
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
    Procedure DoFinishClipArea;
  Protected
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );