main.frm

调用Geomedia的程序

VERSION 5.00
Begin VB.Form fMain 
   Caption         =   "Start command"
   ClientHeight    =   1524
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   4380
   LinkTopic       =   "Form1"
   ScaleHeight     =   1524
   ScaleWidth      =   4380
   StartUpPosition =   3  'Windows Default
   Begin VB.ComboBox cbCmdName 
      Height          =   315
      Left            =   2040
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   360
      Width           =   1935
   End
   Begin VB.ComboBox cbCategory 
      Height          =   315
      Left            =   120
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   360
      Width           =   1815
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "Start command"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   840
      Width           =   1935
   End
   Begin VB.Label Label2 
      Caption         =   "Command name"
      Height          =   255
      Left            =   2040
      TabIndex        =   2
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "Category"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1335
   End
End
Attribute VB_Name = "fMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim oGMApp As Object

' Win API desclares for PostMessage function
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_COMMAND = &H111

' Called when user selects a new command category.
' List all commands available under that category and
' save their respective command id's as item data for
' each command. ToolTip is used as command label.
Private Sub cbCategory_Click()
    ' List all commands
    cbCmdName.Clear
    Dim oCommand As Object
    For Each oCommand In oGMApp.Categories(cbCategory.Text).Commands
        cbCmdName.AddItem oCommand.ToolTip
        cbCmdName.ItemData(cbCmdName.NewIndex) = oCommand.CommandID
    Next oCommand
    
    If cbCmdName.ListCount > 0 Then
        cbCmdName.ListIndex = 0
    End If
End Sub

' Called when user wants to execute the selected command.
' Simulates a menu selection by posting a windows message
' using command ID saved as item data in command combo.
Private Sub cmdStart_Click()
    ' Execute command
    PostMessage oGMApp.AppMainhWnd, WM_COMMAND, cbCmdName.ItemData(cbCmdName.ListIndex), 0
End Sub

' Called when application is started.
' Start GeoMedia and list all available command categories
Private Sub Form_Load()
    ' Start GeoMedia
    Set oGMApp = CreateObject("GeoMedia.Application")
    oGMApp.Visible = True

    ' List all command categories
    cbCategory.Clear
    Dim oCategory As Object
    For Each oCategory In oGMApp.Categories
        cbCategory.AddItem oCategory.Name
    Next oCategory
    
    If cbCategory.ListCount > 0 Then
        cbCategory.ListIndex = 0
    End If
    
    Me.Show
End Sub

' Called when application is closed.
' Shut down GeoMedia
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    oGMApp.Quit
    Set oGMApp = Nothing
End Sub