frminfo.frm

地理信息系统工程案例精选程序,本书所有案例均需要单独配置

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmInfo 
   Caption         =   "数据显示"
   ClientHeight    =   4320
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7560
   Icon            =   "frmInfo.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4320
   ScaleWidth      =   7560
   StartUpPosition =   1  '所有者中心
   Begin MSComctlLib.TreeView treeStruct 
      Height          =   4095
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   2055
      _ExtentX        =   3625
      _ExtentY        =   7223
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   0
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      Appearance      =   1
   End
   Begin MSComctlLib.ListView lstInfo 
      Height          =   4095
      Left            =   2280
      TabIndex        =   0
      Top             =   120
      Width           =   5175
      _ExtentX        =   9128
      _ExtentY        =   7223
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.Label lblResult 
      Caption         =   "Label1"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   2055
   End
   Begin VB.Label lblLayer 
      Caption         =   "Label1"
      Height          =   255
      Left            =   2280
      TabIndex        =   1
      Top             =   120
      Width           =   5055
   End
End
Attribute VB_Name = "frmInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private RecInfo As MapObjects2.Recordset
Private LastNodeName As String
Private Sub Refresh_lstInfo(LayerName As String, strID As String)
'显示指定记录的信息

'获取图层
Dim LayerX As MapObjects2.MapLayer
Set LayerX = frmMain.Map1.Layers(LayerName)

'初始化表头
lstInfo.ColumnHeaders.Clear
lstInfo.ColumnHeaders.Add text:="字段", Width:=lstInfo.Width * 0.25
lstInfo.ColumnHeaders.Add text:="值", Width:=lstInfo.Width * 0.75
lstInfo.ListItems.Clear
'获取记录集
Set RecInfo = LayerX.SearchExpression("SID = " & CStr(Val(strID)))

Dim FieldX As MapObjects2.Field
Dim ListX As ListItem
Dim lpField As Long

RecInfo.MoveFirst

'显示信息
If Not RecInfo.EOF Then
    For lpField = 0 To RecInfo.TableDesc.FieldCount - 1
        Set FieldX = RecInfo.Fields(RecInfo.TableDesc.FieldName(lpField))
        If Not bIsExcept(FieldX.Name, NameToIndex(LayerName)) Then
            Set ListX = lstInfo.ListItems.Add
            ListX.text = FieldX.Name
            ListX.SubItems(1) = FieldX.ValueAsString
        End If
        DoEvents
    Next
End If

'闪烁图形
frmMain.Map1.FlashShape RecInfo.Fields("Shape").Value, 1
End Sub
Private Sub Form_Resize()
'根据窗口大小改变控件大小
If frmInfo.WindowState <> 1 Then
    If frmInfo.Width - 2505 < 100 Then frmInfo.Width = 2650
    If frmInfo.Height - 975 < 100 Then frmInfo.Height = 1075
    lstInfo.Width = frmInfo.Width - 2505
    lstInfo.Height = frmInfo.Height - 735
    treeStruct.Height = lstInfo.Height
End If

End Sub
Private Function treeStruct_Refresh(lIndex As Long, x As Single, Y As Single) As String
'根据用户的鼠标输入,更新treeView控件
Dim lpLayer As Long
Dim LayerX As MapObjects2.MapLayer
Dim PointX As New MapObjects2.POINT
Dim NodeLayer As Node
Dim NodeResult As Node
Dim FirstNodeName As String
Set PointX = frmMain.Map1.ToMapPoint(x, Y)
treeStruct.Nodes.Clear
FirstNodeName = ""
With frmMain.abProMap.Bands("barStandard").Tools("cmbWork")
    For lpLayer = 0 To .CBListCount - 1
        Set LayerX = frmMain.Map1.Layers(.CBList(lpLayer))
        Select Case LayerX.shapeType
            '根绝图层类型选择搜索方式
            Case moShapeTypePolygon
                Set RecInfo = LayerX.SearchShape(PointX, moPointInPolygon, "")
            Case Else
                Set RecInfo = LayerX.SearchByDistance(PointX, modDefinition.Search_PointTolerance, "")
        End Select
        RecInfo.MoveFirst
        If Not RecInfo.EOF Then
            '若此层在指定点附近有地理对象
            '则显示节点
            Set NodeLayer = treeStruct.Nodes.Add(, , "!Layer!" & LayerX.Name, LayerX.Name)
            Do Until RecInfo.EOF
                If FirstNodeName = "" And lIndex = NameToIndex(LayerX.Name) Then FirstNodeName = LayerX.Name & "!!" & RecInfo.Fields("SID").ValueAsString
                treeStruct.Nodes.Add "!Layer!" & LayerX.Name, tvwChild, LayerX.Name & "!!" & RecInfo.Fields("SID").ValueAsString, RecInfo.Fields("SID").ValueAsString
                RecInfo.MoveNext
            Loop
        End If
    Next lpLayer
End With
'返回第一个节点,也即是最上层的符合条件的地理对象节点
treeStruct_Refresh = FirstNodeName

End Function

Public Function ProInfo_GetRecSet(lIndex As Long, x As Single, Y As Single) As Boolean
'获取指定地理对象的信息
lblLayer.Caption = ""
lblResult.Caption = ""
LastNodeName = ""
Dim strNodeName As String
strNodeName = treeStruct_Refresh(lIndex, x, Y)
If treeStruct.Nodes.Count <= 0 Then
    ProInfo_GetRecSet = False
Else
    If strNodeName <> "" Then
    treeStruct.SelectedItem = treeStruct.Nodes(strNodeName)
    End If
    ProInfo_GetRecSet = True
    DisplayInfo
    LastNodeName = strNodeName
End If

End Function
Private Sub DisplayInfo()
'显示指定地理对象信息
Dim LayerName As String
Dim strID As String
Dim lSeek As Long
If Not treeStruct.SelectedItem Is Nothing Then
    If treeStruct.SelectedItem.Key = LastNodeName Then Exit Sub
    LastNodeName = treeStruct.SelectedItem.Key
    
    If Len(treeStruct.SelectedItem.Key) > 7 Then
        If Mid(treeStruct.SelectedItem.Key, 1, 7) <> "!Layer!" Then
            lSeek = InStr(1, treeStruct.SelectedItem.Key, "!!")
            LayerName = Mid(treeStruct.SelectedItem.Key, 1, lSeek - 1)
            strID = Mid(treeStruct.SelectedItem.Key, lSeek + 2)
            Call Refresh_lstInfo(LayerName, strID)
        End If
    Else
        lSeek = InStr(1, treeStruct.SelectedItem.Key, "!!")
        LayerName = Mid(treeStruct.SelectedItem.Key, 1, lSeek - 1)
        strID = Mid(treeStruct.SelectedItem.Key, lSeek + 2)
        Call Refresh_lstInfo(LayerName, strID)
    
    End If
End If

End Sub
Private Sub treeStruct_Click()
    Call DisplayInfo
End Sub