ezactionlaunch.pas

很管用的GIS控件

      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; VectorialText: TEzEntity;
      IsJustifiedText: Boolean; TextBorderStyle: TEzTextBorderStyle );
    Destructor Destroy; Override;
  End;


  {-------------------------------------------------------------------------------}
  //                  TDimAction
  {-------------------------------------------------------------------------------}

  TEzDimStatus = ( dsDefineLineLocation, dsDefineTextLocation );

  { TDimAction }
  TDimAction = Class( TEzAction )
  Private
    FDimEnt: TEzEntity;
    FAuxLine: TEzPolyLine;
    FDimStatus: TEzDimStatus;
    FCurrentIndex: Integer;
    FLastPoint: 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 SetCurrentPoint( Pt: TEzPoint );
    Procedure DrawEntitiesWithRubber( Const Pt: TEzPoint;
      Calculate: Boolean; Sender: TObject=Nil );
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; DimEnt: TEzEntity );
    Destructor Destroy; Override;
  End;


  {-------------------------------------------------------------------------------}
  //                  TDragDropAction
  {-------------------------------------------------------------------------------}

  TDragDropAction = Class( TEzAction )
  Private
    FCurrentRecno: Integer; {the selected recno}
    FCurrentLayer: TEzBaseLayer; {the selected layer}
    FCurrentIndex: Integer; {the vertex to reshape}
    FCurrentEntity: TEzEntity; {current entity if editing symbols}
    FReshaping: Boolean; {state is reshaping entity}
    FIsOneSelected: Boolean; {state have one entity selected}
    FNewPoint: TEzPoint; {the new point if reshaping}
    FAperture: Integer; {the aperture of frame in pixels}
    FStackedSelList: TStringList;
    FLineTransform: TEzEntity;    { line used to show the rotation angle or the distance moved }
    Procedure DrawSelectionRubberBanding( ApplyTransform: Boolean;
        Sender: TObject=Nil );
    Function MyOwnPointCode( Ent: TEzEntity;
      Const Pt: TEzPoint;
      Const Aperture: Double;
      Var Distance: Double;
      SelectPickingInside: Boolean ): Integer;

    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; Aperture: Integer );
    Destructor Destroy; Override;
  End;


  {-------------------------------------------------------------------------------}
  //                  TAddTextAction
  {-------------------------------------------------------------------------------}

  TAddTextAction = Class( TEzAction )
  Private
    FText: TEzEntity;
    FFormEditor: TCustomForm;
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( 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 );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    Destructor Destroy; Override;

    Property FormEditor: TCustomForm read FFormEditor write FFormEditor;
    Property Text: TEzEntity read FText write FText;
  End;

implementation

uses
  Math, Clipbrd, EzDims, EzActions, EzGraphics, EzConsts, fVectorialText,
  EzGisTiff, fTextEditor, EzRtree, EzBasicCtrls;

type

  {-------------------------------------------------------------------------------}
  //                  TEntityClickAction
  {-------------------------------------------------------------------------------}

  TEntityClickAction = Class( TEzAction )
  Private
    FLayer: TEzBaseLayer;
    FRecno: Integer;
    { used for stacked select}
    FStackedSelList: TStringList;
    FHighlightClicked: Boolean;
    { if set to '', all layers included }
    FSearchLayerName: string;
    Procedure Mypaint( Sender: TObject );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure SuspendOperation( Sender: TObject );
    Procedure HiliteClickedEntity( Hilite: Boolean );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; LayerName: string );
    Destructor Destroy; Override;
  End;

  {-------------------------------------------------------------------------------}
  //                  TMouseMoveAction
  {-------------------------------------------------------------------------------}

  TMouseMoveAction = Class( TEzAction )
  Private
    FLastLayer: TEzBaseLayer;
    FLastRecno: Integer;
    FHighlightDetected: Boolean;
    FInMouseMove: Boolean;
    FSearchLayerName: string;
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
    Procedure MyPaint( Sender: TObject );
    Procedure HiliteDetectedEntity(Hilite: Boolean);
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; Const LayerName: string );
    Destructor Destroy; Override;
  End;


  {-------------------------------------------------------------------------------}
  //                  TGenericAction
  {-------------------------------------------------------------------------------}

  TGenericAction = Class( TEzAction )
  Private
    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 MyMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Const WX, WY: Double );
    Procedure MyPaint( Sender: TObject );
    Procedure MyOnClick( Sender: TObject );
    Procedure MyDblClick( Sender: TObject );
    procedure MyOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    procedure MyOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    Procedure MyActionDoCommand( Sender: TObject );
    Procedure MySuspendOperation( Sender: TObject );
    Procedure MyContinueOperation( Sender: TObject );
    Procedure MyUndo( Sender: TObject );
    Procedure MyInitialize( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine; L: TEzActionLauncher );
  End;


{ TEzActionLauncher }

constructor TEzActionLauncher.Create(AOwner: TComponent);
begin
  inherited Create( Aowner );
  FCursor:= crCross;
  FMouseDrawElements:= [mdCursorFrame, mdFullViewCursor];
end;

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

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

procedure TEzActionLauncher.Notification(AComponent: TComponent; Operation: TOperation);
begin
  Inherited Notification( AComponent, Operation );
  If ( Operation = opRemove ) And ( AComponent = FCmdLine ) Then
    FCmdLine := Nil;
end;

procedure TEzActionLauncher.SetCmdLine(const Value: TEzCmdLine);
begin
{$IFDEF LEVEL5}
  if Assigned( FCmdLine ) then FCmdLine.RemoveFreeNotification( Self );
{$ENDIF}
  If Value <> Nil Then
  Begin
    Value.FreeNotification( Self );
  End;
  FCmdLine := Value;
end;

procedure TEzActionLauncher.Finish;
begin
  { please don't call this method inside an event handler of TEzActionLauncher }
  If (FCmdLine = Nil) Or (FCmdLine.TheDefaultAction = FCmdLine.CurrentAction) Or
    (FCmdLine.CurrentAction.Launcher <> Self ) Then Exit;
  FCmdLine.Pop;
end;

procedure TEzActionLauncher.PushAction( const TrackID: string );
begin
  with FCurrentAction do
  begin
    Launcher := Self;
    Cursor:= Self.Cursor;
    CanDoOsnap:= Self.FCanDoOsnap;
    CanDoAccuDraw:= Self.FCanDoAccuDraw;
    MouseDrawElements:= Self.FMouseDrawElements;
  end;
  FCmdLine.Push( FCurrentAction, true, SCmdTracking, TrackID );
end;

procedure TEzActionLauncher.TrackPlace(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine,
    TEzPlace.CreateEntity( Point2D( 0, 0 ) ), Point(0,0) );
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackPoint(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine,
    TEzPointEntity.CreateEntity( Point2D( 0, 0 ), clblack ), Point(0,0));
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackPolygon(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine,
    TEzPolygon.CreateEntity( [Point2D( 0, 0 )] ), Point(0,0));
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackPolyline(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine,
    TEzPolyLine.CreateEntity( [Point2D( 0, 0 )] ), Point(0,0) );
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackSketch(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TSketchAction.CreateAction( FCmdLine,
    TEzPolyLine.CreateEntity( [Point2D(0, 0)] ) );
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackRectangle(const TrackID: string;
  ScaledWidth: Integer = 0; ScaledHeight: Integer=0 );
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine,
    TEzRectangle.CreateEntity( Point2D( 0, 0 ), Point2D( 0, 0 ) ), Point(ScaledWidth,ScaledHeight) );
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackSpline(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine,
    TEzSpline.CreateEntity( [Point2D( 0, 0 )] ), Point(0,0) );
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackArc3P(const TrackID: string);
var
  p: TEzPoint;
begin
  Assert( FCmdLine <> Nil );
  p:= Point2d(0,0);
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine, TEzArc.CreateEntity( p,p,p ), Point(0,0) );
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackArcSE(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TDrawArcAction.CreateAction( FCmdLine );
  PushAction( TrackID );
end;

procedure TEzActionLauncher.TrackEllipse(const TrackID: string);
begin
  Assert( FCmdLine <> Nil );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine,
    TEzEllipse.CreateEntity( Point2D( 0, 0 ), Point2D( 0, 0 ) ), Point(0,0) );
  PushAction( TrackID );
end;

{ FileName must not include path }
procedure TEzActionLauncher.TrackPictureRef(const TrackID, FileName: string);
var
  Entity: TEzEntity;
  Dims: TPoint;
  TheGraphicLink: TEzGraphicLink;
  filnam: string;
begin
  Assert( FCmdLine <> Nil );
  TheGraphicLink := TEzGraphicLink.Create;
  try
    filnam := AddSlash( Ez_Preferences.CommonSubDir ) + FileName;
    If FileExists( filnam ) Then
    begin
      TheGraphicLink.ReadGeneric( filnam );
      Dims.X:= TheGraphicLink.Bitmap.Width;
      Dims.Y:= TheGraphicLink.Bitmap.Height;
    end else
    begin
      Exit;
    end;
  Finally
    TheGraphicLink.Free;
  End;
  Entity:= TEzPictureRef.CreateEntity( Point2D( 0, 0 ), Point2D( 0, 0 ), FileName );
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine, Entity, Dims );
  PushAction( TrackID );
end;

{ FileName must not include path }
procedure TEzActionLauncher.TrackBandsBitmap(const TrackID, FileName: string);
var
  Entity: TEzEntity;
  Dims: TPoint;
  IsCompressed: Boolean;
begin
  Assert( FCmdLine <> Nil );
  Entity:= TEzBandsBitmap.CreateEntity( Point2D( 0, 0 ), Point2D( 0, 0 ), FileName );
  case TEzBandsBitmap(Entity).GetFormat of
    ifBitmap:
      GetDIBDimensions( AddSlash(Ez_Preferences.CommonSubdir) + FileName, nil, Dims.X, Dims.Y, IsCompressed);
    ifTiff:
      GetTiffDimensions( AddSlash(Ez_Preferences.CommonSubdir) + FileName, nil, Dims.X, Dims.Y, IsCompressed);
    ifBIL:
      GetBILDimensions( AddSlash(Ez_Preferences.CommonSubdir) + FileName, Dims.X, Dims.Y);
  end;
  FCurrentAction:= TAddEntityAction.CreateAction( FCmdLine, Entity, Dims );
  PushAction( TrackID );
end;

{ BlockName must not include path }
procedure TEzActionLauncher.TrackBlock(const TrackID, BlockName: string;
  const Rotangle, ScaleX, ScaleY: Double );
var
  Entity: TEzEntity;
begin
  Assert( FCmdLine <> Nil );
  Entity:= TEzBlockInsert.CreateEntity( ExtractFileName( BlockName ),