frmnewbook.frm

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

End Sub

Private Sub cmdDate_Click()

  dtpExpireDate.Value = Date
  
End Sub

Private Sub cmdOK_Click()

   On Error GoTo BookERRR
   
  '1/检查是否完整
   If Trim(ftCName.Text) = "" Then
      MsgBox "联系人姓名不能为空？  " & vbCrLf _
           & "请输入或选择会员编号后,自动显示。  ", vbExclamation
         ftCName.SetFocus
         Exit Sub
   End If
   If Trim(ftTel.Text) = "" Then
      MsgBox "联系电话不能为空？  " & vbCrLf _
           & "请输入或选择会员编号后,自动显示。  ", vbExclamation
         ftTel.SetFocus
         Exit Sub
   End If
   If CInt(ftNum.Text) < 1 Then
      MsgBox "就餐人数最少为 1 人？  " & vbCrLf _
           & "请重新输入 ...  ", vbExclamation
         ftNum.SetFocus
         Exit Sub
   End If
   
   Dim xTmp As Integer
   Dim IsFalse As Boolean
   'If lstSite.ListCount > 0 Then
   '     For xTmp = 0 To lstSite.ListCount - 1
   '         If CheckSiteIde(lstSite.List(xTmp)) = False Then
   '            MsgBox "座位号〖" & lstSite.List(xTmp) & "〗正在维修或已经上台 ..." & vbCrLf _
   '               & "请重新选择座位后,再预订。   ", vbExclamation
   '             IsFalse = True
   '             Exit For
   '         End If
   '     Next
   '  Else
   '  MsgBox "没有餐桌号,不能预订？  " & vbCrLf _
   '       & "请输入餐桌号或点击右边按钮选择多桌。  ", vbExclamation
   '          ftClass.SetFocus
   '  Exit Sub
   'End If
  '座号位已经使用，不能预订
   If IsFalse = True Then
      Exit Sub
   End If
   
   If MsgBox("真的要预订【" & lstSite.ListCount & "桌】吗？ (Y/N)   ", vbInformation + vbYesNo) = vbNo Then Exit Sub
   
      ftNO.Text = GetNo("预订")
     
  '3/保存预订内容|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
     Dim bDB As Connection
     Dim bRs As Recordset
     Dim sTMp As String          '更新座位
     
     Set bDB = CreateObject("ADODB.Connection")
     Set bRs = CreateObject("ADODB.Recordset")
         bDB.Open Constr
         bDB.BeginTrans
        '查询该单号是否有其它人员使用。
         bRs.Open "Select * from tbdBook Where ID='" & Trim(ftNO.Text) & "'", bDB, adOpenStatic, adLockOptimistic, adCmdText
         If bRs.EOF And bRs.BOF Then
           '预订多桌时
            bRs.Close
            For xTmp = 0 To lstSite.ListCount - 1
               '查找某一餐桌某一段时间是否已经预订,或者正在上台
                If IsSqlDat = True Then
                   bRs.Open "Select * from tbdBook Where Class='" & lstSite.List(xTmp) & "' And ExpireDate='" & dtpExpireDate.Value & "' And DatePart=" & cmbDatePart.ListIndex + 1, bDB, adOpenStatic, adLockOptimistic, adCmdText
                  Else
                   bRs.Open "Select * from tbdBook Where Class='" & lstSite.List(xTmp) & "' And ExpireDate=#" & dtpExpireDate.Value & "# And DatePart=" & cmbDatePart.ListIndex + 1, bDB, adOpenStatic, adLockOptimistic, adCmdText
                End If
               '无人预订时，我们现在开始预订该桌。
                If bRs.EOF And bRs.BOF Then
                         bRs.AddNew
                         bRs("ID") = GetNo("预订")              '随机给出单号
                         bRs("Class") = lstSite.List(xTmp)
                         If Trim(ftCID.Text) <> "" Then
                            bRs("CID") = Trim(ftCID.Text)
                         End If
                         bRs("CName") = Trim(ftCName.Text)
                         bRs("Tel") = Trim(ftTel.Text)
                         bRs("Num") = ftNum.Text
                         bRs("ExpireDate") = dtpExpireDate.Value       '使用时的日期
                         bRs("ExpireTime") = Time                      '预订的时间
                         bRs("BookDate") = Date                        '预订日期
                         If Trim(ftMenuID.Text) <> "" Then
                            bRs("MenuID") = Trim(ftMenuID.Text)
                         End If
                         bRs("DatePart") = cmbDatePart.ListIndex + 1   '预订的时间段
                         bRs.Update
                        '4/更新单号
                         UpdateNo "预订"
                    '=============================================================
                  Else
                 MsgBox dtpExpireDate.Value & " 座位【" & lstSite.List(xTmp) & "】已经预订给客户『" & bRs("CName") & "』 " & vbCrLf & vbCrLf _
                      & "该桌预订没有成功，请选择其它座位或时间段。  ", vbInformation
                 bRs.Close
                     bDB.RollbackTrans
                     bDB.Close
                 Set bRs = Nothing
                 Set bDB = Nothing
                '时间段给出焦点
                 cmbDatePart.SetFocus
                 Exit Sub
                 End If
            Next
           '5/更新座位标记,查询该段时间是否有人预订该座位
             Dim tmpDatePart, tmplHour As Integer
                 tmplHour = Hour(Time)
                 If tmplHour >= Lunch1 And tmplHour < Lunch2 Then   '中午
                    tmpDatePart = 1
                  ElseIf tmplHour >= Supper1 And tmplHour < Supper2 Then   '下午
                         tmpDatePart = 2
                    ElseIf tmplHour >= Night1 And tmplHour < NIght2 Then     '晚上
                           tmpDatePart = 3
                       Else
                           tmpDatePart = 1
                 End If
                '将空闲的桌位显示预订
                 If IsSqlDat = True Then
                    sTMp = "Update SiteType Set SiteStatus=1 Where Class In (Select Class From tbdBook Where ExpireDate='" & Date & "' And DatePart=" & tmpDatePart & ") And SiteStatus=0"
                   Else
                    sTMp = "Update SiteType Set SiteStatus=1 Where Class In (Select Class From tbdBook Where ExpireDate=#" & Date & "# And DatePart=" & tmpDatePart & ") And SiteStatus=0"
                 End If
                 bDB.Execute sTMp
         Else
            bRs.Close
            bDB.RollbackTrans
            bDB.Close
            Set bRs = Nothing
            Set bDB = Nothing
            MsgBox "该单号被其他用户使用,现在立即更新,稍等2秒后继续 ...", vbInformation
            UpdateNo "预订"
            Exit Sub
         End If
    '||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
     bDB.CommitTrans
     bDB.Close
     Set bRs = Nothing
     Set bDB = Nothing
     MsgBox "【" & ftCName.Text & "】的预订完成。  ", vbInformation
     sPubSite = ""
     Resetform
     BookChange = False
     ftClass.SetFocus
   
   Exit Sub
BookERRR:
   MsgBox "预订错误:" & Err.Description, vbCritical
   Exit Sub
    
End Sub

Private Sub Resetform()
  
   ftNO.Text = GetNo("预订")
   ftClass.Text = ""
   lstSite.Clear
   
  '添加到座位列表中
   AddToSite sPubSite
   
   ftExpireDate.Text = Time
   dtpExpireDate.Value = Date
   ftNum.Text = "1"
   ftMenuID.Text = ""
   ftTel.Text = ""
   ftCName.Text = ""
   ftCID.Text = ""
   cmbDatePart.ListIndex = 0
   BookChange = False
   
End Sub

Private Sub cmdSelectMember_Click()

    sGuestID = "": sGuestName = "": sGuestTel = ""
  
    frmMemberSelect.Show 1
  
    If sGuestID = "" Then
        ftCID.SetFocus
        Exit Sub
      Else
        BookChange = True
        ftCID.Text = sGuestID
        ftCName.Text = sGuestName
        ftTel.Text = sGuestTel
        
       '焦点转到用餐人数
        ftNum.SetFocus
    End If
    
End Sub

Private Sub cmdSelectMenu_Click()

 '选择菜单酒席套餐
  frmSelectCat.Show 1
   
  If sMenuID <> "" Then
     BookChange = True
     ftMenuID.Text = sMenuID
  End If
   
  ftMenuID.SetFocus
   
End Sub

Private Sub cmdSelectSite_Click()

  BookChange = True
  frmSelectSite.Show 1
  
End Sub

Private Sub dtpExpireDate_Change()

  BookChange = True
  
End Sub

Private Sub dtpExpireDate_KeyDown(KeyCode As Integer, Shift As Integer)

  If KeyCode = 13 Then
     cmbDatePart.SetFocus
  End If
  
End Sub

Private Sub Form_Activate()

 frmMain.lbControl.Caption = "新建预订信息"
   
End Sub

Private Sub Form_Load()

   GetFormSet Me, frmMain
   NewBookFocus = True
   
   Resetform
   BookChange = False
   
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

  If BookChange = True Then
     Dim intResult As Integer
         intResult = MsgBox("预订内容已经改变,是否保存。 ", vbInformation + vbYesNoCancel)
     Select Case intResult
       Case vbYes
         Call cmdOK_Click
         Exit Sub
       Case vbNo
         Exit Sub
       Case vbCancel
         Cancel = -1
         Exit Sub
     End Select
  End If
  
End Sub

Private Sub Form_Resize()
   
   On Error Resume Next
   If Me.WindowState = 1 Then Exit Sub
      Frame1.Left = (Me.Width - Frame1.Width) / 2
      Frame1.Top = 500
  '常规时
   If Me.WindowState = 0 Then
      Me.Move 1, 1, frmMain.Width - (frmMain.picTool.Width + 200), frmMain.Height - (frmMain.picADV.Height + 1150)
   End If
   
End Sub

Private Sub Form_Unload(Cancel As Integer)

   On Error Resume Next
   
   SaveFormSet Me
   NewBookFocus = False
   frmMain.lbControl.Caption = "收银控制中心"

End Sub

Private Sub ftCID_Change()

 BookChange = True
 
End Sub

Private Sub ftCID_DblClick()

 Call cmdSelectMember_Click
 
End Sub

Private Sub ftCID_LostFocus()

  '较对会员是否存在
    If Trim(ftCID.Text) <> "" Then
       If CheckCustomer(Trim(ftCID.Text)) = False Then
          MsgBox "会员编号不存在,请重新输入？  ", vbExclamation
          ftCID.Text = ""
          Exit Sub
       End If
    End If
    
End Sub

Private Sub ftClass_Change()

  'BookChange = True

End Sub

Private Sub ftClass_DblClick()

  BookChange = True
  Call cmdSelectSite_Click
  
End Sub

Private Sub ftClass_KeyPress(KeyAscii As Integer)

 '添加预订桌号
  If Trim(ftClass.Text) <> "" And KeyAscii = 13 Then
     BookChange = True
     AddToSite Trim(ftClass.Text)
     ftClass.Text = ""
     ftClass.SetFocus
  End If
  
End Sub

Public Sub AddToSite(stmpSite As String)
  
   If stmpSite = "" Then Exit Sub
   
 '检测是否已经添加,如果为添加
   Dim xIn As Long
       xIn = SendMessage(lstSite.Hwnd, LB_FINDSTRING, -1, ByVal stmpSite)

  If xIn = -1 Then
     lstSite.AddItem stmpSite
    Else
     MsgBox "座位已经添加？如果需要添加其它餐桌。  ", vbInformation
  End If

End Sub

Private Sub ftCName_Change()

  BookChange = True
  
End Sub

Private Sub ftExpireDate_Change()

  BookChange = True
  
  If ftExpireDate.Text = "" Then
     ftExpireDate.Text = "12"
     ftExpireDate.SelStart = 0
     ftExpireDate.SelLength = 2
     Exit Sub
  End If
  
End Sub

Private Sub ftExpireDate_LostFocus()

  If ftExpireDate.Text = "" Then
     ftExpireDate.Text = "12"
     ftExpireDate.SelStart = 0
     ftExpireDate.SelLength = 2
     Exit Sub
  End If
  
End Sub

Private Sub ftMenuID_Change()
   
   BookChange = True
   
End Sub

Private Sub ftMenuID_DblClick()
   
   Call cmdSelectMenu_Click
   
End Sub

Private Sub ftMenuID_LostFocus()

'较对菜单号是否存在
    If Trim(ftMenuID.Text) <> "" Then
       If CheckMenuCat(Trim(ftMenuID.Text)) = False Then
         MsgBox "菜单编号不存在,请重新输入？  ", vbExclamation
         ftMenuID.Text = ""
         Exit Sub
       End If
    End If
    
End Sub

Private Sub ftNO_Change()

  BookChange = True
  
End Sub

Private Sub ftNum_Change()

  BookChange = True

  If ftNum.Text = "" Then
     ftNum.Text = "1"
     ftNum.SelStart = 0
     ftNum.SelLength = 1
     Exit Sub
  End If
  
End Sub

Private Sub ftNum_LostFocus()
  
  If ftNum.Text = "" Then
     ftNum.Text = "1"
     ftNum.SelStart = 0
     ftNum.SelLength = 1
     Exit Sub
  End If
  
End Sub

Private Sub ftTel_Change()
  
  BookChange = True
  
End Sub

Private Sub lstSite_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

  If Button = 2 Then
     If lstSite.ListCount > 0 Then
        MnuDelete.Enabled = True
        mnuDeleteAll.Enabled = True
      Else
        MnuDelete.Enabled = False
        mnuDeleteAll.Enabled = False
     End If
        PopupMenu mnuOperator
  End If
  
End Sub

Private Sub MnuDelete_Click()

  On Error Resume Next
  
 '移走当前选定的餐桌
  lstSite.RemoveItem lstSite.ListIndex
  
End Sub

Private Sub mnuDeleteAll_Click()

  lstSite.Clear
  
End Sub