ezcmdline.pas

很管用的GIS控件

    If ( FActionList = Nil ) Or ( ActiveDrawBox = Nil ) Then Exit;
    {Item:= FDrawBoxList.FindCurrent;
    If Assigned( Item.FSavedKeyPress ) Then
      Item.FSavedKeyPress( Item.FDrawBox, Key ); }
    Try
      If Assigned( CurrentAction.OnKeyPress ) And ( Length( Self.Text ) = 0 ) Then
      Begin
        CurrentAction.OnKeyPress( Parent, Key );
        If CurrentAction.Finished Then Pop;
      End;
    Except
      Clear;
      Raise;
    End;
    If Key = #0 Then Exit;
    If ( Key = #13 ) And ( Length( Self.Text ) = 0 ) And
      CurrentAction.WaitingMouseClick And Not EqualPoint2d( FLastClicked, INVALID_POINT ) Then
    Begin
      Self.Text := FloatToStr( FLastClicked.X ) + ',' + FloatToStr( FLastClicked.Y );
      //Pass:= False;
    End;
    If ( Key = #13 ) {Or ( Key = #32 )} Then
    Begin
      { possibly it is a direct command: POLYLINE, POLYGON, etc.}
      InternalDoCommand( Self.Text, CurrentAction.FActionID, FActionList.Count > 0 );
      If ActiveDrawBox.Visible And ActiveDrawBox.Enabled Then
        Windows.SetFocus(ActiveDrawBox.Handle);
      Self.Text := '';
    End;
    If Key = #27 Then
    Begin
      Self.Text := '';
      If ActiveDrawBox.Visible And ActiveDrawBox.Enabled Then
        Windows.SetFocus(ActiveDrawBox.Handle);
    End
    Else If ( Key In [#33..#255] ) And Not Self.Focused Then
    Begin
      If ( self.visible And self.enabled ) And ( visible And enabled ) Then
        Windows.SetFocus(Self.Handle);
      If Key In [#33..#255] Then
        Self.Text := Self.Text + Key;
      Self.SelStart := Length( Self.Text );
    End;
  End;
  Inherited KeyPress( Key );
End;

{-------------------------------------------------------------------------------}
//                  TEzCmdLine
{-------------------------------------------------------------------------------}

Var
  FAccuSnapPictures: Array[TEzOsnapSetting] Of TBitmap;
  FAccuSnapPicFocused: TBitmap;
  FAccuSnapPicUnFocused: TBitmap;

const
  ImageNames: array[TEzOsnapSetting] of PChar = (  'SNAP_ENDPOINT',
                                                   'SNAP_MIDPOINT',
                                                   'SNAP_CENTER',
                                                   'SNAP_INTERSECT',
                                                   'SNAP_PERPEND',
                                                   'SNAP_TANGENT',
                                                   'SNAP_NEAREST',
                                                   'SNAP_ORIGIN',
                                                   'SNAP_PARALLEL',
                                                   'SNAP_KEYPOINT',
                                                   'SNAP_BISECTOR'
                                                    );

Constructor TEzCmdLine.Create( AOwner: TComponent );
Var
  DC: THandle;
  ScreenDpiX, ScreenDpiY: Integer;
Begin
  Inherited Create( AOwner );
  FLabel := TLabel.Create( Self );
  FLabel.Parent := Self;
  FLabel.Align := alLeft;
  FLabel.Caption := SCommand;
  FEdit := TEzCmdLineEdit.Create( Self );
  FEdit.Parent := Self;
  FEdit.Align := alClient;
  FEdit.BorderStyle := bsNone;
  FBorderStyle := bsSingle;
  FActionList := TList.Create;
  FTheDefaultAction := TTheDefaultAction.CreateAction( Self );
  FShortCuts := TStringList.Create;
  FDisabledCommands := TStringList.Create;
  FShowMeasureInfoWindow := True;
  DC := GetDC( 0 );
  ScreenDpiX := GetDeviceCaps( DC, LOGPIXELSX );
  ScreenDpiY := GetDeviceCaps( DC, LOGPIXELSY );
  ReleaseDC( 0, DC );
  { By default, 1/8 of an inch to snap to a guideline }
  FGLSnapAperture := Point( ScreenDpiX Div 8, ScreenDpiY Div 8 );
  // command line processing
  TabStop := False;
  Font.Handle:= EzSystem.DefaultFontHandle;
  Height := 24;
  Align := alBottom;
  Color := clWhite;
  FLastClicked := INVALID_POINT;
  FUseFullViewCursor := True;
  FAccuSnap := TEzAccuSnap.Create( Self );
  FAccuDraw := TEzAccuDraw.Create( Self );
  FDrawBoxList:= TEzDrawBoxCollection.Create(Self);
End;

Destructor TEzCmdLine.Destroy;
begin
  Clear;
  FActionList.Free;
  FTheDefaultAction.Free;
  FShortCuts.Free;
  FDisabledCommands.Free;
  FAccuSnap.Free;
  FAccuDraw.Free;
  FreeAndNil( FDrawBoxList );
  Inherited Destroy;
End;

procedure TEzCmdLine.SetDrawBoxList(const Value: TEzDrawBoxCollection);
begin
  FDrawBoxList.Assign( Value );
end;

Procedure TEzCmdLine.CreateParams( Var Params: TCreateParams );
Begin
  Inherited CreateParams( Params );
  With Params Do
  Begin
    Style := Style Or WS_TABSTOP;
    WindowClass.style := CS_DBLCLKS;
    If fBorderStyle = bsSingle Then
      If NewStyleControls And Ctl3D Then
      Begin
        Style := Style And Not WS_BORDER;
        ExStyle := ExStyle Or WS_EX_CLIENTEDGE;
      End
      Else
        Style := Style Or WS_BORDER;
  End;
End;

function TEzCmdLine.GetAbout: TEzAbout;
begin
  Result:= SEz_GisVersion;
end;

procedure TEzCmdLine.SetAbout(const Value: TEzAbout);
begin
end;

Procedure TEzCmdLine.SetBorderStyle( Const Value: forms.TBorderStyle );
Begin
  If FBorderStyle <> Value Then
  Begin
    FBorderStyle := Value;
    RecreateWnd;
  End;
End;

Procedure TEzCmdLine.SetShortCuts( Value: TStrings );
Begin
  FShortCuts.Assign( Value );
End;

Procedure TEzCmdLine.SetDisabledCommands( Value: TStrings );
Begin
  FDisabledCommands.Assign( Value );
End;

Procedure TEzCmdLine.InternalDoCommand( Const Cmd, ActionID: String; IsParam: Boolean );
Var
  TmpCmd, ShortCut, ErrorMessage: String;
  Accept, Processed: Boolean;

  Function ParseScript( Const PCmd: String ): Boolean;
  Var
    lexer: TEzScrLexer;
    parser: TEzScrParser;
    outputStream: TMemoryStream;
    errorStream: TMemoryStream;
    Stream: TStream;
  Begin
    result := False;
    If Length( PCmd ) = 0 Then Exit;
    outputStream := TMemoryStream.create;
    errorStream := TMemoryStream.create;
    Stream := TMemoryStream.Create;
    Stream.Write( PCmd[1], Length( PCmd ) );
    Stream.Seek( 0, 0 );

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

    parser := TEzScrParser.Create;
    parser.DrawBox := Self.ActiveDrawBox;
    parser.MustRepaint := True;
    { this indicates that the checking is not done for parameters for the
      current Action, but for a full script command, like
      LINE (0,0), (10,10) }
    parser.CmdLine := Nil;
    parser.checksyntax := False;
    parser.yyLexer := lexer; // lexer and parser linked
    Try
      result := Not ( parser.yyparse = 1 );
    Finally
      parser.free;
      lexer.free;
      outputStream.free;
      errorStream.free;
      Stream.Free;
    End;
  End;

Begin
  Assert( ActiveDrawBox <> Nil );
  TmpCmd := Cmd;
  If Length( TmpCmd ) = 0 Then
    TmpCmd := FLastCommand;
  If Length( TmpCmd ) = 0 Then Exit;
  If ActiveDrawBox.GIS.Layers.Count = 0 Then
  Begin
    MessageToUser( SThereAreNoLayers, smsgerror, MB_ICONERROR );
    Exit;
  End;
  Try
    // First, replace with a shortcut if it is found
    ErrorMessage := sUnrecognizedCommand;
    If IsParam And IsBusy Then
    Begin
      { send what user typed to the current Action
       that is not the default Action }
      CurrentActionDoCommand( TmpCmd );
    End
    Else
    Begin
      Processed := True;

      If FShortCuts.Count > 0 Then
      Begin
        ShortCut := FShortCuts.Values[TmpCmd];
        If Length( ShortCut ) > 0 Then
          TmpCmd := ShortCut;
      End;
      If FDisabledCommands.IndexOf( TmpCmd ) >= 0 Then TmpCmd := '';

      { check if the command is accepted }
      If Assigned( FOnBeforeCommand ) Then
      Begin
        Accept := True;
        FOnBeforeCommand( Self, TmpCmd, ActionID, ErrorMessage, Accept );
        If Not Accept Then
        Begin
          Text := '';
          If Length( ErrorMessage ) > 0 Then
            MessageToUser( ErrorMessage, smsgerror, MB_ICONERROR );
          Exit;
        End;
      End;
      { check if there is a shortcut for this command }
      If Assigned( FOnShortCut ) Then
        FOnShortCut( Self, TmpCmd );

      { process the internal implemented Actions}
      If Not ExecCommand( Self, AnsiUpperCase(TmpCmd), ActionID ) Then
      Begin
        Processed := false;
        If Assigned( FOnUnknownCommand ) Then
          FOnUnknownCommand( Self, TmpCmd, ActionID, Processed );
        If Not Processed Then
        Begin
          { check if it is a direct command and can be parsed without syntax errors }
          Processed := ParseScript( TmpCmd );
          If Not Processed Then
            MessageToUser( ErrorMessage, smsgerror, MB_ICONERROR );
        End;
      End;
      If Not(Processed And ( Length( TmpCmd ) > 0 )) Then Text := '';
    End;
  Except
    On E: Exception Do
    Begin
      MessageToUser( E.Message, smsgerror, MB_ICONERROR );
      Clear;
    End;
  End;
End;

// command line processing

Procedure TEzCmdLine.DoCommand( Const Cmd, ActionID: String );
Begin
  InternalDoCommand( Cmd, ActionId, False );
End;

Procedure TEzCmdLine.CaptionChange( Const Value: String );
Begin
  If Length(Value) = 0 Then
    FLabel.Caption:= SCommand
  Else
    FLabel.Caption:= Value;
  Text := '';
End;

Function TEzCmdLine.IsBusy: Boolean;
Begin
  Result := CurrentAction <> TheDefaultAction;
End;

Function TEzCmdLine.GetActiveDrawBox: TEzBaseDrawBox;
var
  Item: TEzDrawBoxItem;
Begin
  Result:= Nil;
  If (FDrawBoxList = Nil) Or (FDrawBoxList.Count=0) Then Exit;
  Item:= FDrawBoxList.FindCurrent;
  If Item <> Nil Then
    Result:= Item.FDrawBox
  Else
  Begin
    FDrawBoxList[0].FCurrent:= True;
    Result:= FDrawBoxList.Items[0].DrawBox;
  End;
End;

Procedure TEzCmdLine.SetActiveDrawBox(Value: TEzBaseDrawBox);
var
  I: Integer;
begin
  For I:= 0 to FDrawBoxList.Count-1 do
    If FDrawBoxList.Items[0].DrawBox = Value then
      FDrawBoxList.Items[0].Current:= True;
end;

Procedure TEzCmdLine.Clear;
Var
  I: Integer;
  Action: TEzAction;
Begin
  If FClearing Then Exit;
  FClearing := true;
  Try
    FAccuDraw.Showing:= False;
    For I := 0 To FActionList.Count - 1 Do
    begin
      Action := TEzAction( FActionList[I] );
      KillAction( Action );
    End;
    FActionList.Clear;

    FLabel.Caption := SCommand;
    FEdit.Text := '';
    All_Cursor( FTheDefaultAction.Cursor );
  Finally
    FClearing := false;
  End;
End;

Procedure TEzCmdLine.SetTheDefaultAction( Value: TEzAction );
Begin
  If ( csDesigning In ComponentState ) then Exit;
  { TEzCmdLine is responsible for freeing FTheDefaultAction
    so, assigns will be something like:
    CmdLine.DefaultAction := TScrollingAction.Create(nil) }
  //if not(FTheDefaultAction is TMapActionHook) then
  FTheDefaultAction.Free;
  if Value = Nil then  // if tried to set to nil, then set the default action
    FTheDefaultAction := TTheDefaultAction.CreateAction( Self )
  else
    FTheDefaultAction := Value;
  FTheDefaultAction.FCmdLine := Self; { ensure valid TEzCmdLine in Action }
End;

Function TEzCmdLine.CurrentAction: TEzAction;
Begin
  Result := FTheDefaultAction;
  If ( FActionList = Nil ) Or ( FActionList.Count = 0 ) Then Exit;
  Result := TEzAction( FActionList[FActionList.Count - 1] );
End;