frmboxtype.frm

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

VERSION 5.00
Begin VB.Form frmBoxType 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "请选择包厢或座位"
   ClientHeight    =   1170
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4575
   Icon            =   "frmBoxType.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1170
   ScaleWidth      =   4575
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Height          =   1260
      Left            =   0
      TabIndex        =   3
      Top             =   -90
      Width           =   4560
      Begin VB.CommandButton cmdCancel 
         Cancel          =   -1  'True
         Caption         =   "取消(&C)"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   405
         Left            =   2820
         TabIndex        =   2
         Top             =   705
         Width           =   1530
      End
      Begin VB.CommandButton cmdLogin 
         Caption         =   "登录(&L)"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   405
         Left            =   2820
         TabIndex        =   1
         Top             =   240
         Width           =   1530
      End
      Begin VB.ComboBox cmbSite 
         BackColor       =   &H0080FFFF&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   360
         Left            =   195
         Sorted          =   -1  'True
         TabIndex        =   0
         Top             =   675
         Width           =   2400
      End
      Begin VB.Line Line4 
         BorderColor     =   &H8000000C&
         Index           =   1
         X1              =   2805
         X2              =   4350
         Y1              =   690
         Y2              =   690
      End
      Begin VB.Line Line3 
         BorderColor     =   &H00FFFFFF&
         Index           =   1
         X1              =   4350
         X2              =   4350
         Y1              =   690
         Y2              =   1110
      End
      Begin VB.Line Line2 
         BorderColor     =   &H00FFFFFF&
         Index           =   1
         X1              =   2805
         X2              =   4365
         Y1              =   1110
         Y2              =   1110
      End
      Begin VB.Line Line1 
         BorderColor     =   &H8000000C&
         Index           =   1
         X1              =   2805
         X2              =   2805
         Y1              =   705
         Y2              =   1125
      End
      Begin VB.Line Line4 
         BorderColor     =   &H8000000C&
         Index           =   0
         X1              =   2805
         X2              =   4350
         Y1              =   225
         Y2              =   225
      End
      Begin VB.Line Line3 
         BorderColor     =   &H00FFFFFF&
         Index           =   0
         X1              =   4350
         X2              =   4350
         Y1              =   225
         Y2              =   645
      End
      Begin VB.Line Line2 
         BorderColor     =   &H00FFFFFF&
         Index           =   0
         X1              =   2805
         X2              =   4365
         Y1              =   645
         Y2              =   645
      End
      Begin VB.Line Line1 
         BorderColor     =   &H8000000C&
         Index           =   0
         X1              =   2805
         X2              =   2805
         Y1              =   240
         Y2              =   660
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "选择需要点菜的座位："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   210
         TabIndex        =   4
         Top             =   360
         Width           =   2100
      End
   End
End
Attribute VB_Name = "frmBoxType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmbSite_KeyDown(KeyCode As Integer, Shift As Integer)

  On Error Resume Next
  
  If KeyCode = 13 Then
     cmdLogin.SetFocus
  End If
  
End Sub

Private Sub cmdCancel_Click()

  Unload Me
  
End Sub

Private Sub cmdLogin_Click()
  
  On Error GoTo CheckSite
  If cmbSite.Text = "" Then
     MsgBox "座位为空，不能登录。", vbInformation
     cmbSite.SetFocus
     Exit Sub
  End If
 '检查是否存在的座位号
  Dim EF As Recordset
  Dim DB As Connection
  Set DB = CreateObject("ADODB.Connection")
  Set EF = CreateObject("ADODB.Recordset")
      DB.Open Constr
     '4为维修时，或者3结帐后不能点菜
      EF.Open "Select * from SiteType Where Class='" & Trim(cmbSite.Text) & "' And SiteStatus<4", DB, adOpenStatic, adLockReadOnly, adCmdText
      If EF.EOF And EF.BOF Then
         EF.Close
         DB.Close
         MsgBox "没有找到该座位号或者『该桌正在维修中』" & vbCrLf _
              & "如果不记得座位编号,请点击右边按钮选择。 " & vbCrLf & vbCrLf & "否则出错了,可得你赔钱 ：-<  别怨我没有提醒。   ", vbExclamation, "飞鸿哥:Silong."
         cmbSite.Text = ""
         cmbSite.SetFocus
         Exit Sub
      End If
  EF.Close
  Set EF = Nothing
  DB.Close
  Set DB = Nothing
  
 '显示该桌的消费记录与点菜
  frmBoxForm.sBoxSite = Trim(cmbSite.Text)
  Unload Me
  frmBoxForm.Show
  
   Exit Sub
  
CheckSite:
   MsgBox "检查座位号出错：" & Err.Description, vbCritical
   Exit Sub

End Sub

Private Sub Form_Load()

  GetFormSet Me, Screen
  ConfigSite
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveFormSet Me
  
End Sub

Private Sub ConfigSite()

   On Error GoTo Err_init
   Dim DB As Connection
   Dim EF As Recordset, sEXE As String
   
   Set DB = CreateObject("ADODB.Connection")
   Set EF = CreateObject("ADODB.Recordset")
      '维修的餐桌不列入
       sEXE = "Select * From SiteType Where SiteStatus<4"
       DB.Open Constr
       EF.Open sEXE, DB, adOpenStatic, adLockReadOnly, adCmdText
     If EF.EOF And EF.BOF Then
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
        Exit Sub
      Else
        Do While Not EF.EOF
           cmbSite.AddItem EF.Fields("Class")
           EF.MoveNext
        Loop
     End If
     EF.Close
     Set EF = Nothing
     DB.Close
     Set DB = Nothing
    '直接指向座位号
     If cmbSite.ListCount > 1 Then
        If sInfoSite <> "" Then
           cmbSite.ListIndex = SendMessage(cmbSite.hwnd, CB_FINDSTRING, -1, ByVal sInfoSite)
         Else
           cmbSite.ListIndex = 0
        End If
     End If
     Exit Sub
     
Err_init:
    MsgBox "装载（座位）未知错误！" & Err.Description, vbExclamation, "错误：By Yusilong."

End Sub