frmsearch.frm

一个交通专用的gis-T系统

VERSION 5.00
Begin VB.Form FrmSearch 
   Caption         =   "图元对象搜索"
   ClientHeight    =   3030
   ClientLeft      =   2355
   ClientTop       =   2610
   ClientWidth     =   2910
   Icon            =   "FrmSearch.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3030
   ScaleWidth      =   2910
   Begin VB.CommandButton cmdshow 
      Caption         =   "定位"
      Enabled         =   0   'False
      Height          =   375
      Left            =   1920
      TabIndex        =   7
      Top             =   1920
      Width           =   975
   End
   Begin VB.ListBox List1 
      Height          =   1320
      Left            =   0
      TabIndex        =   4
      Top             =   1440
      Width           =   1815
   End
   Begin VB.CommandButton cmdcancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   1920
      TabIndex        =   8
      Top             =   2640
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "搜索范围设置"
      Height          =   1215
      Left            =   0
      TabIndex        =   5
      Top             =   120
      Width           =   2895
      Begin VB.ComboBox cmbval 
         Height          =   315
         Left            =   960
         TabIndex        =   2
         Text            =   "Combo1"
         Top             =   840
         Width           =   735
      End
      Begin VB.TextBox txtval 
         Height          =   315
         Left            =   1800
         TabIndex        =   3
         Top             =   840
         Width           =   975
      End
      Begin VB.ComboBox cmbfield 
         Height          =   315
         Left            =   1440
         TabIndex        =   1
         Text            =   "字段选择"
         Top             =   360
         Width           =   1335
      End
      Begin VB.ComboBox cmblayer 
         Height          =   315
         Left            =   120
         TabIndex        =   0
         Text            =   "图层选择"
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label1 
         Caption         =   "搜索值："
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   885
         Width           =   855
      End
   End
   Begin VB.CommandButton cmdsearch 
      Caption         =   "搜索"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   375
      Left            =   1920
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   1560
      Width           =   975
   End
End
Attribute VB_Name = "FrmSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************
'*
'*                本源码完全免费，共交通同仁学习参考                 *
'*                      www.tranbbs.com                              *
'*                   Developed by Yang Ming                          *
'*       Nanjing Institute of City Transportation Planning           *
'*                 请保留本版权信息，谢谢合作                        *
'*                      中国交通技术论坛                             *
'*                                                                   *
'*                                                                   *
'*********************************************************************
Private Sub cmbfield_Click()

    txtval.SetFocus
    
End Sub

Private Sub cmblayer_Click()
        cmbfield.Clear
        List1.Clear
        '遍历表中的字段，将其字段名添加到 List2 中。
        For Each Fd In mDbBiblio.TableDefs(cmblayer.Text).Fields
            cmbfield.AddItem Fd.Name
        Next
        '控制cmdsel按钮数组的有效性，以免发生错误。
        If cmbfield.ListCount <> 0 Then
            cmdsearch.Enabled = True
            cmbfield.Text = cmbfield.List(0)
           Else
            cmdsearch.Enabled = False
        End If
        '获取要查询的表名。
        
        TbName = cmbfield.Text
End Sub


Private Sub cmbval_Click()
        txtval.SetFocus
End Sub

Private Sub Cmdcancel_Click()
    Unload Me
End Sub

Private Sub cmdsearch_Click()

    List1.Clear
    
    Dim TbName, FdName As String
    Dim SelVal, KeyV As String
    Dim RsResult As Recordset
    
    TbName = cmblayer.Text
    FdName = cmbfield.Text
    SelVal = cmbval.Text
    KeyV = txtval.Text
    
    Set RsResult = mDbBiblio.OpenRecordset("select * from " & TbName & " where " & FdName & " " & SelVal & " " & KeyV)
    
    If RsResult.RecordCount <> 0 Then
        RsResult.MoveFirst
        Do Until RsResult.EOF
            If TbName = "Nodes" Then
                List1.AddItem RsResult!NodeId
            ElseIf TbName = "Links" Then
                List1.AddItem RsResult!LinkId
            End If
            RsResult.MoveNext
        Loop
    Else
        MsgBox "没有找到记录！"
        Exit Sub
    End If
    
End Sub

Private Sub cmdshow_Click()
    Dim SearchVal As String
    Dim Ftr As Feature
    Dim Ftrs As Features
    Dim Lyr As Layer
    
    Load FrmProgress
    FrmProgress.Show
    Dim stval
    step = 0
    If List1.Text <> "" Then
        If cmblayer.Text = "Nodes" Then
            Set Lyr = Main.Mapshow.Layers("Node")
            Lyr.KeyField = "NodeId"
            If Lyr.AllFeatures.Count <> 0 Then
            stval = 100 / Lyr.AllFeatures.Count
            End If
            
            For Each Ftr In Lyr.AllFeatures
                step = step + stval
                Progress step, "节点查找中..."
                If Ftr.KeyValue = List1.Text Then
                        Main.Mapshow.Zoom = 100
                        Main.Mapshow.CenterX = Ftr.CenterX
                        Main.Mapshow.CenterY = Ftr.CenterY
                        Main.Mapshow.Layers("Node").Selection.Add Ftr
                End If
            Next
        ElseIf cmblayer.Text = "Links" Then
            Set Lyr = Main.Mapshow.Layers("Link")
            Lyr.KeyField = "LinkId"
            If Lyr.AllFeatures.Count <> 0 Then
            stval = 100 / Lyr.AllFeatures.Count
            End If
            For Each Ftr In Lyr.AllFeatures
                        step = step + stval
                Progress step, "路段查找中..."
                If Ftr.KeyValue = List1.Text Then
                        
                        Main.Mapshow.CenterX = Ftr.CenterX
                        Main.Mapshow.CenterY = Ftr.CenterY
                        Main.Mapshow.Layers("Link").Selection.Add Ftr
                End If
            Next
        End If
    End If
    
    Unload FrmProgress

    
End Sub

Private Sub Form_Load()

        Dim x, tdf
        For x = 0 To mDbBiblio.TableDefs.Count - 1
        Set tdf = mDbBiblio.TableDefs(x)
        If (tdf.Attributes And dbSystemObject) = 0 Then '避开系统的 Table
        cmblayer.AddItem mDbBiblio.TableDefs(x).Name
        End If
        Next
       
        cmbval.AddItem ">"
        cmbval.AddItem "="
        cmbval.AddItem "<"
        cmbval.Text = "="
        
        
        SQL_str = ""
        
End Sub


Private Sub List1_Click()
    
    cmdshow.Enabled = True
    cmdshow.SetFocus
    
End Sub

Private Sub txtval_Change()
    cmdsearch.Enabled = True
End Sub