frmselectcat.frm

星级酒店管理系统（附带系统自写控件源码）

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSelectCat 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择酒席"
   ClientHeight    =   3660
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7950
   Icon            =   "frmSelectCat.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3660
   ScaleWidth      =   7950
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdOK 
      Caption         =   "选定(&O)"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   390
      Left            =   5535
      TabIndex        =   4
      Top             =   2970
      Width           =   1155
   End
   Begin VB.CommandButton cmdClos 
      Cancel          =   -1  'True
      Caption         =   "关闭(&C)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   390
      Left            =   6735
      TabIndex        =   2
      Top             =   2970
      Width           =   1155
   End
   Begin VB.Frame Frame1 
      Caption         =   "已经配置的酒席列表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000040C0&
      Height          =   2745
      Left            =   30
      TabIndex        =   0
      Top             =   150
      Width           =   7905
      Begin MSComctlLib.ListView lstPro 
         Height          =   2460
         Left            =   45
         TabIndex        =   1
         ToolTipText     =   "双击选定该酒席。"
         Top             =   240
         Width           =   7815
         _ExtentX        =   13785
         _ExtentY        =   4339
         View            =   3
         LabelEdit       =   1
         LabelWrap       =   -1  'True
         HideSelection   =   0   'False
         AllowReorder    =   -1  'True
         FullRowSelect   =   -1  'True
         GridLines       =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   5
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "酒席编号"
            Object.Width           =   2469
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   1
            Text            =   "酒席名称"
            Object.Width           =   2822
         EndProperty
         BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            SubItemIndex    =   2
            Text            =   "价 格"
            Object.Width           =   1411
         EndProperty
         BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   3
            Text            =   "类型"
            Object.Width           =   2117
         EndProperty
         BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   4
            Text            =   "描述"
            Object.Width           =   4233
         EndProperty
      End
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   45
      Picture         =   "frmSelectCat.frx":08CA
      Top             =   2955
      Width           =   480
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "请在酒席列表中双击,或点击（选定）按钮,确认选择。"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   645
      TabIndex        =   3
      Top             =   3090
      Width           =   4695
   End
End
Attribute VB_Name = "frmSelectCat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub cmdClos_Click()

  Unload Me
  
End Sub

Private Sub cmdOK_Click()

  If lstPro.ListItems.Count = 0 Then Exit Sub
  If lstPro.SelectedItem.Text = "" Then
     MsgBox "请选定酒席后,再按选定按钮？  ", vbExclamation
     lstPro.SetFocus
     Exit Sub
  End If
  
 '返回
  sMenuID = lstPro.SelectedItem.Text
  Unload Me
     
End Sub

Private Sub Form_Load()

  GetFormSet Me, Screen
  sMenuID = ""
  
 '给出酒席列表
  GetIntegration
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveFormSet Me
  
End Sub

Private Sub GetIntegration()
  
  On Error GoTo Ett
  
  lstPro.ListItems.Clear
  Me.MousePointer = 11
  Dim iDB As Connection
  Dim iRS As Recordset
  Set iDB = CreateObject("ADODB.Connection")
  Set iRS = CreateObject("ADODB.Recordset")
      iDB.Open Constr
      iRS.Open "Select * from tbdMenuCat", iDB, adOpenStatic, adLockReadOnly, adCmdText
      If Not (iRS.EOF And iRS.BOF) Then
         Do While Not iRS.EOF
            InsertToIntegration lstPro, iRS("MenuID"), iRS("MenuName"), iRS("MenuPrice"), NullValue(iRS("MenuType")), NullValue(iRS("MenuDescription"))
            iRS.MoveNext
         Loop
      End If
      iRS.Close
      Set iRS = Nothing
      iDB.Close
      Set iDB = Nothing
      Me.MousePointer = 0
  
      Exit Sub
Ett:
      Me.MousePointer = 0
      MsgBox "给出酒席错误:" & Err.Description, vbCritical
      Exit Sub
  
End Sub

Private Sub InsertToIntegration(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String, sText5 As String)
 
   On Error Resume Next
   
   If Trim(sText1) = "" Then Exit Sub
   
   Dim lstTmp As ListItem
   Set lstTmp = tmpView.ListItems.Add
       lstTmp.Text = Trim(sText1)
       lstTmp.SubItems(1) = Trim(sText2)
       lstTmp.SubItems(2) = Trim(sText3)
       lstTmp.SubItems(3) = Trim(sText4)
       lstTmp.SubItems(4) = Trim(sText5)
       
End Sub

Private Sub lstPro_DblClick()
    
  Call cmdOK_Click
  
End Sub