⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ezactionlaunch.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
unit EzActionLaunch;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}
Interface

Uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, ExtCtrls, Forms,
  Dialogs, EzBase, EzBaseGIS, EzLib, EzCmdLine, EzSystem, EzEntities,
  EzMiscelEntities ;

Type

  TEzCircleDrawType = ( ct2P, ct3P, ctCR );

  { if you return TrackedEntity = Nil, then you must dispose the entity passed
    on that parameter }
  TEzTrackedEntityEvent = Procedure(Sender: TObject; const TrackID: string;
    var TrackedEntity: TEzEntity ) Of Object;

  { this is for event OnTrackedEntityClick.
    Important ! If Layer = Nil and Recno = 0, it means that end-user clicked on the map
    but no entity was found, so you must always check and proceed accordingly }
  TEzTrackEntityClickEvent = Procedure( Sender: TObject; const TrackID: string;
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Const WX, WY: Double;
    Layer: TEzBaseLayer; Recno: Integer; Var Accept: Boolean ) Of Object;

  { tracks when mouse is moved (not clicked) over and entity. This is checked every
    TEzBaseDrawbox.DelayShowHint elapsed time (in milliseconds )
    Important! If Layer = Nil and Recno = 0 then that means that no entity was
    found under mouse when the time elapsed (We must check in a time delay
    because the search can be time consuming )}
  TEzTrackEntityMouseMoveEvent = Procedure( Sender: TObject; const TrackID: string;
    Layer: TEzBaseLayer; Recno: Integer; Var Accept: Boolean ) Of Object;

  TEzTrackEntityDragDropEvent = Procedure ( Sender: TObject; const TrackID: string;
    Layer: TEzBaseLayer; Recno: Integer; Var TrackedEntity: TEzEntity ) Of Object;

  TEzActionLauncher = Class(TComponent)
  Private
    FCmdLine: TEzCmdLine;       // linked to this CmdLine
    FCursor: TCursor;           // the cursor used for the action
    { following are mainly used in a generic action tracking }
    FFinished: Boolean;
    FCurrentAction: TEzAction;
    FCanDoOsnap: Boolean;
    FCanDoAccuDraw: Boolean;
    FMouseDrawElements: TEzMouseDrawElements;

    { tracking events }
    FOnTrackedEntity: TEzTrackedEntityEvent;
    FOnTrackedEntityClick: TEzTrackEntityClickEvent;
    FOnTrackedEntityMouseMove: TEzTrackEntityMouseMoveEvent;
    FOnTrackedEntityDragDrop: TEzTrackEntityDragDropEvent;

    { generic action events ( TrackGenericAction event }
    FOnMouseDown: TEzMouseEvent;
    FOnMouseMove: TEzMouseMoveEvent;
    FOnMouseUp: TEzMouseEvent;
    FOnPaint: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnKeyDown: TKeyEvent;
    FOnKeyPress: TKeyPressEvent;
    FOnKeyUp: TKeyEvent;
    FOnActionDoCommand: TNotifyEvent;
    FOnSuspendOperation: TNotifyEvent;
    FOnContinueOperation: TNotifyEvent;
    FOnUndo: TNotifyEvent;
    FOnInitialize: TNotifyEvent;
    FOnFinished: TNotifyEvent;
    procedure PushAction( const TrackID: string );
    procedure SetCmdLine(const Value: TEzCmdLine);
    function GetDefaultAction: Boolean;
    procedure SetDefaultAction(const Value: Boolean);
    function GetCurrentTrackID: string;
    function GetCaption: String;
    procedure SetCaption(const Value: String);
    function GetStatusMessage: string;
    procedure SetStatusMessage(const Value: string );
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
  Public
    Constructor Create(AOwner: TComponent); Override;
    { causes to finish immediately.
      please don't call this method inside an event handler of TEzActionLauncher }
    Procedure Finish;

    { track entity given in TrackedEntity parameter. You must prebuilt the
      entity with your choice of attributes.
      This method and TrackXXX (XXX=polygon,polyline,etc) will fire event
      OnTrackedEntity.
      You can define the TrackedEntity variable instance to nil in that event
      in order to avoid this method to dispose internally }
    Procedure TrackEntity( const TrackID: string; TrackedEntity: TEzEntity );

    { track entity defined by name of method. Entity is built
      internally with default attributes.
      For other entities you must use previous method: TrackEntity. In event
      OnTrackedEntity you can define variable instance to nil if you will
      use the entity internally and the instance will not be disposed
      internally }
    Procedure TrackPolygon( const TrackID: string );
    Procedure TrackPolyline( const TrackID: string );
    Procedure TrackSketch( const TrackID: string );
    Procedure TrackRectangle( const TrackID: string;
      ScaledWidth: Integer = 0; ScaledHeight: Integer=0 );
    Procedure TrackPlace( const TrackID: string );
    Procedure TrackArc3P( const TrackID: string );
    Procedure TrackArcSE( const TrackID: string );
    Procedure TrackEllipse( const TrackID: string );
    Procedure TrackSpline( const TrackID: string );
    Procedure TrackPoint( const TrackID: string );
    procedure TrackPictureRef(const TrackID, FileName: string);
    procedure TrackBandsBitmap(const TrackID, FileName: string);
    procedure TrackBlock(const TrackID, BlockName: string;
      const Rotangle, ScaleX, ScaleY: Double );

    { track a circle that can be draw with three methods:
      2 points; 3 points; or Center and Radius. Circle is
      created and disposed internally. This method also will fire event
       OnTrackedEntity }
    Procedure TrackCircle( const TrackID: string; DrawType: TEzCircleDrawType );

    { track a buffer. This fire event OnTrackedEntity }
    Procedure TrackBuffer( const TrackID: string );

    { This method will fire event OnTrackedEntityClick when an entity on the
      map is clicked. You also can use event TEzDrawBox.OnEntityClick }
    Procedure TrackEntityClick( const TrackID: string; Const LayerName: string = '';
      HighlightClicked: Boolean = True );

    { this method will detect which entity is under mouse when you move the
      mouse over entities on the map/drawing. Can be used for showing your own
      hints or other kind of actions. This method will fire method
      OnTrackedEntityMouseMove }
    Procedure TrackEntityMouseMove( const TrackID: string;
      Const LayerName: string = ''; HighlightDetected: Boolean = True );

    { this method will track the moving of an entity on the map/drawing. If the method is
     succesful, then event OnTrackedEntityDragDrop is fired }
    Procedure TrackEntityDragDrop( const TrackID: string );

    { generic track action. You can use the following events in order
      to code specific action;
       OnMouseDown;
       OnMouseMove;
       OnMouseUp;
       OnClick;
       OnDblClick;
       OnKeyDown;
       OnKeyPress;
       OnKeyUp;
       OnActionDoCommand;
       OnSuspendOperation;
       OnContinueOperation;
       OnUndo;
       OnInitialize;
     }
    Procedure TrackGenericAction( const TrackID: string );
    Function IsRunning: Boolean;

    Property DefaultAction: Boolean read GetDefaultAction Write SetDefaultAction;
    Property CurrentTrackID: string read GetCurrentTrackID;
    Property Caption: String Read GetCaption Write SetCaption;
    Property TrackID: string read GetCurrentTrackID;
    Property CurrentAction: TEzAction read FCurrentAction write FCurrentAction;
    Property StatusMessage: string read GetStatusMessage write SetStatusMessage;
    { when true, causes to finish when an event returns. You must set this inside
      an event handler only.
     }
    Property Finished: Boolean read FFinished write FFinished;
  Published
    { properties }
    Property About: TEzAbout read GetAbout write SetAbout;
    Property CmdLine: TEzCmdLine read FCmdLine write SetCmdLine;
    Property Cursor: TCursor read FCursor write FCursor default crCross;
    Property CanDoOsnap: Boolean read FCanDoOsnap write FCanDoOsnap;
    Property CanDoAccuDraw: Boolean read FCanDOAccuDraw write FCanDOAccuDraw;
    Property MouseDrawElements: TEzMouseDrawElements read FMouseDrawElements write FMouseDrawElements;

    { events }
    Property OnTrackedEntity: TEzTrackedEntityEvent read FOnTrackedEntity write FOnTrackedEntity;
    Property OnTrackedEntityClick: TEzTrackEntityClickEvent read FOnTrackedEntityClick write FOnTrackedEntityClick;
    Property OnTrackedEntityMouseMove: TEzTrackEntityMouseMoveEvent read FOnTrackedEntityMouseMove write FOnTrackedEntityMouseMove;
    Property OnTrackedEntityDragDrop: TEzTrackEntityDragDropEvent read FOnTrackedEntityDragDrop write FOnTrackedEntityDragDrop;

    { for generic action (TrackGenericAction method ) }
    Property OnMouseDown: TEzMouseEvent Read FOnMouseDown Write FOnMouseDown;
    Property OnMouseMove: TEzMouseMoveEvent Read FOnMouseMove Write FOnMouseMove;
    Property OnMouseUp: TEzMouseEvent Read FOnMouseUp Write FOnMouseUp;
    Property OnPaint: TNotifyEvent Read FOnPaint Write FOnPaint;
    Property OnClick: TNotifyEvent Read FOnClick Write FOnClick;
    Property OnDblClick: TNotifyEvent Read FOnDblClick Write FOnDblClick;
    Property OnKeyDown: TKeyEvent Read FOnKeyDown Write FOnKeyDown;
    Property OnKeyPress: TKeyPressEvent Read FOnKeyPress Write FOnKeyPress;
    Property OnKeyUp: TKeyEvent Read FOnKeyUp Write FOnKeyUp;
    Property OnActionDoCommand: TNotifyEvent Read FOnActionDoCommand Write FOnActionDoCommand;
    Property OnSuspendOperation: TNotifyEvent Read FOnSuspendOperation Write FOnSuspendOperation;
    Property OnContinueOperation: TNotifyEvent Read FOnContinueOperation Write FOnContinueOperation;
    Property OnUndo: TNotifyEvent Read FOnUndo Write FOnUndo;
    Property OnInitialize: TNotifyEvent Read FOnInitialize Write FOnInitialize;
    Property OnFinished: TNotifyEvent read FOnFinished write FOnFinished;
  End;


  {-------------------------------------------------------------------------------}
  {                  TAddEntityAction                                             }
  {-------------------------------------------------------------------------------}

  TAddEntityAction = Class(TEzAction)
  Private
    FEntity: TEzEntity;
    FCurrentIndex: Integer;
    FImgDims: TPoint;
    FIsImage: Boolean;
    FDrawImmediately: Boolean;
    Procedure DrawEntityRubberToAll( DrawBox: TEzBaseDrawBox );
    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 );
    Procedure AddPoint( const CurrPoint: TEzPoint );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; Ent: TEzEntity;
      Const ImgDims: TPoint );
    Destructor Destroy; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  TAddEntityAction                                             }
  {-------------------------------------------------------------------------------}

  TSketchAction = Class(TEzAction)
  Private
    FEntity: TEzEntity;
    FCurrentIndex: Integer;
    FIsDrawing: Boolean;
    Procedure SetCurrentPoint( 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 );
    Procedure AddPoint( const CurrPoint: TEzPoint );
    Procedure CleanEntity;
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; Ent: TEzEntity );
    Destructor Destroy; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  TDrawCircleAction                                              }
  {-------------------------------------------------------------------------------}

  TDrawCircleAction = Class( TEzAction )
  Private
    FPts: Array[0..2] Of TEzPoint;
    FCircle: TEzEntity;
    FCurrentIndex: Integer;
    FCircleDrawType: TEzCircleDrawType;
    Function IndexLimit: 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 CreateCircle;
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction(  CmdLine: TEzCmdLine;
      CircleDrawType: TEzCircleDrawType );
    Destructor Destroy; Override;
  End;


  {-------------------------------------------------------------------------------}
  {                  TDrawCircleAction                                              }
  {-------------------------------------------------------------------------------}

  TDrawArcMethod = (damCRS, damFCS);
    //damCRS = (C)enter, (R)adius, (S)weep angle
    //damFCS = (F)irst arc end point, (C)enter, (S)weep angle

  // draw an arc by marking first circle, then start angle, then end angle
  TDrawArcAction = Class( TEzAction )
  Private
    FPts: Array[0..1] Of TEzPoint;
    FCircle: TEzEntity;
    FArc: TEzEntity;
    FDefiningCircle: Boolean;
    FCurrentIndex: Integer;
    FRadiusLines: TEzEntity;
    FIsCounterClockWise: Boolean;
    FMethod: TDrawArcMethod;
    FLastPoint: TEzPoint;
    procedure DrawRubberCircle(Sender: TObject = Nil);
    procedure DrawRubberArc(Sender: TObject = Nil);
    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 CreateCircle;
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; Method: TDrawArcMethod = damCRS );
    Destructor Destroy; Override;
  End;

  {-------------------------------------------------------------------------------}
  //                  TBufferSelectAction
  {-------------------------------------------------------------------------------}

  TBufferSelectAction = Class( TEzAction )
  Private
    FLine: TEzPolyLine;
    FPolyline: TEzPolyLine;
    FPolygon: TEzPolygon;
    FCurrentIndex: Integer;
    FDistance: Double;
    FReferenceDefined: Boolean;
    Procedure SetCurrentPoint( Const Pt: TEzPoint );
    Procedure CalcPolygon;
    Procedure DrawRubberEntityDotted(Entity: TEzEntity; Sender: TObject=Nil);
  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;


  {-------------------------------------------------------------------------------}
  //                  TAddVectorialTextAction
  {-------------------------------------------------------------------------------}

  { the add vectorial text action display a dialog box asking for the text
    to add and the justification }
  TAddVectorialTextAction = Class( TEzAction )
  Private
    FFrame: TEzRectangle;
    FCurrentIndex: Integer;
    FOrigin: TPoint;
    FIsJustifiedText: Boolean;
    FTextBorderStyle: TEzTextBorderStyle;
    FVectorialText: TEzEntity;
    Procedure DoAddTheText;
    Procedure SetCurrentPoint( 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:

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -