VB6 Dialog Example

DebugMenuDialog.frm

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form DebugMenuDialog 
   BorderStyle     =   4  '單線固定工具視窗
   Caption         =   "Debug Menu Dialog"
   ClientHeight    =   4230
   ClientLeft      =   2760
   ClientTop       =   3705
   ClientWidth     =   6795
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3204.546
   ScaleMode       =   0  '使用者自訂
   ScaleWidth      =   7787.966
   ShowInTaskbar   =   0   'False
   Begin MSComctlLib.ListView lsvMenu 
      Height          =   3525
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   6315
      _ExtentX        =   11139
      _ExtentY        =   6218
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   3
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Func ID"
         Object.Width           =   1847
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "Func Name"
         Object.Width           =   5541
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "Value"
         Object.Width           =   5540
      EndProperty
   End
   Begin VB.Label Label1 
      Alignment       =   2  '置中對齊
      Caption         =   "選取測試功能"
      BeginProperty Font 
         Name            =   "新細明體"
         Size            =   14.25
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   240
      TabIndex        =   1
      Top             =   90
      Width           =   6315
   End
End
Attribute VB_Name = "DebugMenuDialog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'
' 功能說明：簡易的功能選單選取器。設計用於開發與 Debug 程式
'

Option Explicit

Public DialogResult As String

Public Sub AddMenu(funcId As String, funcName As String, ssCommand As String)
    With lsvMenu.ListItems.Add(, funcId, funcId)
        .SubItems(1) = funcName
        .SubItems(2) = ssCommand
    End With
End Sub

Public Function ShowDialog() As String
    Me.Show 1 'vbModel
    ShowDialog = DialogResult
End Function

Private Sub Form_Load()

   '# 初始化功能選單
    With lsvMenu.ListItems.Add(, "FOSM0010", "FOSM0010")
        .SubItems(1) = "FOSM0010_Name"
        .SubItems(2) = "FOSM0010_ConnString"
    End With

    With lsvMenu.ListItems.Add(, "FOSM0020", "FOSM0020")
        .SubItems(1) = "FOSM0020_Name"
        .SubItems(2) = "FOSM0020_ConnString"
    End With

    With lsvMenu.ListItems.Add(, "FOSM0030", "FOSM0030")
        .SubItems(1) = "FOSM0030_Name"
        .SubItems(2) = "FOSM0030_ConnString"
    End With
End Sub

Private Sub lsvMenu_DblClick()
    DialogResult = lsvMenu.SelectedItem.SubItems(2) 
    Unload Me ' Close this dialog
End Sub

MainPartial.vb

'# 應用範例：欲執行的功能

Dim dlgMenu As New DebugMenuDialog '功能說明：簡易的功能選單選取器。設計用於開發與 Debug 程式
Dim ssSubCommand As String

dlgMenu.AddMenu "FOSM0040", "ChargeBack Requested Screen" _
    , "SEC" & Chr(9) & "FOSM0040" & Chr(9) & "功能名稱" & Chr(9) & "frmFOSM0040" & Chr(9)

dlgMenu.AddMenu "FOSM0050", "Write-Off Request Screen" _
    , "SEC" & Chr(9) & "FOSM0050" & Chr(9) & "功能名稱" & Chr(9) & "frmFOSM0050" & Chr(9) 

dlgMenu.AddMenu "FOSX0090", "Create Sub System" _
    , "SEC" & Chr(9) & "FOSX0090" & Chr(9) & "功能名稱" & Chr(9) & "frmFOSX0090" & Chr(9)

ssSubCommand = dlgMenu.ShowDialog()
If ssSubCommand = "" Then '未選取功能選單。
    Exit Sub
End If
    
ssCommand = ssCommand & ssSubCommand ' to combine command

Set dlgMenu = Nothing 'release resource