frmselectdistance.frm

GIS地理信息系统开发。大名鼎鼎的MAPX＋VisualBasic6.0软件开发

VERSION 5.00
Begin VB.Form frmSelectDistance 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Select Within Distance"
   ClientHeight    =   1560
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6825
   Icon            =   "frmSelectDistance.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1560
   ScaleWidth      =   6825
   ShowInTaskbar   =   0   'False
   Begin VB.ComboBox SelectedLayerCombo 
      Height          =   315
      Left            =   2640
      Style           =   2  'Dropdown List
      TabIndex        =   9
      Top             =   1080
      Width           =   2775
   End
   Begin VB.ComboBox ToBeSelectedLayerCombo 
      Height          =   315
      Left            =   2640
      Style           =   2  'Dropdown List
      TabIndex        =   8
      Top             =   120
      Width           =   2775
   End
   Begin VB.CommandButton QueryButton 
      Caption         =   "Query..."
      Height          =   375
      Left            =   5520
      TabIndex        =   7
      Top             =   1080
      Width           =   1215
   End
   Begin VB.TextBox DistanceText 
      Height          =   315
      Left            =   2640
      TabIndex        =   5
      Top             =   600
      Width           =   1095
   End
   Begin VB.ComboBox DistanceUnitCombo 
      Height          =   315
      ItemData        =   "frmSelectDistance.frx":0442
      Left            =   3840
      List            =   "frmSelectDistance.frx":0479
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   600
      Width           =   1575
   End
   Begin VB.CommandButton CancelButton 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   5520
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   5520
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "of the Feature(s) Selected in:"
      Height          =   255
      Left            =   480
      TabIndex        =   6
      Top             =   1150
      Width           =   2175
   End
   Begin VB.Label Label2 
      Caption         =   "that is Within:"
      Height          =   255
      Left            =   1540
      TabIndex        =   3
      Top             =   670
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "Select Everything in the Layer:"
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   165
      Width           =   2295
   End
End
Attribute VB_Name = "frmSelectDistance"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' This sample application and corresponding sample code is provided
' for example purposes only.  It has not undergone rigorous testing
' and as such should not be shipped as part of a final application
' without extensive testing on the part of the organization releasing
' the end-user product.

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim lyr As Layer
  
    ' We want to add all normal layers to the top combobox, and only layers
    ' that have something selected in them to the bottom combobox.
    For Each lyr In fMainForm.Map1.Layers
        If lyr.Type = miLayerTypeNormal Then
            ToBeSelectedLayerCombo.AddItem lyr.Name
            If lyr.Selection.Count <> 0 Then
                SelectedLayerCombo.AddItem lyr.Name
            End If
        End If
    Next
    
    ' Add an option to select _everything_ within the given distance
    ToBeSelectedLayerCombo.AddItem "(All Layers)"
    
    ' Set the default selections
    DistanceUnitCombo.ListIndex = 0 ' Miles
    SelectedLayerCombo.ListIndex = 0
    
    ' Select "(All Layers)" by default
    ToBeSelectedLayerCombo.ListIndex = ToBeSelectedLayerCombo.ListCount - 1
End Sub

Private Sub OKButton_Click()
    ' Here, what we do is store all the selected features from the layer that the
    ' user chose in the top combobox in SourceFeatures. Then, we deselect these
    ' features in preparation for selecting others later on.
    ' Then, for each selected feature (each feature in SourceFeatures), we find
    ' all the features that are within the chosen distance of that feature and
    ' put those in FeaturesToSelect.  Then, we select those features.
    
    Dim SelectionUnit As Integer
    Dim SelectedLayer As Layer ' This is the layer chosen in the bottom combobox
    Dim ToBeSelectedLayer As Layer ' The layer chosen in the top combobox
    Dim ftr As Feature ' This gets looped over every feature in SourceFeatures
    Dim FeaturesToSelect As Features
    Dim SourceFeatures As Features
    Dim SearchDistance As Double
    
    ' Warn the user if we're selecting within all layers, which can take a long time
    If ToBeSelectedLayerCombo.Text = "(All Layers)" Then
        If MsgBox("Selecting within all layers can be a long procedure. Continue?", vbOKCancel) = vbCancel Then
            Exit Sub
        End If
    End If
    
    ' Find the units that the user picked
    SelectionUnit = IdentifyUnits
    
    On Error GoTo BadTextError
    SearchDistance = DistanceText.Text
    
    On Error GoTo BadSelectError
    ' Since we're changing around the selection any number of times in this
    ' sub, we disable the redraw while this is going on.  Also, display the
    ' hourglass cursor
    fMainForm.Map1.AutoRedraw = False
    frmSelectDistance.MousePointer = ccHourglass
    
    Set SelectedLayer = fMainForm.Map1.Layers(SelectedLayerCombo.Text)
    
    ' Get the current selection in the chosen layer
    
    Set SourceFeatures = SelectedLayer.Selection.Clone
        
    ' Then, since we'll be selecting something new, clear the selection on the
    ' entire map
    Dim lyr As MapXLib.Layer
    For Each lyr In fMainForm.Map1.Layers
        lyr.Selection.ClearSelection
    Next
    
    If ToBeSelectedLayerCombo.Text <> "(All Layers)" Then
        ' There's just one layer for which we have to select
        Set ToBeSelectedLayer = fMainForm.Map1.Layers(ToBeSelectedLayerCombo.Text)
        For Each ftr In SourceFeatures
            ' For each feature, select everything within the distance
            Set FeaturesToSelect = ToBeSelectedLayer.SearchWithinDistance(ftr, SearchDistance, SelectionUnit, miSearchTypePartiallyWithin)
            ToBeSelectedLayer.Selection.Add FeaturesToSelect
        Next
    Else
        ' The user wants to select _everything_ within the chosen distance
        ' Do this by looping over every layer and selecting as before
        For Each ToBeSelectedLayer In fMainForm.Map1.Layers
            For Each ftr In SourceFeatures
                ' For each feature, select everything within the distance
                Set FeaturesToSelect = ToBeSelectedLayer.SearchWithinDistance(ftr, SearchDistance, SelectionUnit, miSearchTypePartiallyWithin)
                ToBeSelectedLayer.Selection.Replace FeaturesToSelect
            Next
        Next
    End If
    
    ' Turn redraw back on, update the map, and restore the mousepointer
    fMainForm.Map1.AutoRedraw = True
    fMainForm.Map1.Refresh
    frmSelectDistance.MousePointer = ccDefault
    
    Unload Me
    Exit Sub
    
BadTextError:
    MsgBox "Please enter a valid numeric distance."
    Exit Sub
BadSelectError:
    MsgBox "Could not select within distance. Error #" & Str(Err) & ": " & Error
    Unload Me
End Sub

Private Sub QueryButton_Click()
    ' The Query button selects everything, then shows the Query Selection dialog
    ' to show the data attached to whatever we selected
    OKButton_Click
    frmQueryResults.Show vbModal, fMainForm
End Sub

Private Function IdentifyUnits() As Integer
    ' Find out which units the user picked in the combobox
    Dim Unit As Integer
    Select Case DistanceUnitCombo.ListIndex
        Case 0 ' Miles
            Unit = miUnitMile
        Case 1 ' Kilometers
            Unit = miUnitKilometer
        Case 2 ' Inches
            Unit = miUnitInch
        Case 3 ' Feet
            Unit = miUnitFoot
        Case 4 ' Yards
            Unit = miUnitYard
        Case 5 ' Millimeters
            Unit = miUnitMillimeter
        Case 6 ' Centimeters
            Unit = miUnitCentimeter
        Case 7 ' Meters
            Unit = miUnitMeter
        Case 8 ' Survey Feet
            Unit = miUnitSurveyFoot
        Case 9 ' Nautical Miles
            Unit = miUnitNauticalMile
        Case 10 ' Twips
            Unit = miUnitTwip
        Case 11 ' Points
            Unit = miUnitPoint
        Case 12 ' Picas
            Unit = miUnitPica
        Case 13 ' Degrees
            Unit = miUnitDegree
        Case 14 ' Links
            Unit = miUnitLink
        Case 15 ' Chains
            Unit = miUnitChain
        Case 16 ' Rods
            Unit = miUnitRod
    End Select
    IdentifyUnits = Unit
End Function