⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ezactions.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
{ Utilities }

Function IsPointOnEntity( CmdLine: TEzCmdLine; Aperture: Integer;
  Const APt: TEzPoint; Ent: TEzEntity ): Boolean;
Var
  MinDist, Distance, NewAperture: Double;
  RealAperture: TEzPoint;
  TmpNPoint: Integer;
Begin
  Aperture := Aperture Div 2;
  With CmdLine.ActiveDrawBox Do
    RealAperture := Point2D( Grapher.DistToRealX( Aperture ), Grapher.DistToRealY( Aperture ) );
  If RealAperture.X > RealAperture.Y Then
    NewAperture := RealAperture.X
  Else
    NewAperture := RealAperture.Y;
  NewAperture := Sqrt( 2 ) * NewAperture;
  MinDist := NewAperture;
  TmpNPoint := Ent.PointCode( APt, MinDist, Distance, True );
  If ( TmpNPoint >= PICKED_INTERIOR ) And ( Distance <= MinDist ) Then
    Result := True
  Else
    Result := False;
End;

Function PointOnLine( Const CX, CY, AX, AY, BX, BY: Double ): TEzPoint;
Var
  r, L: Double;
Begin
  L := Dist2D( Point2D( AX, AY ), Point2D( BX, BY ) );
  If L = 0 Then
    Exit;
  r := ( ( CX - AX ) * ( BX - AX ) + ( CY - AY ) * ( BY - AY ) ) / ( L * L );
  Result.X := AX + r * ( BX - AX );
  Result.Y := AY + r * ( BY - AY );
End;

{ returns true if an entity is found inside Polygon }

Function DoPolygonSelect( Polygon: TEzPolygon; cmdLine: TEzCmdLine ): Boolean;
Var
  EntityID: TEzEntityID;
  TmpClass: TEzEntityClass;
  TmpEntity: TEzEntity;
  I: Integer;
  TmpLayer: TEzBaseLayer;
  SelExtent, Extent, MyVisualWindow: TEzRect;
  SearchType: TSearchType;
  IsAltPressed: Boolean;
  Saved:TCursor;
Begin
  Result := false;
  With cmdLine.ActiveDrawBox Do
  Begin
    MyVisualWindow := Grapher.CurrentParams.VisualWindow;
    With GIS.MapInfo Do
    Begin
      If IsAreaClipped Then
      Begin
        With MyVisualWindow Do
        Begin
          If Emin.X < AreaClipped.Emin.X Then
            Emin.X := AreaClipped.Emin.X;
          If Emin.Y < AreaClipped.Emin.Y Then
            Emin.Y := AreaClipped.Emin.Y;
          If Emax.X > AreaClipped.Emax.X Then
            Emax.X := AreaClipped.Emax.X;
          If Emax.Y > AreaClipped.Emax.Y Then
            Emax.Y := AreaClipped.Emax.Y;
        End;
      End;
    End;
    SelExtent := ezlib.INVALID_EXTENSION;
    IsAltPressed := ( GetAsyncKeyState( VK_menu ) Shr 1 ) <> 0;
    Selection.BeginUpdate;
    Saved:=Screen.Cursor;
    Screen.Cursor:= crHourglass;
    Try
      For I := 0 To GIS.Layers.Count - 1 Do
      Begin
        TmpLayer := GIS.Layers[I];
        With TmpLayer Do
        Begin
          If Not LayerInfo.Visible Then
            Continue;
          If Not LayerInfo.Selectable Then
            Continue;
          With Grapher.CurrentParams Do
          Begin
            If PartialSelect Then
              SearchType := stOverlap
            Else
              SearchType := stEnclosure;

            SetGraphicFilter( Searchtype, Polygon.FBox );

            First;
            StartBuffering;
            Try
              While Not Eof Do
              Begin
                Try
                  Extent := RecExtension;
                  If RecIsDeleted Or
                    Not IsBoxInBox2D( Extent, MyVisualWindow ) Or
                    Not IsBoxInBox2D( Extent, Polygon.FBox ) Then Continue;
                  { Verify if entity extension is inside Polygon extension }
                  EntityID := RecEntityID;
                  If EntityID In NoPickFilter Then Continue;
                  TmpClass := GetClassFromID( EntityID );
                  TmpEntity := TmpClass.Create( 1 );
                  RecLoadEntity2( TmpEntity );
                  Try
                    If TmpEntity.IsInsideEntity( Polygon, Not PartialSelect ) Then
                    Begin
                      If Not IsAltPressed Then
                        Selection.Add( TmpLayer, Recno )
                      Else
                        Selection.Delete( TmpLayer, Recno );
                      MaxBound( SelExtent.Emax, Extent.Emax );
                      MinBound( SelExtent.Emin, Extent.Emin );
                      result := true;
                    End;
                  Finally
                    TmpEntity.Free;
                  End;
                Finally
                  Next;
                End;
              End;
            Finally
              EndBuffering;
              CancelFilter;
            End;
          End;
        End;
      End;
      If Not EqualRect2D( SelExtent, INVALID_EXTENSION ) Then
        cmdLine.All_RepaintRect( SelExtent );
    Finally
      Selection.EndUpdate;
      Screen.Cursor:= Saved;
    End;
  End;
End;

// Add current inserting entity to the map. Returns the recno of the entity added

Function ActionAddNewEntity( CmdLine: TEzCmdLine; Var Entity: TEzEntity ) : Integer;
Var
  Accept: Boolean;
  TmpLayer: TEzBaseLayer;
  Extents: TEzRect;
  MinDim: Double;

Begin

  If Entity.EntityID = idPreview Then
  Begin
    With TEzPreviewEntity( Entity ) Do
    Begin
      CalculateScales( ProposedPrintArea );
    End;
  End;

  With CmdLine.ActiveDrawBox Do
  Begin
    Accept := True;
    TmpLayer := GIS.CurrentLayer;
    If Assigned( OnBeforeInsert ) Then
      OnBeforeInsert( CmdLine.ActiveDrawBox, TmpLayer, Entity, Accept );
    Result := 0;
    If Accept Then
      Result := AddEntity( GIS.CurrentLayerName, Entity );
    { the current layer could be changed on the OnBeforeInsert event}
    TmpLayer := GIS.CurrentLayer;
    If Accept And Assigned( OnAfterInsert ) Then
      OnAfterInsert( CmdLine.ActiveDrawBox, TmpLayer, Result );
    cmdLine.All_Refresh;
    Extents := Entity.FBox;
    FreeAndNil( Entity );
    {Repaint only the affected area}
    MinDim := CmdLine.ActiveDrawBox.Grapher.DistToRealY( 5 );
    InflateRect2D( Extents, MinDim, MinDim );
    cmdLine.All_RepaintRect( Extents );
  End;
End;


Function SelectInFrame( CmdLine: TEzCmdLine; Frame: TEzRect; Mode: TEzGroupMode;
  Var SelRect: TEzRect ): Boolean;
Var
  TmpEntity: TEzEntity;
  TmpEntityID: TEzEntityID;
  I: Integer;
  TmpLayer: TEzBaseLayer;
  Entities: Array[TEzEntityID] Of TEzEntity;
  Cont: TEzEntityID;
  SavedDrawLimit: Integer;
  TickStart: DWORD;
  Msg: TMsg;
  Canceled: Boolean;
  SearchType: TSearchType;
  ARecno: integer;
  IsAltPressed: Boolean;
  SelExtent, Extent: TEzRect;
  Saved: TCursor;
Begin
  Result := false;
  Frame := ReOrderRect2D( Frame );
  Canceled := False;

  With CmdLine.ActiveDrawBox Do
  Begin
    SelExtent := INVALID_EXTENSION;
    For Cont := Low( TEzEntityID ) To High( TEzEntityID ) Do
      Entities[Cont] := GetClassFromID( Cont ).Create( 4 );
    SavedDrawLimit := Ez_Preferences.MinDrawLimit;
    Ez_Preferences.MinDrawLimit := 0;
    Selection.BeginUpdate;
    Saved:= Screen.Cursor;
    Screen.Cursor:= crHourglass;
    Try
      { detect of CTRL key is pressed }
      IsAltPressed := ( GetAsyncKeyState( VK_menu ) Shr 1 ) <> 0;
      {Scan from topmost layer}
      TickStart := GetTickCount;
      For I := GIS.Layers.Count - 1 Downto 0 Do
      Begin
        TmpLayer := GIS.Layers[I];
        With TmpLayer Do
        Begin
          If Not LayerInfo.Visible Then Continue;
          If Not LayerInfo.Selectable Then Continue;
          Case Mode Of
            gmAllInside:
              If PartialSelect Then
                SearchType := stOverlap
              Else
                SearchType := stEnclosure;
            gmCrossFrame:
              SearchType := stOverlap;
          Else
            SearchType := stOverlap;
          End;
          SetGraphicFilter( SearchType, Frame );

          First;
          StartBuffering;
          Try
            While Not Eof Do
            Begin
              If GetTickCount >= TickStart + 500 Then
              Begin
                // check if specific messages are waiting and if so, cancel internal selecting
                PeekMessage( Msg, Handle, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE );
                If ( Msg.Message = WM_KEYDOWN ) And ( Msg.WParam = VK_ESCAPE ) Then
                Begin
                  Canceled := True;
                  Break;
                End;

                TickStart := GetTickCount;
              End;
              Try
                With Grapher.CurrentParams Do
                Begin
                  Extent := RecExtension;
                  If RecIsDeleted Then Continue;

                  TmpEntityID := RecEntityID;
                  If TmpEntityID In NoPickFilter Then Continue;
                  If TmpEntityID In [idFittedVectText, idJustifVectText] Then
                  Begin
                    If Not Ez_Preferences.ShowText Then Continue;
                  End;
                  TmpEntity := Entities[TmpEntityID];
                  RecLoadEntity2( TmpEntity );
                  ARecno := TmpLayer.Recno;
                  If Mode = gmAllInside Then
                  Begin
                    If PartialSelect Then
                    Begin
                      If IsBoxInBox2D( TmpEntity.FBox, Frame ) Then
                      Begin
                        If Not IsAltPressed Then
                          Selection.Add( TmpLayer, ARecno )
                        Else
                          Selection.Delete( TmpLayer, ARecno );
                        MaxBound( SelExtent.Emax, Extent.Emax );
                        MinBound( SelExtent.Emin, Extent.Emin );
                        Result := true;
                      End;
                    End
                    Else
                    Begin
                      If IsBoxFullInBox2D( TmpEntity.FBox, Frame ) Then
                      Begin
                        If Not IsAltPressed Then
                          Selection.Add( TmpLayer, ARecno )
                        Else
                          Selection.Delete( TmpLayer, ARecno );
                        MaxBound( SelExtent.Emax, Extent.Emax );
                        MinBound( SelExtent.Emin, Extent.Emin );
                        Result := true;
                      End;
                    End;
                  End
                  Else If TmpEntity.DrawPoints.CrossFrame( Frame, TmpEntity.GetTransformMatrix ) Then
                  Begin
                    If Not IsAltPressed Then
                      Selection.Add( TmpLayer, ARecno )
                    Else
                      Selection.Delete( TmpLayer, ARecno );
                    MaxBound( SelExtent.Emax, Extent.Emax );
                    MinBound( SelExtent.Emin, Extent.Emin );
                    Result := true;
                  End;
                End;
              Finally
                Next;
              End;
            End;
          Finally
            EndBuffering;
            CancelFilter;
          End;
        End;
        If Canceled Then
          Break;
      End;
    Finally
      Selection.EndUpdate;
      For Cont := Low( TEzEntityID ) To High(

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -