ezcmdline.pas

很管用的GIS控件

Unit EzCmdLine;

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

{$I EZ_FLAG.PAS}
{.$DEFINE SUBCLASS_DRAWBOX}
Interface

Uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
  StdCtrls, EzLib, EzEntities, EzBaseGIS, EzSystem, EzBase ;

Type

  TEzCmdLine = Class;

  { This enumerated list the possible inputs from the user on the command line }
  TEzInputType = ( itNone,          { user typed nothing valid }
                   itFloatValue,    { user typed a single float value, like when positioning guidelines}
                   itString );      { user typed a string, ex: "Rob Brown" (double quotes included) }

  TEzStatusMessageEvent = Procedure( Sender: TObject; Const AMessage: String ) Of Object;

  TEzMeasureInfoEvent = Procedure( Sender: TObject; Const Area, Perimeter, Angle, NumPoints: Double ) Of Object;

  TEzBeforeCommandEvent = Procedure( Sender: TObject; Const Command, ActionID: String;
    Var ErrorMessage: String; Var Accept: Boolean ) Of Object;

  TEzAfterCommandEvent = Procedure( Sender: TObject; Const Command, ActionID: String ) Of Object;

  TEzShortCutEvent = Procedure( Sender: TObject; Var Command: String ) Of Object;

  { this is for executing commands with an event }
  TEzUnknownCommandEvent = Procedure( Sender: TObject; Const Command, ActionID: String;
    Var Processed: Boolean ) Of Object;

  TEzGetCursorEvent = Procedure( Sender: TObject; const Command, ActionID: String;
    var Cursor: TCursor ) Of Object;

  {-------------------------------------------------------------------------------}
  {                  Define TEzAction                                              }
  {-------------------------------------------------------------------------------}

  TEzAction = Class;

  TEzActionClass = Class Of TEzAction;

  TEzMouseDrawElements = Set Of ( mdCursor, mdCursorFrame, mdFullViewCursor );

  TEzAction = Class(TObject)
  Private
    FCmdLine: TEzCmdLine;
    FCursor: TCursor; // the cursor used in the DrawBox by the Action
    FFinished: Boolean;
    FCaption: String;
    FOldCaption: String;
    FActionID: String;
    FCanBeSuspended: Boolean;
    FWaitingMouseClick: Boolean;
    FInfoForPrevious: String;
    FCanDoOSNAP: Boolean;
    FCanDoAccuDraw: Boolean;
    { The following data is updated when the command line is parsed }
    FUserCommand: TEzInputType;
    FUserString: String;
    FUserValue: Double;
    { entity used for drawing the cursor }
    FFullViewCursor: TEzPolyLine;
    FCursorFrame: TEzRectangle;
    FMouseDrawElements: TEzMouseDrawElements;
    { After finish executing this one, start executing this }
    FChainedTo: TEzAction;
    FLauncher: TComponent; { defined when launched from TEzActionLauncher }
    FLastClicked: TEzPoint;

    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;

    Procedure SetFullViewCursorPos(Const Pt: TEzPoint);
    Procedure DrawFullViewCursor(Sender: TObject = Nil);
    Procedure EraseFullViewCursor;
    Procedure SetCaption( Const Value: String );
    { this is used in order to cancel a command if a DrawBox is not
      of the expected type }
    Function AcceptDrawBox: Boolean; {Dynamic;}
  Public
    { methods }
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;
    Procedure UndoOperation; Dynamic;
    Procedure ParseUserCommand( Const Cmd: String );
    Procedure SuspendOperation;
    Procedure ContinueOperation;

    { When this property is assigned, it will be linked to the Action that is
      pointing to }
    Property Finished: Boolean Read FFinished Write FFinished;
    Property WaitingMouseClick: Boolean Read FWaitingMouseClick Write FWaitingMouseClick;
    Property InfoForPrevious: String Read FInfoForPrevious Write FInfoForPrevious;
    Property UserCommand: TEzInputType Read FUserCommand Write FUserCommand;
    Property UserString: String Read FUserString Write FUserString;
    Property UserValue: Double Read FUserValue Write FUserValue;
    Property MouseDrawElements: TEzMouseDrawElements read FMouseDrawElements write FMouseDrawElements;
    Property LastClicked: TEzPoint read FLastClicked write FLastClicked;

    { previous version these properties was in the published section }
    Property ChainedTo: TEzAction Read FChainedTo Write FChainedTo;
    Property CanDoOSNAP: Boolean Read FCanDoOSNAP Write FCanDoOSNAP;
    Property CanDoAccuDraw: Boolean Read FCanDoAccuDraw Write FCanDoAccuDraw;
    Property ActionID: String Read FActionID Write FActionID;
    Property CanBeSuspended: Boolean Read FCanBeSuspended Write FCanBeSuspended;
    Property Caption: String Read FCaption Write SetCaption;
    Property Cursor: TCursor Read FCursor Write FCursor;
    Property CmdLine: TEzCmdLine Read FCmdLine Write FCmdLine;
    Property Launcher: TComponent read FLauncher write FLauncher;

    { events }
    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;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TEzCmdLine class                                        }
  {-------------------------------------------------------------------------------}

  TEzCmdLineEdit = Class( TEdit )
  Protected
    Procedure KeyPress( Var Key: Char ); Override;
  End;

  TEzFrameStyle = ( fsRectangular, fsPolar );

  TEzAccuDraw = Class( TPersistent )
  Private
    FOwner: TEzCmdLine;
    FEnabled: Boolean;
    FShowing: Boolean;
    FSnapUnRotated: Boolean;
    FRotateToSegments: Boolean;
    { means that AccuDraw can be snapped to the axis marks. True by default }
    FSnapToAxis: Boolean;
    { Can be snapped to a distance }
    FSnapSameDistance: Boolean;
    { It's a frame, polar or absolute coordinates ?}
    FFrameStyle: TEzFrameStyle;
    FDeltaX: Double;
    FDeltaY: Double;
    { is any distance currently locked ?}
    FDeltaXLocked: Boolean;
    FDeltaYLocked: Boolean;
    { the colors for every axis and frame }
    FXAxisColor: TColor;
    FYAxisColor: TColor;
    FHiliteColor: TColor;
    FFrameColor: TColor;
    FSnapColor: TColor;
    { width of frame in pixels default 80 }
    FWidth: Integer;
    { is the tolerance, in pixels that allows to AccuDraw to snap to the axxis }
    FTolerance: Byte;
    { switch to one beyond on reshaping entities (used for aligning perpend
      to other line segment ) }
    FReshapeAdvance: Boolean;
    FCtrlAltSuspend: Boolean;

    { Local variables }

    FAccuOrigin: TEzPoint;  // origin of accudraw
    FRotangle: Double;      // rotation angle

    FLastDistance: Double;  // last used distance
    { The following is the list of entities used for showing rubber banding
      for the accudraw snapped points (locked to axis, snapped by using accusanp, etc.)
    }
    FRubberList: TEzEntityList;

    { this flag is set when the current point is snapped to an axis (rotated or not) }
    FIsSnappedToAxis: Boolean;
    { this flag is set when the current point is snapped to the last distance }
    FIsSnappedToDistance: Boolean;
    { used to flag that a perpend point was found from one point that is
      snapped to the AccuSnap, a guideline or the grid.
      This is flagged from TEzCmdLine}
    FPerpendFound: Boolean;
    { the perpendicular point }
    FPerpendFrom: TEzPoint;

    procedure SetFrameColor(const Value: TColor);
    procedure SetHiliteColor(const Value: TColor);
    procedure SetWidth(Value: Integer);
    procedure SetXAxisColor(const Value: TColor);
    procedure SetYAxisColor(const Value: TColor);
    procedure SetDeltaX(const Value: Double);
    procedure SetDeltaY(const Value: Double);
    procedure SetShowing(const Value: Boolean);
    procedure SetFrameStyle(const Value: TEzFrameStyle);
    procedure SetTolerance(const Value: Byte);
    procedure SetEnabled(const Value: Boolean);
    { semi-public procedures }
    procedure Reset;
    procedure DrawSnaps(Reversed: Boolean = False);
    procedure DrawAuxLines;
    procedure EraseAuxLines;
    Function GetSnappedPoint: TEzPoint;
    Procedure Draw;
    procedure SetRotangle(const Value: Double);
  Public
    Constructor Create( AOwner: TEzCmdLine );
    Destructor Destroy; Override;
    Procedure UpdatePosition( const FromPt, ToPt: TEzPoint; Reversed: Boolean = False );
    Procedure ChangeOrigin( Origin: TEzPoint; const Angle: Double = 0 );
    Procedure ShowUnRotated;
    procedure CurrentDimensions( Var DX, DY: Double );
    procedure Change;

    Property Showing: Boolean read FShowing write SetShowing;
    { displacement of current point (FAccuOrigin) }
    Property DeltaX: Double read FDeltaX write FDeltaX;
    Property DeltaY: Double read FDeltaY write FDeltaY;
    { same as above but for polar }
    Property Dist: Double read FDeltaX write SetDeltaX;
    Property Angle: Double read FDeltaY write SetDeltaY;

    { current origin of AccuDraw object on screen (FAccuOrigin) }
    Property AccuOrigin: TEzPoint read FAccuOrigin write FAccuOrigin;
    Property Rotangle: Double read FRotangle write SetRotangle;

    Property DeltaXLocked: Boolean read FDeltaXLocked write FDeltaXLocked;
    Property DeltaYLocked: Boolean read FDeltaYLocked write FDeltaYLocked;
    { same as above but for polar }
    Property DistLocked: Boolean read FDeltaXLocked write FDeltaXLocked;
    Property AngleLocked: Boolean read FDeltaYLocked write FDeltaYLocked;

    Property FrameStyle: TEzFrameStyle read FFrameStyle write SetFrameStyle default fsRectangular;

  Published
    { published properties }
    Property ReshapeAdvance: Boolean read FReshapeAdvance write FReshapeAdvance;
    Property SnapUnRotated: Boolean read FSnapUnRotated write FSnapUnRotated default true;
    Property Enabled: Boolean read FEnabled write SetEnabled default true;
    Property Width: Integer read FWidth write SetWidth default 80;
    Property XAxisColor: TColor read FXAxisColor write SetXAxisColor default clRed;
    Property YAxisColor: TColor read FYAxisColor write SetYAxisColor default clLime;
    Property HiliteColor: TColor read FHiliteColor write SetHiliteColor default clBlack;
    Property FrameColor: TColor read FFrameColor write SetFrameColor default clBlue;
    Property SnapColor: TColor read FSnapColor write FSnapColor default clBlack;
    Property SnapToAxis: Boolean read FSnapToAxis write FSnapToAxis default True;
    Property Tolerance: Byte read FTolerance write SetTolerance default 10;
    Property RotateToSegments: Boolean read FRotateToSegments write FRotateToSegments default true;
    Property SnapSameDistance: Boolean read FSnapSameDistance write FSnapSameDistance default true;
    Property CtrlAltSuspend: Boolean read FCtrlAltSuspend write FCtrlAltSuspend default true;
  End;

  { the info for the current snapped point }
  TEzAccuSnapInfo = Record
    { position on the viewport in pixels }
    Pos: TPoint;
    { the current bitmap visible on screen }
    Picture: TBitmap;
    { the current snap setting }
    SnapSetting: TEzOSNAPSetting;
    { the current snapped point }
    SnapPoint: TEzPoint;
    { the entity that was accusnapped}
    Layer: TEzBaseLayer;
    Recno: Integer;
    { is currently showing on screen ?}
    Showing: Boolean;
    { used when SnapSetting = osPerpend, osParallel }
    RefFrom: TEzPoint;
    RefTo: TEzPoint;
    IsNextParallel: Boolean;
  End;

  { TEzAccuSnap }
  TEzAccuSnap = class(TPersistent)
  private
    FOwner: TEzCmdLine;
    FEnabled: Boolean;
    // value between 0 and 100 that indicates the sensitivity of the snapping
    FSensitivity: Byte;
    FOsnapSetting: TEzOSNAPSetting;
    FOverrideOsnapSetting: TEzOSNAPSetting;
    FOverrideOsnap: Boolean;
    FSnapDivisor: Byte;
    FCtrlShiftSuspend: Boolean;
    FHiliteSnapped: Boolean;

    { temporary used }
    FCurrentSnapInfo: TEzAccuSnapInfo;
    FSnapLayerName: string;
    FInSearch: Boolean;
    Procedure EraseFromScreen;
    Procedure UpdateAccuSnapEntity;
    Procedure DrawAccuSnap( Draw: Boolean );
    procedure SetEnabled(const Value: Boolean);
    procedure SetOverrideOsnapSetting(const Value: TEzOSNAPSetting);
    procedure SetOsnapSetting(const Value: TEzOSNAPSetting);
    procedure SetOverrideOsnap(const Value: Boolean);
  public
    { set to some layer name for snapping only to that layer }
    Constructor Create(AOwner: TEzCmdLine);
    Destructor Destroy; Override;
    Function GetCurrentOsnapSetting: TEzOsnapSetting;
    procedure Change;

    Property SnapLayerName: string read FSnapLayerName write FSnapLayerName;
    Property OverrideOsnapSetting: TEzOSNAPSetting read FOverrideOsnapSetting write SetOverrideOsnapSetting;
    Property OverrideOsnap: Boolean read FOverrideOsnap write SetOverrideOsnap;
    Property HiliteSnapped: Boolean read FHiliteSnapped Write FHiliteSnapped;
  published
    Property Sensitivity: Byte read FSensitivity write FSensitivity default 100;
    Property OsnapSetting: TEzOSNAPSetting read FOsnapSetting write SetOsnapSetting default osKeyPoint;
    Property SnapDivisor: Byte read FSnapDivisor write FSnapDivisor default 2;
    Property Enabled: Boolean read FEnabled write SetEnabled default true;
    Property CtrlShiftSuspend: Boolean read FCtrlShiftSuspend write FCtrlShiftSuspend default True;
  end;


  { Follows the list of draw box that can be connected to the same TEzCmdLine }

  {---------------------------------------------------------------------------}
  {                  Define TEzDrawBoxItem                                    }
  {---------------------------------------------------------------------------}

  TEzDrawBoxItem = Class( TCollectionItem )
  Private
    FDrawBox: TEzBaseDrawBox;
    FCurrent: Boolean;
    { Events hooks for the drawbox }
{$IFDEF SUBCLASS_DRAWBOX}
    FNewWndProc, FOldWndProc: Pointer;
    FSavedPaint: TNotifyEvent;
{$ELSE}
    FSavedMouseDown: TEzMouseEvent;
    FSavedMouseMove: TEzMouseMoveEvent;
    FSavedMouseUp: TEzMouseEvent;
    FSavedClick: TNotifyEvent;
    FSavedDblClick: TNotifyEvent;
    FSavedKeyPress: TKeyPressEvent;
    FSavedKeyDown: TKeyEvent;
    FSavedKeyUp: TKeyEvent;
    FSavedPaint: TNotifyEvent;
    FSavedMouseEnter: TNotifyEvent;
    FSavedMouseLeave: TNotifyEvent;
{$ENDIF}
    Procedure SetDrawBox( Value: TEzBaseDrawBox );
    Procedure SetCurrent( Value: Boolean );
{$IFDEF SUBCLASS_DRAWBOX}
    procedure SubClassedWinProc(var Msg: TMessage);
{$ENDIF}
  Protected
    Function GetDisplayName: String; Override;
  Public
    Destructor Destroy; Override;
    Procedure Assign( Source: TPersistent ); Override;
  Published