ezcmdline.pas

很管用的GIS控件

    Property DrawBox: TEzBaseDrawbox Read FDrawBox Write SetDrawBox;
    Property Current: Boolean Read FCurrent Write SetCurrent;
  End;

  {---------------------------------------------------------------------------}
  {                  Define TEzDrawBoxCollection                              }
  {---------------------------------------------------------------------------}

  TEzDrawBoxCollection = Class( TOwnedCollection )
  Private
    FCmdLine: TEzCmdLine;
    Function GetItem( Index: Integer ): TEzDrawBoxItem;
    Procedure SetItem( Index: Integer; Value: TEzDrawBoxItem );
  Public
    Constructor Create( AOwner: TPersistent );
    Function Add: TEzDrawBoxItem;
    Function Find(DrawBox: TEzBaseDrawBox): Boolean;
    Function FindCurrent: TEzDrawBoxItem;
    Function FindItem(Sender: TObject): TEzDrawBoxItem;
    Procedure SetCurrent( Value: TObject );
    Property Items[Index: Integer]: TEzDrawBoxItem Read GetItem Write SetItem; Default;
  End;

  { TEzCmdLine }
  TEzCmdLine = Class( TWinControl )
  Private
    FDrawBoxList: TEzDrawBoxCollection;
    FEdit: TEzCmdLineEdit;
    FLabel: TLabel;
    FActionList: TList;
    FTheDefaultAction: TEzAction;
    FUseOrto: Boolean;
    FRepaintRect: TEzRect;
    FCurrentPoint: TEzPoint;
    FShortCuts, FDisabledCommands: TStrings;
    FGLSnapAperture: TPoint;
    { for AccuSnap }
    FAccuSnap: TEzAccuSnap;
    //FWasSnapped: Boolean;
    { if <> '', then only that layer name will be used for snapping }
    FIsMouseDown: Boolean;
    { AccuDraw }
    FAccuDraw: TEzAccuDraw;
    FDefaultCanTransform: Boolean;

    // Command line processing
    FLastCommand: String;
    FLastActionID: String;
    FDeletingActionID: string;
    FBorderStyle: TBorderStyle; {border style to use}
    FUseFullViewCursor: Boolean;
    FClearing: Boolean;
    FShowMeasureInfoWindow: Boolean;
    FDynamicUpdate: Boolean;

    { event handlers }
    FOnActionChange: TNotifyEvent;
    FOnStatusMessage: TEzStatusMessageEvent;
    FOnMeasureInfo: TEzMeasureInfoEvent;
    FOnBeforeCommand: TEzBeforeCommandEvent;
    FOnAfterCommand: TEzAfterCommandEvent;
    FOnShortCut: TEzShortCutEvent;
    FOnUnknownCommand: TEzUnKnownCommandEvent;
    FOnGetCursor: TEzGetCursorEvent;
    FOnAccuDrawActivate: TNotifyEvent;
    FOnAccuDrawChange: TNotifyEvent;
    FOnAccuSnapChange: TNotifyEvent;

    Function GetActiveDrawBox: TEzBaseDrawBox;
    Procedure SetActiveDrawBox(Value: TEzBaseDrawBox);
    Procedure InternalDoCommand( Const Cmd, ActionID: String; IsParam: Boolean );
    Procedure SetTheDefaultAction( Value: TEzAction );
    // command line processing
    Procedure SetShortCuts( Value: TStrings );
    Procedure SetDisabledCommands( Value: TStrings );
    Procedure SetStatusMessage( Const Value: String );

    procedure DoMouseEnter(Sender: TObject);
    procedure DoMouseLeave(Sender: TObject);
    Procedure DoMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure DoMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure DoMouseUp( Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure DoKeyPress( Sender: TObject; Var Key: Char );
    Procedure DoPaint( Sender: TObject );
    Procedure DoKeyDown( Sender: TObject; var Key: Word; Shift: TShiftState);
    Procedure DoKeyUp( Sender: TObject; var Key: Word; Shift: TShiftState);
    //Procedure DoClick( Sender: TObject );
    Procedure DoDblClick( Sender: TObject );

    Procedure SetBorderStyle( Const Value: forms.TBorderStyle );
    Procedure CMColorChanged( Var Message: TMessage ); Message CM_COLORCHANGED;
    Function GetText: String;
    Procedure SetText( Const Value: String );
    Function GetCaption: String;
    Procedure SetCaption( Const Value: String );
    Procedure CMFontChanged( Var Message: TMessage ); Message CM_FONTCHANGED;
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
    procedure SetDrawBoxList(const Value: TEzDrawBoxCollection);
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
  Public
    FLastClicked: TEzPoint;
  {$IFDEF IS_OCX}
    FOCX_Owner : IUnknown;
  {$ENDIF}
    { methods }
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Procedure CreateParams( Var Params: TCreateParams ); Override;
    Function CurrentAction: TEzAction;
    Function PreviousAction: TEzAction;
    Procedure KillAction( var Action: TEzAction );
    Procedure Clear;
    Procedure Push( Action: TEzAction; ClearBefore: Boolean; Const Cmd, ActionID: String );
    Procedure Pop;
    // command line processing
    Procedure DoCommand( Const Cmd, ActionID: String );
    Procedure CurrentActionDoCommand( Const Cmd: String );
    Function IsBusy: Boolean;
    Procedure CaptionChange( Const Value: String );
    Function IsSnapped: Boolean;
    Function CurrentActionID: String;
    Function GetSnappedPoint(): TEzPoint;
    Procedure AddPointToCurrentAction( const P: TEzPoint );
    Procedure AddRelativePointToCurrentAction( const P: TEzPoint );
    Procedure AddRelativeAngleToCurrentAction( const Dist, Angle: Double );
    Procedure AddPointListToCurrentAction( const P: TEzVector );

    { follows the methods and properties that will affect to all drawboxes }
    Procedure All_Cursor(Value: TCursor);
    Procedure All_DrawEntity2DRubberBand( Entity: TEzEntity; CtrlPts:
      Boolean = False; TransfPts: Boolean=False );
    Procedure All_Invalidate;
    Procedure All_Refresh;
    Procedure All_Repaint;
    Procedure All_RepaintRect(const Value: TEzRect);

    { properties }
    Property ActiveDrawBox: TEzBaseDrawBox Read GetActiveDrawBox write SetActiveDrawBox;
    Property CurrentPoint: TEzPoint Read FCurrentPoint Write FCurrentPoint;
    Property RepaintRect: TEzRect Read FRepaintRect Write FRepaintRect;
    //Property ActionList: TList Read FActionList;
    Property LastCommand: String Read FLastCommand Write FLastCommand;
    Property LastActionID: String Read FLastActionID Write FLastActionID;
    // command line processing
    Property Caption: String Read GetCaption Write SetCaption;
    Property UserInput: String Read GetText Write SetText;
    Property StatusMessage: String Write SetStatusMessage;
    Property UseOrto: Boolean Read FUseOrto Write FUseOrto;
    Property TheDefaultAction: TEzAction Read FTheDefaultAction Write SetTheDefaultAction;
    Property DeletingActionID: string read FDeletingActionID;
    Property IsMouseDown: Boolean read FIsMouseDown;

  Published

    Property About: TEzAbout read GetAbout write SetAbout;
    Property DrawBoxList: TEzDrawBoxCollection read FDrawBoxList write SetDrawBoxList;
    Property AccuDraw: TEzAccuDraw read FAccuDraw;
    Property AccuSnap: TEzAccuSnap read FAccuSnap;
    Property ShortCuts: TStrings Read FShortCuts Write SetShortCuts;
    Property DisabledCommands: TStrings Read FDisabledCommands Write SetDisabledCommands;
    Property ShowMeasureInfoWindow: Boolean Read FShowMeasureInfoWindow Write FShowMeasureInfoWindow Default True;
    Property BorderStyle: TBorderStyle Read FBorderStyle Write SetBorderStyle Default bsSingle;
    Property UseFullViewCursor: Boolean Read FUseFullViewCursor Write FUseFullViewCursor Default True;
    { this causes to scroll and to realtime zooming dynamically, although this
      consumes more memory }
    Property DynamicUpdate: Boolean read FDynamicUpdate write FDynamicUpdate;
    Property DefaultCanTransform: Boolean read FDefaultCanTransform write FDefaultCanTransform;

    {inherited properties}
    Property Font;
    Property Color;
    Property Align;
    Property Ctl3D;
    Property Enabled;
    Property ParentShowHint;
    Property ShowHint;
    Property TabOrder;
    Property TabStop Default True;
    Property Visible;

    Property OnEnter;
    Property OnExit;

    // events
    Property OnAccuDrawActivate: TNotifyEvent read FOnAccuDrawActivate write FOnAccuDrawActivate;
    Property OnAccuDrawChange: TNotifyEvent read FOnAccuDrawChange write FOnAccuDrawChange;
    Property OnAccuSnapChange: TNotifyEvent read FOnAccuSnapChange write FOnAccuSnapChange;
    Property OnGetCursor: TEzGetCursorEvent read FOnGetCursor write FOnGetCursor;
    Property OnActionChange: TNotifyEvent Read FOnActionChange Write FOnActionChange;
    Property OnStatusMessage: TEzStatusMessageEvent Read FOnStatusMessage Write FOnStatusMessage;
    Property OnMeasureInfo: TEzMeasureInfoEvent Read FOnMeasureInfo Write FOnMeasureInfo;
    Property OnBeforeCommand: TEzBeforeCommandEvent Read FOnBeforeCommand Write FOnBeforeCommand;
    Property OnAfterCommand: TEzAfterCommandEvent Read FOnAfterCommand Write FOnAfterCommand;
    Property OnShortCut: TEzShortCutEvent Read FOnShortCut Write FOnShortCut;
    Property OnUnknownCommand: TEzUnknownCommandEvent Read FOnUnknownCommand Write FOnUnknownCommand;
  End;

Implementation

Uses
  Math, ezconsts, ezscrlex, ezscryacc, ezactions, EzActionLaunch;

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

Constructor TEzAction.CreateAction( CmdLine: TEzCmdLine );
Var
  p: TEzPoint;
Begin
  Inherited Create;

  FLastClicked:= INVALID_POINT;

  FCmdLine := CmdLine;
  FCanBeSuspended := true;
  { for drawing a full view cursor}
  p := Point2D( 0, 0 );
  FFullViewCursor := TEzPolyLine.CreateEntity( [p, p, p, p] );
  With FFullViewCursor.Points Do
  Begin
    Parts.Add( 0 );
    Parts.Add( 2 );
  End;
  FCursorFrame := TEzRectangle.CreateEntity( Point2D( 0, 0 ), Point2D( 0, 0 ) );
  FCursorFrame.ID:= -2;    // flag for not drawing interior axis when rubber banding

  FMouseDrawElements:= [mdCursor];

  FCursor := crDefault;

End;

Destructor TEzAction.Destroy;
Begin
  With FCmdLine Do
    If Assigned( FCmdLine ) And ( FCmdLine.TheDefaultAction <> Self )
       And Assigned( OnAfterCommand ) Then
      OnAfterCommand( FCmdLine, LastCommand, LastActionID );
  FFullViewCursor.Free;
  FCursorFrame.Free;
  If Assigned( FLauncher ) then
    TEzActionLauncher( FLauncher ).CurrentAction := Nil;
  Inherited Destroy;
End;

Procedure TEzAction.DrawFullViewCursor(Sender: TObject = Nil);
Var
  DrawBox: TEzBaseDrawBox;
Begin
  If Sender= Nil Then
    DrawBox:= FCmdLine.ActiveDrawBox
  Else
    DrawBox:= Sender as TEzBaseDrawbox;
  With DrawBox Do
  Begin
    RubberPen.Style:= psSolid;
    If FCmdLine.UseFullViewCursor And (mdFullViewCursor In FMouseDrawElements) Then
      DrawEntityRubberBand( FFullViewCursor );
    If mdCursorFrame In FMouseDrawElements Then // Or (Self.CanDoOsnap And FCmdLine.FAccuSnap.FEnabled) Then
      DrawEntityRubberBand( Self.FCursorFrame );
  End;
End;

{ draw in reverse order in order to erase }
Procedure TEzAction.EraseFullViewCursor;
Begin
  With FCmdLine.ActiveDrawBox Do
  Begin
    RubberPen.Style:= psSolid;
    If mdCursorFrame In FMouseDrawElements Then
      DrawEntityRubberBand( Self.FCursorFrame );
    If FCmdLine.UseFullViewCursor And (mdFullViewCursor In FMouseDrawElements) Then
      DrawEntityRubberBand( FFullViewCursor );
  End;
End;

Procedure TEzAction.SetFullViewCursorPos(Const Pt: TEzPoint);
Var
  DX, DY: Double;
Begin
  { draw old position }
  with FCmdLine.ActiveDrawBox.Grapher do
  begin
    If FCmdLine.UseFullViewCursor And (mdFullViewCursor In FMouseDrawElements) Then
      With FFullViewCursor, CurrentParams.VisualWindow Do
      Begin
        Points[0] := Point2D( Pt.X, Emin.Y );
        Points[1] := Point2D( Pt.X, Emax.Y );
        Points[2] := Point2D( Emin.X, Pt.Y );
        Points[3] := Point2D( Emax.X, Pt.Y );
      End;
    If mdCursorFrame In FMouseDrawElements Then
    Begin
      DX:= DistToRealX( Ez_Preferences.ApertureWidth );
      DY:= DistToRealY( Ez_Preferences.ApertureWidth );
      FCursorFrame.BeginUpdate;
      FCursorFrame.Points[0] := Point2D( Pt.X - DX / 2, Pt.Y - DY / 2 );
      FCursorFrame.Points[1] := Point2D( Pt.X + DX / 2, Pt.Y + DY / 2 );
      FCursorFrame.EndUpdate;
    End;
  end;
End;

Procedure TEzAction.SetCaption( Const Value: String );
Begin
  FCaption := Value;
  FCmdLine.CaptionChange( Value );
End;

Procedure TEzAction.SuspendOperation;
Begin
  { erase full view cursor }
  EraseFullViewCursor;
  FOldCaption := FCaption;
  If Assigned( FOnSuspendOperation ) Then
    FOnSuspendOperation( Self );
End;

Procedure TEzAction.ContinueOperation;
Begin
  Caption := fOldCaption;
  CmdLine.StatusMessage := '';
  If Assigned( FOnContinueOperation ) Then
    FOnContinueOperation( Self );
  { re-draw full view cursor }
  DrawFullViewCursor;
End;

Procedure TEzAction.UndoOperation;
Begin
  { Clear the caption by default }
  Caption := '';
  If Assigned( FOnUndo ) Then
    FOnUndo( Self );
End;

Function TEzAction.AcceptDrawBox: Boolean;
Begin
  Result := True;
End;

Procedure TEzAction.ParseUserCommand( Const Cmd: String );
Var
  lexer: TEzScrLexer;
  parser: TEzScrParser;
  outputStream: TMemoryStream;
  errorStream: TMemoryStream;
  Stream: TStream;
Begin
  If Length( Cmd ) = 0 Then Exit;
  outputStream := TMemoryStream.create;
  errorStream := TMemoryStream.create;
  Stream := TMemoryStream.Create;
  Stream.Write( Cmd[1], Length( Cmd ) );
  Stream.Seek( 0, 0 );

  lexer := TEzScrLexer.Create;
  lexer.yyinput := Stream;
  lexer.yyoutput := outputStream;
  lexer.yyerrorfile := errorStream;

  parser := TEzScrParser.Create;
  parser.DrawBox := CmdLine.ActiveDrawBox;
  parser.CmdLine := CmdLine;
  parser.checksyntax := False;
  parser.yyLexer := lexer; // lexer and parser linked
  Try
    FUserCommand := itNone;
    If parser.yyparse = 1 Then
    Begin
      // if it is a syntax error, we will consider it a simple string
      FUserCommand := itString;
      FUserString := Cmd;
    End;
  Finally
    parser.free;
    lexer.free;
    outputStream.free;
    errorStream.free;