ezactions.pas

很管用的GIS控件

    Procedure MyMouseUp( 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;
  End;

  {----------------------------------------------------------------------------}
  //                  TSetPolygonClipAreaAction
  {----------------------------------------------------------------------------}

  TSetPolygonClipAreaAction = Class( TEzAction )
  Private
    FEntity: TEzEntity;
    FCurrentIndex: Integer;
    Procedure SetCurrentPoint( Pt: TEzPoint; Orto: Boolean );
  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;

  {----------------------------------------------------------------------------}
  //                  TReshapeEntityAction
  {----------------------------------------------------------------------------}

  TReshapeEntityAction = 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 }
    FStartPoint: TEzPoint;    // used when moving a segment
    { for reshaping full segments }
    FPickedSegment: Boolean;
    FSegmentIdx1: Integer;
    FSegmentIdx2: Integer;
    { save previous state of TEzCmdLine.AccuSnap.HiliteSnapped }
    FOldHiliteSnapped: Boolean;
    procedure RubberLineTransform(Sender: TObject = Nil);
    Procedure DrawSelectionRubberBanding( ApplyTransform: Boolean;
      Sender: TObject=Nil );
    Function MyOwnPointCode( Ent: TEzEntity;  Const Pt: TEzPoint;
      Const Aperture: Double; Var Distance: Double;
      SelectPickingInside: Boolean ): Integer;
  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 MyMouseUp( Sender: TObject; Button: TMouseButton;
      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; Aperture: Integer );
    Destructor Destroy; Override;
  End;

  {----------------------------------------------------------------------------}
  //                  TDeleteVertexAction
  {----------------------------------------------------------------------------}

  TDeleteVertexAction = Class( TEzAction )
  Private
    FCurrentRecno: Integer; {the selected recno}
    FCurrentLayer: TEzBaseLayer; {the selected layer}
    FCurrentIndex: Integer; {the vertex to delete}
    FCurrentEntity: TEzEntity; {current entity if editing symbols}
    FIsOneSelected: Boolean; {state have one entity selected}
    FAperture: Integer; {the aperture of frame in pixels}
    Procedure DrawSelectionRubberBanding( ApplyTransform: Boolean;
      Sender: TObject=Nil );
  Protected
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      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;
  End;

  {----------------------------------------------------------------------------}
  //                  TCustomClickAction
  {----------------------------------------------------------------------------}

  { show coords }
  TCustomClickAction = Class( TEzAction )
  Protected
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyMouseDown( Sender: TObject;
                           Button: TMouseButton;
                           Shift: TShiftState;
                           X, Y: Integer;
                           Const WX, WY: Double );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
  End;

  {----------------------------------------------------------------------------}
  //                  TCustomClickAction
  {----------------------------------------------------------------------------}

  { show coords }
  TDropSelectionAction = Class( TEzAction )
  Private
    FSelCentroid, FLastPos: TEzPoint;
    FDrawBoxWithSel: TEzBaseDrawBox;
    Procedure DrawSelectionRubberBanding(Sender: TObject=Nil);
  Protected
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyPaint( Sender: TObject );
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer;
      Const WX, WY: Double );
    Procedure MyMouseDown( Sender: TObject;
                           Button: TMouseButton;
                           Shift: TShiftState;
                           X, Y: Integer;
                           Const WX, WY: Double );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
  End;

  {----------------------------------------------------------------------------}
  //                  TAddMarkerAction
  {----------------------------------------------------------------------------}

    { add marker }
  TAddMarkerAction = Class( TEzAction )
  Private
    FMarker: TEzEntity;
    FNumSymbol: Integer;
    procedure SetCurrentPoint( Const Pt: TEzPoint );
  Protected
    Procedure MyMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer; Const WX, WY: Double );
    Procedure MyKeyPress( Sender: TObject; Var Key: Char );
    Procedure MyMouseDown( Sender: TObject; Button: TMouseButton;
      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 SuspendOperation( Sender: TObject );
    Procedure ContinueOperation( Sender: TObject );
  Public
    Constructor CreateAction( CmdLine: TEzCmdLine );
    destructor Destroy; override;
  End;

  // used in trim, break, TEznetwork.CleanUpLayer() etc.
  PDistRec = ^TDistRec;
  TDistRec = Record
    D: Double;
    Index: Integer;
  End;

  TListImageKind = (liBitmaps, liBlocks, liAllImages);

Function SelectCommonElement(const Subdir, IniFilter: string;
  ListImageKind: TListImageKind): string;

  { main procedure used for executing an action on the command line control }
Function ExecCommand( M: TEzCmdLine; Const Cmd, ActionID: String ): Boolean;

{ miscelaneous procedures }
Function GetSnapPt( CmdLine: TEzCmdLine; Aperture: Integer;
  Setting: TEzOSNAPSetting; Const PivotLayerName: string;
  Var ALayer: TEzBaseLayer; Var ARecno: Integer;
  Var SnapPt: TEzPoint; Var IsSnappedPointOnEntity: Boolean;
  Var RefFrom, RefTo: TEzPoint ): Boolean;
Procedure QuickSortDistList( SortList: TList; L, R: Integer );
Function IsPointOnEntity( CmdLine: TEzCmdLine; Aperture: Integer;
  Const APt: TEzPoint; Ent: TEzEntity ): Boolean;
Function ActionAddNewEntity( CmdLine: TEzCmdLine; Var Entity: TEzEntity ) : Integer;
Function DoPolygonSelect( Polygon: TEzPolygon; cmdLine: TEzCmdLine ): Boolean;

Implementation

Uses
  Math, clipbrd, ezdims, EzPolyClip, EzBaseExpr, ezConsts, EzActionLaunch,
  EzRtree, ezbasicctrls, EzGisTiff, EzMiscelEntities, ezgraphics,
  fPictureDef, EzNetwork, EzPreview
{$IFDEF USE_RICHEDIT}
  , fRichEdit
{$ENDIF}
  ;


Function SelectCommonElement(const Subdir, IniFilter: string;
  ListImageKind: TListImageKind): string;
var
  OpenDialog: TOpenDialog;
begin
  Result:= '';
  OpenDialog:= TOpenDialog.Create(Nil);
  try
    if Length(IniFilter)>0 then
    begin
      //OpenDialog.DefaultExt:= DefaultExt;
      OpenDialog.Filter:= IniFilter;
    end else
    begin
    case ListImageKind of
      liBitmaps:
        OpenDialog.Filter:= SBandedImagesFilter;
      liAllImages:
        begin
          OpenDialog.Filter:= SBitmapFilter
{$IFDEF JPEG_SUPPORT}
            + '|' + SJPGFilter
{$ENDIF}
{$IFDEF GIF_SUPPORT}
            + '|' + SGIFFilter
{$ENDIF}
            + '|' + SMetafileFilter
            + '|' + SICOFilter
{$IFDEF USE_GRAPHICEX}
  {$IFDEF TIFFGraphic}
            + '|' + STIFFilter
  {$ENDIF}
  {$IFDEF TargaGraphic}
            + '|' + STargaFilter
  {$ENDIF}
  {$IFDEF PCXGraphic}
            + '|' + SPCXFilter
  {$ENDIF}
  {$IFDEF PCDGraphic}
            + '|' + SPCDFilter
  {$ENDIF}
{$IFNDEF GIF_SUPPORT}
  {$IFDEF GIFGraphic}
            + '|' + SGIFFilter
  {$ENDIF}
{$ENDIF}
  {$IFDEF PhotoshopGraphic}
            + '|' + SPSDFilter
  {$ENDIF}
  {$IFDEF PaintshopProGraphic}
            + '|' + SPSPFilter
  {$ENDIF}
  {$IFDEF PortableNetworkGraphic}
            + '|' + SPNGFilter
  {$ENDIF}

{$ENDIF}
            ;
        end;
        liBlocks:
          OpenDialog.Filter:= SEDBFilter;
      end;
    end;
    OpenDialog.InitialDir:= SubDir;
    OpenDialog.Options:= [ofPathMustExist, ofFileMustExist, ofNoChangeDir];
    repeat
      if not OpenDialog.Execute then exit;
      If AnsiCompareText( AddSlash(ExtractFilePath(OpenDialog.FileName)), SubDir) = 0 then
        Break;
      MessageToUser( SChangeDirNotAllowed, smsgerror, MB_ICONERROR );
    until False;
    Result:= OpenDialog.FileName;
  finally
    OpenDialog.Free;
  end;
end;

{this method is called by TEzCmdLine every time user types something in order
 to found if a command was issued
 Comment commands you don't want your end user can do}

Function ExecCommand( M: TEzCmdLine; Const Cmd, ActionID: String ): Boolean;
Var
  ent: TEzEntity;
  BlockName, s: String;
  ImageDims: TPoint;
  Lines: TStrings;

  Procedure SetPictureFileName( Var Entity: TEzEntity );
  Var
    Subd: String;
    GraphicLink: TEzGraphicLink;
  Begin
    With TfrmPict1.Create( Nil ) Do
    Try
      If Entity.EntityID In [idPictureRef, idBandsBitmap] Then
        Subd := Ez_Preferences.CommonSubDir
      Else
        Subd := '';
      If Not ( Enter( Entity.EntityID, '', Subd ) = mrOk ) Then
      Begin
        FreeAndNil( Entity );
        exit;
      End;
      ImageDims.X := ImageWidth;
      ImageDims.Y := ImageHeight;
      Case Entity.EntityID Of
        idPictureRef:
          Begin
            With TEzPictureRef( Entity ) Do
            Begin
              FileName := ExtractFileName( EditFileName );
            End;
          End;
        idPersistBitmap:
          Begin
            With TEzPersistBitmap( Entity ) Do
            Begin
              GraphicLink := TEzGraphicLink.Create;
              Try
                GraphicLink.ReadGeneric( EditFileName );
                Bitmap.Assign( GraphicLink.Bitmap );
              Finally
                GraphicLink.Free;
              End;