frmselectfeature.frm

有关geomedia的一个全新的gis工程

VERSION 5.00
Begin VB.Form frmSelectFeature 
   Caption         =   "SelectFeature"
   ClientHeight    =   4560
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3855
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4560
   ScaleWidth      =   3855
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton CmdCANCEL 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2760
      TabIndex        =   5
      Top             =   4080
      Width           =   1095
   End
   Begin VB.CommandButton CmdOK 
      Caption         =   "OK"
      Height          =   375
      Left            =   1680
      TabIndex        =   4
      Top             =   4080
      Width           =   975
   End
   Begin VB.ListBox LstFeatures 
      Height          =   2400
      Left            =   0
      TabIndex        =   1
      Top             =   1320
      Width           =   3855
   End
   Begin VB.TextBox TxtConnectionName 
      Enabled         =   0   'False
      Height          =   270
      Left            =   0
      TabIndex        =   0
      Top             =   480
      Width           =   3855
   End
   Begin VB.Label Label2 
      Caption         =   "Connection Location:"
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   120
      Width           =   1815
   End
   Begin VB.Label Label1 
      Caption         =   "Select a &feature:"
      Height          =   255
      Left            =   0
      TabIndex        =   2
      Top             =   840
      Width           =   1935
   End
End
Attribute VB_Name = "frmSelectFeature"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim boolCancel As Boolean

Private Sub CmdCANCEL_Click()
    boolCancel = True
    Hide
End Sub

Private Sub Cmdok_Click()
    boolCancel = False
    Hide
End Sub

Public Sub GetSelectFeatureInfo(objConnection As Connection, _
            strTableName As String)
'Procedure to display frmSelectFeature and return the info the user chose
'on the form.
    On Error GoTo ErrorHandler

'Check to ensure at least one connection exists.
    If gobjConnection.Status = gmcStatusClosed Then
        MsgBox "You must open a connection first.", MSGBOX_ERROR, "Select Feature"
        Set gobjConnection = Nothing
        strTableName = ""
        Exit Sub
    Else
      boolCancel = False
      InitForm
      Show 1
    End If
'If he cancelled, return an empty object and string.
    If boolCancel Then
        strTableName = ""
        
'Otherwise, return the selected  table name.
    Else
        strTableName = LstFeatures.List(LstFeatures.ListIndex)
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description, MSGBOX_ERROR, "Select Feature"
    On Error Resume Next
    Set gobjConnection = Nothing
    strTableName = ""

End Sub
Private Sub InitForm()
On Error GoTo ErrorHandler
    LstFeatures.Clear
    If gobjConnection.Status = gmcStatusOpen Then
        Dim objMDSrvc As New MetadataService
        Set objMDSrvc.Connection = gobjConnection
        Dim vTableList As Variant
        Dim tmask As Long
        tmask = 1 + 2 + 4 + 8 + 32 + 128
        objMDSrvc.GetTables tmask, vTableList
        Dim i As Integer
        For i = 0 To (UBound(vTableList) - LBound(vTableList) - 1)
            LstFeatures.AddItem vTableList(i)
        Next i
        Set objMDSrvc = Nothing
        LstFeatures.ListIndex = 0
        frmSelectFeature.TxtConnectionName.Text = gobjConnection.Location
    Else
        MsgBox "The selected connection is not open.", vbOKOnly, "Select Feature"
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description, MSGBOX_ERROR, "Select Feature"
    Set objMDSrvc = Nothing
    
End Sub