⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmsitesataus.frm

📁 星级酒店管理系统（附带系统自写控件源码）
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
Private Sub cmdClose_Click()

  Unload Me
  
End Sub

Private Sub Form_Activate()

  On Error Resume Next
      
  frmMain.lbControl.Caption = "餐厅上坐状态"
    
  If optSelect(0).Value = True Then sWhere = ""
  If optSelect(1).Value = True Then sWhere = " Where SiteStatus=0"
  If optSelect(2).Value = True Then sWhere = " Where SiteStatus=1"
  If optSelect(3).Value = True Then sWhere = " Where SiteStatus=2"
  
  Me.MousePointer = 11
  Browse   '浏览餐桌
  Me.MousePointer = 0

  Call Form_Resize

End Sub

Private Sub Form_Load()

  GetFormSet Me, frmMain
  SitesFocus = True
  
  
End Sub

Public Sub Form_Resize()

  On Error Resume Next
  
  If Me.WindowState = 1 Then Exit Sub
        
  '常规时
  If Me.WindowState = 0 Then
     Me.Move 1, 1, frmMain.Width - (frmMain.picTool.Width + 200), frmMain.Height - (frmMain.picADV.Height + 1150)
  End If
        
        Dim x       As Long
        Dim y       As Long
        Dim lIdx    As Long
        Dim lCols   As Long
        
        Frame1.Width = Me.ScaleWidth - 6
        cmdClose.Left = Me.Width - cmdClose.Width - 320
        
        picFrame.Visible = False
        
        If Me.Width < 346 * Screen.TwipsPerPixelX Then
            Me.Width = 346 * Screen.TwipsPerPixelX
        ElseIf Me.Height < 378 * Screen.TwipsPerPixelY Then
            Me.Height = 378 * Screen.TwipsPerPixelY
        Else
            picFrame.Move 3, 53, Me.ScaleWidth - 6, Me.ScaleHeight - 56
            vsbSlide.Move Me.ScaleWidth - vsbSlide.Width - 12, 0, vsbSlide.Width, Me.ScaleHeight - 62
            
            lCols = Int((picFrame.ScaleWidth - vsbSlide.Width) / optThumb(0).Width)
            For lIdx = 0 To optThumb.Count - 1
                x = (lIdx Mod lCols) * optThumb(0).Width
                y = Int(lIdx / lCols) * optThumb(0).Height
                optThumb(lIdx).Move x, y
            Next lIdx
            picSlide.Width = lCols * optThumb(0).Width
            picSlide.Height = Int(optThumb.Count / lCols) * optThumb(0).Height
            If Int(optThumb.Count / lCols) < (optThumb.Count / lCols) Then
                picSlide.Height = picSlide.Height + optThumb(0).Height
            End If
            vsbSlide.Value = 0
            vsbSlide.Max = picSlide.Height - picFrame.ScaleHeight
            If vsbSlide.Max < 0 Then
                vsbSlide.Max = 0
                vsbSlide.Enabled = False
            Else
                vsbSlide.Enabled = True
                vsbSlide.SmallChange = optThumb(0).Height
                vsbSlide.LargeChange = picFrame.ScaleHeight
            End If
        End If
        picFrame.Visible = True
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    On Error Resume Next

    Dim lIdx As Long
    Dim lRet As Long
    Dim sPos As String
       
    For lIdx = 1 To optThumb.Count - 1
        Unload optThumb(lIdx)
    Next lIdx

    SaveFormSet Me
    SitesFocus = False
    
    frmMain.lbControl.Caption = "收银控制中心"
  
End Sub

Private Sub mnuBookthis_Click()

  '新的预订
   frmMain.mnuNewBook_Click
   
End Sub

Private Sub mnuCancelBook_Click()

 '取消预订
  Dim stmpS As String
      stmpS = GetID(sPubSite)
  If stmpS = "" Then Exit Sub
  If CancelBook(stmpS) = True Then
    '刷新
    If optSelect(0).Value = True Then sWhere = ""
    If optSelect(1).Value = True Then sWhere = " Where SiteStatus=0"
    If optSelect(2).Value = True Then sWhere = " Where SiteStatus=1"
    If optSelect(3).Value = True Then sWhere = " Where SiteStatus=2"
  End If
  
 '刷新排列
  Me.MousePointer = 11
  Browse   '浏览餐桌
  Me.MousePointer = 0
  Call Form_Resize

End Sub

Private Sub mnuCancelMaintenans_Click()

    If sPubSite = "" Then
       MsgBox "餐桌为空，不能结帐？  ", vbInformation
       Exit Sub
    End If

    If CancelMaintenans(sPubSite) = True Then
       Browse
       Call Form_Resize
    End If
    
End Sub

Private Sub mnuChange_Click()

    ChangeIt sPubSite
    
    If optSelect(0).Value = True Then sWhere = ""
    If optSelect(1).Value = True Then sWhere = " Where SiteStatus=0"
    If optSelect(2).Value = True Then sWhere = " Where SiteStatus=1"
    If optSelect(3).Value = True Then sWhere = " Where SiteStatus=2"

    Me.MousePointer = 11
    Browse   '浏览餐桌
    Me.MousePointer = 0
    Form_Resize
    
End Sub

Private Sub mnuCheckOut_Click()
   
    If sPubSite = "" Then
       MsgBox "餐桌为空，不能结帐？  ", vbInformation
       Exit Sub
    End If
   
   '结帐
    Dim DB As Connection, EF As Recordset
    Set DB = CreateObject("ADODB.Connection")
        DB.Open Constr
    Set EF = CreateObject("ADODB.Recordset")
        EF.Open "Select * From tmpCust Where Site='" & sPubSite & "'", DB, adOpenStatic, adLockReadOnly, adCmdText
   
   '没有数据
    If EF.EOF And EF.BOF Then
       EF.Close
       Set EF = Nothing
       DB.Close
       Set DB = Nothing
       MsgBox "对不起，该桌没有消费不能结帐？   ", vbInformation
       Exit Sub
    End If
    EF.Close
    Set EF = Nothing
    DB.Close
    Set DB = Nothing
    frmCash.Show 1
    
    If optSelect(0).Value = True Then sWhere = ""
    If optSelect(1).Value = True Then sWhere = " Where SiteStatus=0"
    If optSelect(2).Value = True Then sWhere = " Where SiteStatus=1"
    If optSelect(3).Value = True Then sWhere = " Where SiteStatus=2"

    Me.MousePointer = 11
    Browse   '浏览餐桌
    Me.MousePointer = 0
    Form_Resize

End Sub

Private Sub mnuClean_Click()

  If Trim(sPubSite) = "" Then
       MsgBox "座位为空不能继续？   ", vbInformation
       Exit Sub
  End If
  
  If MsgBox("【" & sPubSite & "】真的要清台吗（Y/N）。" & vbCrLf & vbCrLf & "清台后，所有点菜内容将删除？", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
  
  On Error GoTo CleanErr
  
 '清台操作
  Dim DB As Connection
  Dim sTMp As String
  Set DB = CreateObject("ADODB.Connection")
      DB.ConnectionString = Constr
      DB.Open
      DB.BeginTrans
     '清除点菜明细
      sTMp = "Delete from TmpCust Where Site='" & sPubSite & "'"
      DB.Execute sTMp
     '清除座位信息
      sTMp = "Delete from TmpSite Where Site='" & sPubSite & "'"
      DB.Execute sTMp
     '清除包厢点菜内容
      sTMp = "Delete from TmpBox Where Site='" & sPubSite & "'"
      DB.Execute sTMp
     '清除飞单内容
      sTMp = "Delete from ptCust Where Site='" & sPubSite & "'"
      DB.Execute sTMp
     '恢复餐桌状态,为空闲
      sTMp = "Update SiteType Set SiteStatus=0 Where Class='" & sPubSite & "' And (SiteStatus>=2 And SiteStatus<=3)"
      DB.Execute sTMp
      DB.CommitTrans
      DB.Close
      Set DB = Nothing
      
 '清除当前
  MsgBox "清台完毕！", vbInformation
 
  Browse   '浏览餐桌
  Call Form_Resize

  Exit Sub
CleanErr:
  MsgBox "清台错误:" & Err.Description, vbCritical
  On Error Resume Next
  DB.RollbackTrans
  DB.Close
  Set DB = Nothing
  Exit Sub

End Sub

Private Sub mnuCopy_Click()

    CopyIt sPubSite
    
    If optSelect(0).Value = True Then sWhere = ""
    If optSelect(1).Value = True Then sWhere = " Where SiteStatus=0"
    If optSelect(2).Value = True Then sWhere = " Where SiteStatus=1"
    If optSelect(3).Value = True Then sWhere = " Where SiteStatus=2"

    Me.MousePointer = 11
    Browse   '浏览餐桌
    Me.MousePointer = 0
    Form_Resize
    
End Sub

Private Sub mnuInfo_Click()

  '启动frmCustomerForm窗体
   sInfoSite = sPubSite
   
   If CustFocus = True Then        '说明窗体已经显示
      frmCustomerForm.SetFocus
     Else
      frmCustomerForm.Show
   End If
   
End Sub

Private Sub mnuMaintenans_Click()
  
  If sPubSite = "" Then
     MsgBox "座位为空不能继续？   ", vbInformation
     Exit Sub
  End If
  
  If Maintenans(sPubSite) = True Then
     Call Browse
     Call Form_Resize
  End If
  
End Sub

Private Sub MnuOpen_Click()
  
  If Trim(sPubSite) = "" Then
       MsgBox "座位为空不能继续？   ", vbInformation
       Exit Sub
  End If
  
  If MsgBox("【" & sPubSite & "】现在开台吗（Y/N）。" & vbCrLf & vbCrLf & "开台后，包厢就可以点菜。 ", vbInformation + vbYesNo + vbDefaultButton1) = vbNo Then Exit Sub
  
  On Error GoTo CleanErr
  
 '清台操作
  Dim DB As Connection
  Dim sTMp As String
  Set DB = CreateObject("ADODB.Connection")
      DB.ConnectionString = Constr
      DB.Open
      sTMp = "Update SiteType Set SiteStatus=2 Where Class='" & sPubSite & "'"
      DB.Execute sTMp
      DB.Close
      Set DB = Nothing
      
   MsgBox "开台完毕，现在可以点菜了！", vbInformation
 
  Browse   '浏览餐桌
  Call Form_Resize

  Exit Sub
CleanErr:
  MsgBox "开台错误:" & Err.Description, vbCritical
  Exit Sub

End Sub

Private Sub mnuTable_Click()

  On Error GoTo ERR_HZ
   
  If sPubSite = "" Then
      MsgBox "座位为空不能继续？   ", vbInformation
      Exit Sub
  End If
 
  frmDC.Show 1
  
  If optSelect(0).Value = True Then sWhere = ""
  If optSelect(1).Value = True Then sWhere = " Where SiteStatus=0"
  If optSelect(2).Value = True Then sWhere = " Where SiteStatus=1"
  If optSelect(3).Value = True Then sWhere = " Where SiteStatus=2"

 '刷新菜单列表
  Me.MousePointer = 11
  Browse   '浏览餐桌
  Me.MousePointer = 0
  Form_Resize
  
   Exit Sub
ERR_HZ:
 MsgBox "点菜错误：   " & vbCrLf & vbCrLf & Err.Description, vbInformation

End Sub

Private Sub mnuViewBOOK_Click()

  '首先给出当前预订ID号
   Dim tmpBookID As String
       tmpBookID = GetID(sPubSite)
    If tmpBookID = "" Then
       Exit Sub
    End If
   
    ViewBook tmpBookID

End Sub

Private Sub optSelect_Click(Index As Integer)

  On Error Resume Next
  
 '所有菜单无效
  mnuBookthis.Enabled = False
  mnuCancelBook.Enabled = False
  mnuViewBOOK.Enabled = False
  mnuInfo.Enabled = False
  mnuTable.Enabled = False
  mnuCheckOut.Enabled = False
  mnuChange.Enabled = False
  
  Select Case Index
    Case 0
      sWhere = ""
    Case 1
      sWhere = " Where SiteStatus=0"
    Case 2
      sWhere = " Where SiteStatus=1"
    Case 3
      sWhere = " Where SiteStatus=2"
  End Select
  
 '刷新排列
  Me.MousePointer = 11
  Browse   '浏览餐桌
  Me.MousePointer = 0
  Call Form_Resize

End Sub

Private Sub optThumb_Click(Index As Integer)
   
   On Error Resume Next
        mnuBookthis.Enabled = False
        mnuTable.Enabled = False
        mnuInfo.Enabled = False
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -