frmsearchlocation.frm

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

VERSION 5.00
Begin VB.Form frmSearchLocation 
   Caption         =   "位置查询"
   ClientHeight    =   3330
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6495
   LinkTopic       =   "Form1"
   ScaleHeight     =   3330
   ScaleWidth      =   6495
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   450
      Left            =   960
      TabIndex        =   6
      Top             =   2400
      Width           =   1215
   End
   Begin VB.ListBox lstSelLayer 
      Height          =   2040
      Left            =   3720
      TabIndex        =   4
      Top             =   840
      Width           =   2175
   End
   Begin VB.ComboBox cboSelType 
      Height          =   300
      Left            =   600
      TabIndex        =   2
      Top             =   1800
      Width           =   2175
   End
   Begin VB.ComboBox cboSelLayer 
      Height          =   300
      Left            =   600
      TabIndex        =   0
      Top             =   840
      Width           =   2175
   End
   Begin VB.Label Label3 
      Caption         =   "查找图层"
      Height          =   375
      Left            =   3720
      TabIndex        =   5
      Top             =   480
      Width           =   2295
   End
   Begin VB.Label Label2 
      Caption         =   "查找类型"
      Height          =   375
      Left            =   600
      TabIndex        =   3
      Top             =   1440
      Width           =   2175
   End
   Begin VB.Label Label1 
      Caption         =   "选择图层"
      Height          =   375
      Left            =   600
      TabIndex        =   1
      Top             =   480
      Width           =   2175
   End
End
Attribute VB_Name = "frmSearchLocation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdok_Click()
  Dim FTRS1 As MapXLib.Features
  Dim Ftr As MapXLib.Feature
  Dim FTRS As MapXLib.Features
  Dim CurLayer As MapXLib.Layer
  Dim SelLayer As MapXLib.Layer
  Dim FeaFac As FeatureFactory
  Dim SelCount As Long
  
  Set CurLayer = frmMain.MapDisp.Layers(Me.cboSelLayer.Text)
  Set SelLayer = frmMain.MapDisp.Layers(Me.lstSelLayer.List(Me.lstSelLayer.ListIndex))
  
  Set FeaFac = frmMain.MapDisp.FeatureFactory
  Set FTRS1 = SelLayer.Selection
  For Each Ftr In FTRS1
     SelCount = SelCount + 1
  Next
  CurLayer.Selection.ClearSelection
  If SelCount <> 0 Then
    Set Ftr = FeaFac.CombineFeatures(FTRS1)
    Set FTRS = CurLayer.SearchWithinFeature(Ftr, Me.cboSelType.ListIndex)
  Else
    SelLayer.Selection.SelectAll miSelectionNew
    Set FTRS1 = SelLayer.Selection
    Set Ftr = FeaFac.CombineFeatures(FTRS1)
    Set FTRS = CurLayer.SearchWithinFeature(Ftr, Me.cboSelType.ListIndex)
  End If
  
  SelLayer.Selection.ClearSelection
  If FTRS.Count <> 0 Then
    frmMain.MapDisp.Bounds = FTRS.Bounds
    For Each Ftr In FTRS
        CurLayer.Selection.Add Ftr
    Next
  End If
  
  MsgBox "共找到" & CStr(FTRS.Count) & "条记录", vbInformation
  
End Sub

Private Sub Form_Load()
  Dim Lyr As MapXLib.Layer
  
  For Each Lyr In frmMain.MapDisp.Layers
      Me.cboSelLayer.AddItem Lyr.Name
      Me.lstSelLayer.AddItem Lyr.Name
  Next
  
  Me.cboSelType.AddItem "中心位于区域"
  Me.cboSelType.AddItem "区域包含"
  Me.cboSelType.AddItem "任意部分位于区域"
  
End Sub