frmlabel.frm

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

VERSION 5.00
Begin VB.Form frmLabel 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Generate Labels"
   ClientHeight    =   3735
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5070
   HelpContextID   =   80805
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3735
   ScaleWidth      =   5070
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton btnCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   350
      Left            =   3840
      TabIndex        =   5
      Top             =   3300
      Width           =   1125
   End
   Begin VB.ListBox lstAttributes 
      Height          =   2790
      Left            =   2700
      Sorted          =   -1  'True
      TabIndex        =   4
      Top             =   390
      Width           =   2265
   End
   Begin VB.CommandButton btnOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   350
      Left            =   2565
      TabIndex        =   3
      Top             =   3300
      Width           =   1125
   End
   Begin VB.ListBox lstFeatures 
      Height          =   2790
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   390
      Width           =   2265
   End
   Begin VB.Label Label2 
      Caption         =   "&Attributes:"
      Height          =   255
      Left            =   2700
      TabIndex        =   2
      Top             =   135
      Width           =   870
   End
   Begin VB.Label Label1 
      Caption         =   "&Feature classes:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   135
      Width           =   1215
   End
End
Attribute VB_Name = "frmLabel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim bOK As Boolean
Dim oMDS As New MetadataService

Public Function GetLabelInfo(oConnection As Connection, _
    sFeature As String, sAttribute As String) As Boolean
    
'GetLabelInfo   return  TRUE = user selected OK
'                       FALSE = user selected Cancel
'oConnection    input   open connection
'sFeature       output  chosen feature name
'sAttribute     output  chosen attribute name

    On Error GoTo ErrorHandler
    
'Populate list box with features names of the current connection.
    Set oMDS.Connection = oConnection
    Dim vFeatures As Variant
'    oMDS.GetTables 0, vFeatures
    oMDS.GetTables 1 + 2 + 4 + 8 + 32 + 128, vFeatures 'gmmtPoint + gmmtLinear + gmmtAreal + gmmtAnySpatial + gmmtGraphicsText + gmmtGraphic, _

    Dim i As Long
    For i = LBound(vFeatures) To UBound(vFeatures) - 1
        lstFeatures.AddItem vFeatures(i)
    Next
    lstFeatures.ListIndex = 0   'select the first item
    
'Display the dialog as modal.
    Show vbModal
    
'Set return value and output arguments.
    GetLabelInfo = bOK
    If bOK Then
        sFeature = lstFeatures.List(lstFeatures.ListIndex)
        sAttribute = lstAttributes.List(lstAttributes.ListIndex)
    End If
    
    GoTo Finish

ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext

Finish:
    On Error Resume Next
    Set oMDS = Nothing
    Unload Me

End Function

Private Sub btnCancel_Click()
    bOK = False
    Hide
End Sub

Private Sub btnOK_Click()
    bOK = True
    Hide
End Sub

Private Sub lstFeatures_Click()

    On Error GoTo ErrorHandler
    
    'Populate attribute list with field names of currently selected table.
    oMDS.TableName = lstFeatures.List(lstFeatures.ListIndex)
    Dim vFields As Variant
    oMDS.GetFields 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128 + 256, vFields 'gmmfBoolean + gmmfByte + gmmfInteger + gmmfLong + gmmfCurrency + gmmfSingle + gmmfDouble + gmmfDate + gmmfText
    lstAttributes.Clear
    Dim i As Long
    For i = LBound(vFields) To UBound(vFields) - 1
        lstAttributes.AddItem vFields(i)
    Next
    lstAttributes.ListIndex = 0   'select the first item
    GoTo Finish

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Source & Chr(13) & _
        Err.Description, vbOKOnly + vbExclamation

Finish:
    On Error Resume Next
    
End Sub