frmdistancesearch.frm

师兄做的一个利用VB结合mapx组件做的超市查询小系统

VERSION 5.00
Begin VB.Form frmDistanceSearch 
   Caption         =   "距离查询"
   ClientHeight    =   3780
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4065
   LinkTopic       =   "Form1"
   ScaleHeight     =   3780
   ScaleWidth      =   4065
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox cboSelLayer 
      Height          =   300
      Left            =   1680
      TabIndex        =   9
      Top             =   2300
      Width           =   1335
   End
   Begin VB.ComboBox cboSelType 
      Height          =   300
      Left            =   1680
      TabIndex        =   7
      Top             =   1692
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   495
      Left            =   2040
      TabIndex        =   3
      Top             =   2880
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   495
      Left            =   240
      TabIndex        =   2
      Top             =   2880
      Width           =   1215
   End
   Begin VB.ComboBox cboUnit 
      Height          =   300
      Left            =   1680
      TabIndex        =   1
      Top             =   1086
      Width           =   1335
   End
   Begin VB.TextBox txtDistance 
      Height          =   300
      Left            =   1680
      TabIndex        =   0
      Top             =   480
      Width           =   1335
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "选择图层"
      Height          =   180
      Left            =   360
      TabIndex        =   8
      Top             =   2400
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "类型："
      Height          =   180
      Left            =   360
      TabIndex        =   6
      Top             =   1800
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "距离："
      Height          =   180
      Left            =   360
      TabIndex        =   5
      Top             =   600
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "地图单位："
      Height          =   180
      Left            =   360
      TabIndex        =   4
      Top             =   1200
      Width           =   900
   End
End
Attribute VB_Name = "frmDistanceSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim MapUnit As Integer
Dim Lyr As MapXLib.Layer


Private Sub cboUnit_Click()
  MapUnit = cboUnit.ListIndex
End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub

Private Sub cmdok_Click()
  Dim CurrentLayer As MapXLib.Layer
  Dim FTRS As MapXLib.Features
  Dim Ftr As MapXLib.Feature
  Dim FeaFac As FeatureFactory
  Dim customersFound As Features

  Set FeaFac = frmMain.MapDisp.FeatureFactory
  Set Lyr = frmMain.MapDisp.Layers(cboSelLayer.Text)
  
  For Each CurrentLayer In frmMain.MapDisp.Layers
    If CurrentLayer.Selection.Count <> 0 Then
        Set Ftr = FeaFac.CombineFeatures(CurrentLayer.Selection)
     
        Set FTRS = Lyr.SearchWithinDistance(Ftr, Val(txtDistance.Text), MapUnit, cboSelType.ListIndex)
        Set customersFound = FTRS.Clone
        customersFound.Common FTRS
        Lyr.Selection.Replace customersFound
    End If
  Next
  
  Unload Me
End Sub

Private Sub Form_Load()
  For Each Lyr In frmMain.MapDisp.Layers
      Me.cboSelLayer.AddItem Lyr.Name
  Next
  
  cboUnit.AddItem "Mile"
  cboUnit.AddItem "Kilometer"
  cboUnit.AddItem "Inch"
  cboUnit.AddItem "Foot"
  cboUnit.AddItem "Yard"
  cboUnit.AddItem "Millimeter"
  cboUnit.AddItem "Centimeter"
  cboUnit.AddItem "Meter"
  cboUnit.AddItem "SurveyFoot"
  cboUnit.AddItem "NauticalMile"
  cboUnit.AddItem "Twip"
  cboUnit.AddItem "Point"
  cboUnit.AddItem "Pica"
  cboUnit.AddItem "Degree"
  cboUnit.AddItem "Link"
  cboUnit.AddItem "Chain"
  cboUnit.AddItem "Rod"
  cboUnit.ListIndex = 7
  
  Me.cboSelType.AddItem "中心位于区域"
  Me.cboSelType.AddItem "区域包含"
  Me.cboSelType.AddItem "任意部分位于区域"
End Sub