End If
   
   If txtSL.Text = "." Then
      txtSL.Text = "0."
      txtSL.SelStart = 2
      txtSL.SelLength = 0
   End If
   
   If Trim(cmbCode.Text) <> "" And sBoxSite <> "" And Val(txtSL) <> 0 And Val(txtDJ.Text) <> 0 Then
      cmdAdd.Enabled = True
    Else
      cmdAdd.Enabled = False
   End If
   
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"
        sGlobalType = ""
      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
        sGlobalType = 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 InsertToMenu(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String, sText5 As String, sText6 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)
       lstTmp.SubItems(5) = Trim(sText6)
End Sub

Private Sub InsertToCust(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
      , sText4 As String, sText5 As String, sText6 As String, sText7 As String, sText8 As String, sText9 As String)
 
   On Error Resume Next
   
   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)
       lstTmp.SubItems(5) = Format(Trim(sText6), "0.00")
       lstTmp.SubItems(6) = Format(Trim(sText7), "0.00")
       lstTmp.SubItems(7) = Format(Trim(sText8), "0.00")
       lstTmp.SubItems(8) = Trim(sText9)
       
End Sub

Private Sub Strip1_Click()
  
 '選擇類別
  sGlobalType = Strip1.SelectedItem.Key
  If sGlobalType = "ALL" Then sGlobalType = ""
  ConfigGridX ""

End Sub

Private Sub AddItItem()

   On Error GoTo AddERR
   
  '檢測一些項目
   If Trim(cmbCode.Text) = "" Then
      MsgBox "請輸入物品編碼，否則不能錄入！   ", vbInformation
      cmbCode.SetFocus
      Exit Sub
   End If
   If Trim(txtPingyin.Text) = "" Then
      MsgBox "請輸入物品拼音碼，否則不能錄入！   ", vbInformation
      txtPingyin.SetFocus
      Exit Sub
   End If
   If Trim(txtName.Text) = "" Then
      MsgBox "請輸入物品名稱，否則不能錄入！   ", vbInformation
      txtName.SetFocus
      Exit Sub
   End If
   If Val(txtSL) = 0 Or IsNumeric(txtSL.Text) = False Then
      MsgBox "請輸入物品數(shù)量，否則不能錄入！   ", vbInformation
      txtSL.SetFocus
      Exit Sub
   End If
   If Trim(txtDJ) = "" Or IsNumeric(txtDJ.Text) = False Then
      MsgBox "請輸入物品單價，如果沒有請輸入0！  ", vbInformation
      txtDJ.SetFocus
      Exit Sub
   End If
   If Trim(txtJGF) = "" Or IsNumeric(txtJGF.Text) = False Then
      MsgBox "請輸入物品加工費，如果沒有請輸入0！   ", vbInformation
      txtJGF.SetFocus
      Exit Sub
   End If
   If Trim(txtType) = "" Then
      MsgBox "請輸入酒菜的分類名！ ", vbInformation
      txtType.SetFocus
      Exit Sub
   End If
  '添加到消費庫中 ============================================================
   Dim DB As Connection
   Dim EF As Recordset
   Dim sTMp As String
   
   Set DB = CreateObject("ADODB.COnnection")
       DB.Open Constr
       DB.BeginTrans
   Set EF = CreateObject("ADODB.Recordset")
       
      If Val(txtSL.Text) < 0 Then '退單時
        '檢測是否有足夠的數(shù)量退單++++++++++++++++++++++++++++++++++++++
         Dim tmpSql As String
         Dim bTui As Boolean   '可以退時
             tmpSql = "Select Sum(Quanty) From tmpBox where site='" & sBoxSite & "' And Name='" & Trim(txtName.Text) & "' And " _
                    & " CID='" & Trim(cmbCode) & "' And DType='" & txtType.Text & "'"
             EF.Open tmpSql, DB, adOpenStatic, adLockReadOnly, adCmdText
            '如果沒有找到該菜單時,BTui標記為假
             If EF.BOF And EF.EOF Then  '沒有記錄時
                bTui = False
              Else
                If IsNull(EF.Fields(0)) = True Then
                   bTui = False
                Else
                 '數(shù)量是否足夠
                  If Abs(Val(txtSL)) > EF.Fields(0) Then
                     bTui = False
                    Else
                     bTui = True   '可以退單
                  End If
                End If
             End If
            If bTui = False Then
              '退出
               EF.Close
               Set EF = Nothing
               DB.RollbackTrans
               DB.Close
               Set DB = Nothing
               MsgBox "很抱歉：請檢查菜單上是否有該菜 ？   " & vbCrLf & vbCrLf & "或者數(shù)量夠不夠退？ ", vbExclamation
               txtSL.SetFocus
               Exit Sub
            End If
            EF.Close
      End If

     '打開消費記錄表
      EF.Open "Select * From tmpBox", DB, adOpenStatic, adLockOptimistic, adCmdText
             ' sTmp = "CID='" & Trim(cmbCode) & "'"
      EF.AddNew
      EF.Fields("ID") = GetFixNo("點菜明細號")
      EF.Fields("Site") = sBoxSite
      EF.Fields("Name") = Trim(txtName.Text)
      EF.Fields("CID") = Trim(cmbCode.Text)
      EF.Fields("Pingyin") = Trim(txtPingyin.Text)
      EF.Fields("Unit") = Trim(txtUnit.Text)
      EF.Fields("Price") = txtDJ.Text
      EF.Fields("Quanty") = Val(txtSL)
      EF.Fields("JGF") = txtJGF.Text
      EF.Fields("Amo") = Round(EF.Fields("Quanty") * EF.Fields("Price"), 0) '不包括加工費 ,以后直接打折
      EF.Fields("Amos") = Round(EF.Fields("JGF") + EF.Fields("Amo"), 0)     '合計金額=加工費+總額
      EF.Fields("DType") = txtType.Text                                     '單類型
      EF.Update
  
      EF.Close
      DB.CommitTrans
      DB.Close                 '事務(wù)結(jié)束
      Set EF = Nothing
      Set DB = Nothing
  
      RefreshIt   '刷新菜單列表
      
      cmbCode.Text = "": txtName.Text = "": txtPingyin = ""
      txtSL = "1": txtUnit = "": txtDJ = "0": txtJGF = "0"
      txtType = ""
  
      If AddIt = False Then cmbCode.SetFocus
         AddIt = False
     
   Exit Sub
AddERR:
   MsgBox "添加菜單錯誤:" & Err.Description, vbCritical
   
End Sub

Private Sub RefreshIt()

   ConfigGrid1 sBoxSite
 
End Sub

Private Sub GetItem(sType As String)

  On Error GoTo GetERR
  
  Dim DB As Connection
  Dim EF As Recordset
  Set DB = CreateObject("ADODB.Connection")
      DB.Open Constr
  Select Case sType
    Case "MID"
       Set EF = CreateObject("ADODB.Recordset")
           EF.Open "Select * From EatList Where MID='" & Trim(cmbCode.Text) & "'", DB, adOpenStatic, adLockReadOnly
        If EF.BOF And EF.EOF Then '沒有該記錄時
           EF.Close
           Set EF = Nothing
           DB.Close
           Set DB = Nothing
           MsgBox "請輸入正確的菜單編碼！   ", vbExclamation
           cmbCode.Text = ""
           cmbCode.SetFocus
        Else
          '給出各個項的值
           txtPingyin = EF.Fields("Pingyin")
           txtName = EF.Fields("MName")
           txtSL = 1
           txtDJ = EF.Fields("MPrice")
           txtUnit = NullValue(EF.Fields("MUnit"))
           txtType = NullValue(EF.Fields("MType"))
           SearchAgain = True
           EF.Close
           Set EF = Nothing
           DB.Close
           Set DB = Nothing
       End If
    Case Else
        Set EF = CreateObject("ADODB.Recordset")
            EF.Open "Select * From EatList Where Pingyin='" & Trim(txtPingyin) & "'", DB, adOpenStatic, adLockReadOnly
         If EF.BOF And EF.EOF Then '沒有該記錄時
            EF.Close
            Set EF = Nothing
            DB.Close
            Set DB = Nothing
            MsgBox "請輸入正確的拼音碼！   ", vbExclamation
            txtPingyin.Text = ""
            txtPingyin.SetFocus
          Else
           '給出各個項的值
            cmbCode = EF.Fields("MID")
            txtName = EF.Fields("MName")
            txtSL = 1
            txtDJ = EF.Fields("MPrice")
            txtUnit = NullValue(EF.Fields("MUnit"))
            txtType = NullValue(EF.Fields("MType"))
            SearchAgain = True
            EF.Close
            Set EF = Nothing
            DB.Close
            Set DB = Nothing
       End If
  End Select
  
  Exit Sub
GetERR:
  MsgBox "給出Item錯誤:" & Err.Description, vbCritical
  
End Sub

Private Sub ConfigPingyin(sCode As String)

    On Error GoTo Err_init
    
    sCode = Trim(sCode)
    If sCode = "" And sGlobalType = "" Then Exit Sub
    
    Dim sSQL As String
    If sGlobalType = "" Then
         If sCode <> "" Then
             sSQL = "Select * From EatList Where (PingYin Like '" & sCode & "%') Order By PingYin"
         Else
             Exit Sub
         End If
      Else
         If sCode <> "" Then
            sSQL = "Select * From EatList Where (PingYin Like '" & sCode & "%' And MType='" & sGlobalType & "') Order By PingYin"
         Else
            sSQL = "Select * From EatList Where MType='" & sGlobalType & "' Order By PingYin"
         End If
    End If
        
    Dim DB As Connection, EF As Recordset
    Set DB = CreateObject("ADODB.Connection")
        DB.Open Constr
    Set EF = CreateObject("ADODB.Recordset")
        
        EF.Open sSQL, DB, adOpenStatic, adLockReadOnly, adCmdText
      
      lstPro.Visible = False
      lstPro.ListItems.Clear
      
        If Not (EF.EOF And EF.BOF) Then
            Do While Not EF.EOF()
               InsertToMenu lstPro, EF("MID"), EF("MName"), NullValue(EF("PingYin")), EF("MPrice"), NullValue(EF("Munit")), EF("MType")
               EF.MoveNext
            Loop
        End If
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
        lstPro.Visible = True
        
   Exit Sub
Err_init:
   MsgBox "給出菜單錯誤:" & Err.Description, vbCritical
 
End Sub

Private Sub txtSL_LostFocus()
 
 If txtSL.Text = "" Then
    txtSL = 1
    Exit Sub
 End If
 If Val(txtSL.Text) = "0" Then
   txtSL = 1
   Exit Sub
 End If

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
   
   If Trim(sText1) = "" Then Exit Sub
   
   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.00")
       lstTmp.SubItems(4) = Format(sText5, "0.00")
       lstTmp.SubItems(5) = Format(sText6, "0.00")
       lstTmp.SubItems(6) = sText7
       
End Sub