?? frmboxform.frm

?? 星級酒店管理系統(tǒng)（附帶系統(tǒng)自寫控件源碼）
?? FRM
?? 第 1 頁 / 共 3 頁
字號:
上一頁 1 23
    lstPro.Height = Frame1.Height - 530
    lstPRE.Height = lstPro.Height
    lstPro.Width = Frame1.Width - 150 - lstPRE.Width
    Frame2.Width = Frame1.Width
    cmdCancel.Left = Me.ScaleWidth - cmdCancel.Width - 300
     
End Sub

Private Sub Form_Unload(Cancel As Integer)

 Timer1.Interval = 0
 SaveFormSet Me
 frmMain.lbControl.Caption = "收銀控制中心"
 
End Sub

Private Sub ConfigGrid()

   On Error GoTo Err_init

   Dim sSQL As String
   Dim cHJ As Currency, cJGF As Currency, cQuanty As Currency
   
    IsRunning = True
    cHJ = 0: cJGF = 0: cQuanty = 0
      
    If sCustType = "ALL" Then sCustType = ""
    If Trim(sCustType) <> "" Then
        sSQL = "Select * From tmpCust Where DType='" & Trim(sCustType) & "' And Site='" & sBoxSite & "'"
      Else
         sSQL = "Select * From tmpCust Where Site='" & sBoxSite & "'"
    End If
   
    Dim DB As Connection, EF As Recordset
   
    lstPro.ListItems.Clear
    
    Set DB = CreateObject("ADODB.Connection")
    Set EF = CreateObject("ADODB.Recordset")
        DB.Open Constr
        EF.Open sSQL, DB, adOpenStatic, adLockReadOnly, adCmdText
        If Not (EF.EOF And EF.BOF) Then
            Do While Not EF.EOF()
               InsertToMenuList lstPro, EF.Fields("ID"), EF.Fields("CID"), EF.Fields("Name"), _
                   EF.Fields("Price"), EF.Fields("Quanty"), EF.Fields("JGF"), EF.Fields("Amos")
              '累計合計
               cHJ = cHJ + EF.Fields("Amos")
               cJGF = cJGF + EF.Fields("JGF")
               cQuanty = cQuanty + EF.Fields("Quanty")
               EF.MoveNext
            Loop
           '添加合計
            InsertToMenuList lstPro, "", "", "【 合 計 】 ", Chr(10), Trim(CStr(cQuanty)), Trim(CStr(cJGF)), Trim(CStr(cHJ))

        End If
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
        IsRunning = False
        
        Exit Sub
Err_init:
 IsRunning = False
 MsgBox "列出點菜內容錯誤!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

'預訂菜單
Private Sub ConfigGridPre()

   On Error GoTo Err_init

   Dim sSQL As String
   Dim cHJ As Currency, cJGF As Currency, cQuanty As Currency
   
    IsRunning = True
    cHJ = 0: cJGF = 0: cQuanty = 0
      
    If sCustType = "ALL" Then sCustType = ""
    If Trim(sCustType) <> "" Then
        sSQL = "Select * From tmpBox Where DType='" & Trim(sCustType) & "' And Site='" & sBoxSite & "'"
      Else
         sSQL = "Select * From tmpBox Where Site='" & sBoxSite & "'"
    End If
   
    Dim DB As Connection, EF As Recordset
   
    lstPRE.ListItems.Clear
    
    Set DB = CreateObject("ADODB.Connection")
    Set EF = CreateObject("ADODB.Recordset")
        DB.Open Constr
        EF.Open sSQL, DB, adOpenStatic, adLockReadOnly, adCmdText
        If Not (EF.EOF And EF.BOF) Then
            Do While Not EF.EOF()
               InsertToPreList lstPRE, EF.Fields("ID"), EF.Fields("CID"), EF.Fields("Name"), _
                   EF.Fields("Quanty")
              '累計合計
               cHJ = cHJ + EF.Fields("Amos")
               cJGF = cJGF + EF.Fields("JGF")
               cQuanty = cQuanty + EF.Fields("Quanty")
               EF.MoveNext
            Loop
           '添加合計
            InsertToPreList lstPRE, "", "", "【 合 計 】 ", Trim(CStr(cQuanty))
        End If
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
        IsRunning = False
        
        Exit Sub
Err_init:
 IsRunning = False
 MsgBox "列出預點菜內容錯誤!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub


Private Sub ConfigType()

   On Error GoTo Err_init
   
   Dim tDB As Connection
   Dim tEf As Recordset, sEXE As String
   Set tDB = CreateObject("ADODB.Connection")
       tDB.Open Constr
       sEXE = "Select Class From MenuType"
   Set tEf = CreateObject("ADODB.Recordset")
       tEf.Open sEXE, tDB, adOpenStatic, adLockReadOnly, adCmdText
     If tEf.EOF And tEf.BOF Then
        Strip1.SelectedItem.Key = "Null"
        sCustType = ""
      Else
        Dim x As Integer
            x = 1
        Do While Not tEf.EOF
          '給出菜分類
           Strip1.Tabs.Add x, tEf.Fields(0), tEf.Fields(0) & "&" & Chr(64 + x)
           x = x + 1
           tEf.MoveNext
        Loop
        sCustType = Strip1.SelectedItem.Key
     End If
     tEf.Close
     Set tEf = Nothing
     tDB.Close
     Set tDB = Nothing
     Exit Sub
     
Err_init:
    MsgBox "菜分類錯誤，名稱不能全為數(shù)字 ？ " & Err.Description, vbExclamation, "錯誤：0577-86261392 013955647557"

End Sub

Private Sub Grid1_DblClick()

'  If Grid1.Text <> "" Then
'     If Trim(cmbSite.Text) = "" Then
'        MsgBox "對不起，請注明該物品的座位號！    ", vbInformation, "提示：By Yusilong."
'        cmbSite.SetFocus
'        Exit Sub
'     End If
'     frmQuantly.Show 1
'     If SureQuantly = True Then
'        Dim lCurRow As Long
'            lCurRow = Grid1.Row '當前行
'            AddRecord Grid1.TextMatrix(lCurRow, 1), "名稱", Grid1.TextMatrix(lCurRow, 2), "單價", Grid1.TextMatrix(lCurRow, 3), "單位", Grid1.TextMatrix(lCurRow, 4), "代碼", Grid1.TextMatrix(lCurRow, 5), "MenuType", Grid1.TextMatrix(lCurRow, 2) * sSL, "金額", "tmpSell"
'           ConfigGrid2 Trim(cmbSite.Text)
'     End If
'   Else
'     Exit Sub
'  End If
  
End Sub


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

 '顯示操作菜單
  If Button = 2 Then
     PopupMenu mnuSystem
  End If
   
End Sub

Private Sub lstPro_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
 
 On Error Resume Next
 
'排序操作
 If lstPro.ListItems.Count > 0 Then
 
    lstPro.SortKey = ColumnHeader.Index - 1
    lstPro.Sorted = True
    
    If lstPro.SortOrder = lvwAscending Then
       lstPro.SortOrder = lvwDescending
       Else
       lstPro.SortOrder = lvwAscending
    End If
    
 End If

End Sub


Private Sub mnuClean_Click()

  Call cmdClean_Click
  
End Sub

Private Sub mnuDC_Click()

  Call cmdDC_Click
  
End Sub

Private Sub mnuLD_Click()

  Call cmdOK_Click
  
End Sub

Private Sub Strip1_Click()
  
  '選擇類別
  sCustType = Strip1.SelectedItem.Key
  
 '選定已點酒菜
  ConfigGrid
 '選定未預點菜
  ConfigGridPre

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
        cmbSite.Clear
        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
     Exit Sub
     
Err_init:
    MsgBox "裝載（座位）未知錯誤！" & Err.Description, vbExclamation, "錯誤：By Yusilong."

End Sub
Private Sub CopyIt(sFirstSite As String)

 On Error GoTo ERR_HZ
    Dim DB As Connection
    Dim EF As Recordset
    Dim lSheelID As Long
    Set DB = CreateObject("ADODB.Connection")
    Set EF = CreateObject("ADODB.Recordset")
        DB.Open Constr
        EF.Open "Select * From tmpSite Where Site='" & sFirstSite & "'", DB, adOpenStatic, adLockReadOnly, adCmdText
       '首先檢測該座位有沒有上臺，退出
        If EF.BOF And EF.EOF Then  '沒有記錄時為0
           EF.Close
           Set EF = Nothing
           DB.Close
           Set DB = Nothing
           MsgBox "對不起，沒有找到[" & sFirstSite & "]消費記錄單！   " & vbCrLf & vbCrLf & "不能進行【同桌】請求！  ", vbInformation
           Exit Sub
        End If
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
            sBoxSite = sFirstSite  '桌號保存
           '顯示未消費的桌
            frmCopysite.Show 1
        Exit Sub
        
ERR_HZ:
        MsgBox "對不起，同桌復制錯誤：   " & vbCrLf & vbCrLf & Err.Description, vbInformation
        Exit Sub
End Sub

Private Sub InsertToMenuList(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String, sText5 As String, sText6 As String, sText7 As String)

   On Error Resume Next
   
   Dim lstTmp As ListItem
   Set lstTmp = tmpView.ListItems.Add
       lstTmp.Text = sText1
       lstTmp.SubItems(1) = sText2
       lstTmp.SubItems(2) = sText3
       lstTmp.SubItems(3) = sText4
       lstTmp.SubItems(4) = Format(sText5, "0.00")
       lstTmp.SubItems(5) = Format(sText6, "0.00")
       lstTmp.SubItems(6) = Format(sText7, "0.00")
       
End Sub

Private Sub InsertToPreList(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String)

   On Error Resume Next
   Dim lstTmp As ListItem
   Set lstTmp = tmpView.ListItems.Add
       lstTmp.Text = sText1
       lstTmp.SubItems(1) = sText2
       lstTmp.SubItems(2) = sText3
       lstTmp.SubItems(3) = Format(sText4, "0.0")
       
End Sub

Private Sub Timer1_Timer()

   If IsRunning = True Then Exit Sub
   
  '給出餐桌的實時狀態(tài)
   GetSiteStatus
   Screen.MousePointer = 11
  '配置點菜
   ConfigGrid
  '配置預點菜
   ConfigGridPre
 
   Screen.MousePointer = 0
   
End Sub

Private Sub GetSiteStatus()
  
  On Error Resume Next
  
  IsRunning = True
  
 '查詢該座位是否能點菜=2時，才可以
  Dim CDB As Connection
  Dim cRS As Recordset
  Set CDB = CreateObject("ADODB.Connection")
  Set cRS = CreateObject("ADODB.Recordset")
      CDB.Open Constr
      cRS.Open "Select * from SiteType Where Class='" & sBoxSite & "'", CDB, adOpenStatic, adLockReadOnly, adCmdText
      If cRS.EOF And cRS.BOF Then
         cRS.Close
         CDB.Close
         Set cRS = Nothing
         Set CDB = Nothing
         lbStatus.Caption = "餐桌號沒有找到？ "
         shpCirCle.FillColor = &HFF&
         Exit Sub
      End If
  Select Case cRS("SiteStatus")
   Case 0
     cRS.Close
     CDB.Close
     Set cRS = Nothing
     Set CDB = Nothing
     lbStatus.Caption = "餐桌還沒有『開臺』"
     shpCirCle.FillColor = &HFF&
     Exit Sub
   Case 1
     cRS.Close
     CDB.Close
     Set cRS = Nothing
     Set CDB = Nothing
     lbStatus.Caption = "餐桌還沒有『開臺』"
     shpCirCle.FillColor = &HFF&
     Exit Sub
   Case 2
    '點菜開始
     cRS.Close
     CDB.Close
     Set cRS = Nothing
     Set CDB = Nothing
     lbStatus.Caption = "『已經(jīng)開臺』,可以使用。"
     shpCirCle.FillColor = &HC000&
     Exit Sub
   Case 3
     cRS.Close
     CDB.Close
     Set cRS = Nothing
     Set CDB = Nothing
     lbStatus.Caption = "『正在結帳』,不能點菜。"
     shpCirCle.FillColor = &HFF&
     Exit Sub
   Case 4
     cRS.Close
     CDB.Close
     Set cRS = Nothing
     Set CDB = Nothing
     lbStatus.Caption = "『維修中』,不能點菜。"
     shpCirCle.FillColor = &HFF&
     Exit Sub
  End Select
  
  cRS.Close
  CDB.Close
  Set cRS = Nothing
  Set CDB = Nothing
  
End Sub
上一頁 1 23
?? 文件大小 12233 K
?? 上傳用戶 norwaybaby
?? 所屬分類其他數(shù)據(jù)庫
??? 相關標簽

#管理系統(tǒng) #控件 #源碼
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmboxform.frm

?? 快捷鍵說明
