MsgBox "只有『會員』才有掛帳資格,否則不能掛帳。   ", vbInformation
           ftCID.SetFocus
           Exit Sub
        End If
       '掛帳客戶提醒
        txtSK.Text = "0"
        If MsgBox("請在入帳前將帳單打印出來,否則入帳后將不能打印帳單。" & vbCrLf & vbCrLf _
            & "您現在進行【掛帳操作】,掛帳時實收現金自動變為 0 ？  " & vbCrLf & vbCrLf _
            & "『掛帳』的金額以后在〖掛帳管理】中處理,是否繼續。  ", vbInformation + vbYesNo) = vbNo Then Exit Sub
    End If
        
    Dim DB As Connection
    Dim EF As Recordset
    Dim lSheelID As Long
    Set DB = CreateObject("ADODB.Connection")
        DB.Open Constr
        DB.BeginTrans
    
    Set EF = CreateObject("AdODB.Recordset")
      '1檢查上臺信息，是否有該臺
        EF.Open "Select * From tmpSite Where Site='" & sPubSite & "'", DB, adOpenStatic, adLockOptimistic, adCmdText
        If EF.BOF And EF.EOF Then  '沒有記錄時為0
           lSheelID = 0
           EF.Close
           Set EF = Nothing
           DB.RollbackTrans
           DB.Close
           Set DB = Nothing
           MsgBox "很抱歉，該桌沒有消費！  ", vbExclamation
           Exit Sub
         Else
          '當前消費的ID號
           lSheelID = EF.Fields("ID")      '給出使用記錄號 ,明細表及菜單號碼中使用。
          '更新付款方式
           EF.Fields("tmpStr") = cmbPayMethod.Text '付款方式
           If chkCard.Value = vbChecked Then
              If CCur(ftRemain.Text) >= CCur(txtFK.Text) Then
                 '可以完整支付時
                  EF.Fields("tmpCur") = txtFK.Text       '卡付金額
                Else
                  EF.Fields("tmpCur") = ftRemain.Text    '卡付金額，所有
              End If
           End If
           EF.Update
        End If
        EF.Close
        Set EF = Nothing
        
      '檢查是否為共享版
       If IsShare = True Then
          Dim shareRS As Recordset
          Set shareRS = CreateObject("ADODB.Recordset")
              shareRS.Open "Select count(*) from Site", DB, adOpenStatic, adLockReadOnly, adCmdText
              If Not (shareRS.EOF And shareRS.BOF) Then
                 If shareRS(0) > 50 Then
                    DB.RollbackTrans
                    DB.Close
                    Set DB = Nothing
                    MsgBox "試用版僅能添加100條記錄,請注冊。  " & vbCrLf _
                        & "注冊信息請參（系統控制）菜單中的關于與注冊。  ", vbInformation
                    Exit Sub
                  Else
                   shareRS.Close
                   Set shareRS = Nothing
                 End If
              Else
                shareRS.Close
                Set shareRS = Nothing
              End If
       End If
       
      '2如果為會員時，記錄累計消費，及自動升級提示？
       If Trim(ftCID.Text) <> "" Then
          If chkArrearage.Value = vbChecked Then
             '掛帳時DB為數據庫，FtCID為客戶編號,0為消費金額,txtFK為掛帳金額
              UpdateGuestLJ DB, Trim(ftCID.Text), 0, CCur(txtFK.Text)
             Else
              UpdateGuestLJ DB, Trim(ftCID.Text), CCur(txtFK.Text), 0
          End If
       End If
       
      '3建立收款表
        If chkArrearage.Value = vbUnchecked Then
            Dim sMemo As String
                If ftCID.Text <> "" Then
                   sMemo = "會員：【" & ftCID.Text & "】消費結帳"
                  Else
                   sMemo = "散客結帳"
                End If
            '更新客戶的會員付款
             If chkCard.Value = vbChecked Then
                '建立卡付對帳單=============
                 Dim tmpRemain As Currency
                 If CCur(ftRemain.Text) >= CCur(txtFK.Text) Then
                     tmpRemain = CCur(ftRemain.Text) - CCur(txtFK.Text)
                     InserToCard DB, 0, "消費卡結帳 - " & Date, CCur(txtFK.Text), Trim(ftCID.Text), lSheelID, tmpRemain
                    '---------------------------
                    '有足夠金額時
                    '減少卡上金額
                     UpdateRemain DB, Trim(ftCID.Text), tmpRemain
                    '插入剩余現金
                     InserToCash DB, 1, sMemo, CCur(txtFK.Text), Date, "會員卡付"
                    '修改今日與總金額
                     InserTodayCash DB, "會員卡付", CCur(txtFK.Text), Date
                   Else
                    '資金不夠時，只能通過其它方法輸入
                     tmpRemain = 0
                     InserToCard DB, 0, "消費卡結帳 - " & Date, CCur(ftRemain.Text), Trim(ftCID.Text), lSheelID, tmpRemain
                    '---------------------------
                     '減少卡上金額
                     UpdateRemain DB, Trim(ftCID.Text), tmpRemain
                    '插入剩余現金
                     InserToCash DB, 1, sMemo, CCur(ftRemain.Text), Date, "會員卡付"
                    '修改今日與總金額
                     InserTodayCash DB, "會員卡付", CCur(ftRemain.Text), Date
                    '========補足不夠的部分===========================================
                     '插入剩余現金
                     InserToCash DB, 1, sMemo, CCur(txtFK.Text) - CCur(ftRemain.Text), Date, cmbPayMethod.Text
                    '修改今日與總金額
                     InserTodayCash DB, cmbPayMethod.Text, CCur(txtFK.Text) - CCur(ftRemain.Text), Date
                  End If
               Else
                 InserToCash DB, 1, sMemo, CCur(txtFK.Text), Date, cmbPayMethod.Text
                '4修改今日與總金額
                 InserTodayCash DB, cmbPayMethod.Text, CCur(txtFK.Text), Date
             End If
          Else
           '插入掛帳庫中。
            InserToArrearage DB, lSheelID, Trim(ftCID.Text), Trim(ftArrearage.Text), CCur(txtFK.Text), Date
           '4修改今日與總金額
            InserTodayCash DB, "掛帳", CCur(txtFK.Text), Date
        End If
        
       '5清臺
        Dim sTMp As String
            sTMp = "Update tmpCust Set SheelID=" & lSheelID & " Where Site='" & sPubSite & "'"
            DB.Execute sTMp

       '6替換付款金額
        GetJE DB
        
       '打印函數
       'Call cmdPrint_Click
      
       '保存消費記錄
        sTMp = "Insert Into Site Select * From tmpSite Where Site='" & sPubSite & "'"
        DB.Execute sTMp
        sTMp = "Insert Into Cust Select * From tmpCust Where Site='" & sPubSite & "'"
        DB.Execute sTMp
       '清除臨時記錄
        sTMp = "Delete  From tmpSite Where Site='" & sPubSite & "'"
        DB.Execute sTMp
        sTMp = "Delete  From tmpCust 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 & "'"
        DB.Execute sTMp
        
    DB.CommitTrans
    DB.Close
    Set DB = Nothing
    
    Unload Me
    
    Exit Sub
    
CheckErr:
    MsgBox "結帳發生錯誤：" & vbCrLf & vbCrLf & Err.Description, vbCritical, vbOKOnly
    On Error Resume Next
    DB.RollbackTrans
    DB.Close
    Set DB = Nothing
    
End Sub

Private Sub cmdPrint_Click()

  '顯示打印預覽
   frmPreview.Show 1
      
End Sub

Private Function GetSiteID(stmpIds As String) As String
 
   On Error GoTo GetERR
   
   Dim pDB As Connection
   Dim pRS As Recordset
   Dim sTmpx As String
   
   Set pDB = CreateObject("ADODB.Connection")
   Set pRS = CreateObject("ADODB.Recordset")
       pDB.Open Constr
       sTmpx = "SElect * from tmpSite Where Site='" & stmpIds & "'"
       pRS.Open sTmpx, pDB, adOpenStatic, adLockReadOnly, adCmdText
       If pRS.EOF And pRS.BOF Then
          GetSiteID = ""
        Else
          GetSiteID = pRS("ID")
       End If
       
       pRS.Close
       pDB.Close
       Set pRS = Nothing
       Set pDB = Nothing
       
       Exit Function
       
GetERR:
       GetSiteID = ""
       MsgBox "對不起,給出消費單號錯誤:" & Err.descrition, vbCritical
       Exit Function
       
End Function

Private Sub cmdSelectMember_Click()

    sGuestID = "": sGuestName = ""
    cGuestRemain = 0                  '初始化會員參數
    frmMemberSelect.Show 1
  
    If sGuestID = "" Then
        ftCID.SetFocus
        Exit Sub
      Else
        ftCID.Text = sGuestID
        ftCName.Text = sGuestName
        ftRemain.Text = cGuestRemain
        cmbDZ.Text = GetCustomerRate(sGuestID)
        Already = True
        GetMoneyCount
        txtSK.SetFocus
       '計算打折率
    End If

End Sub

Private Sub GetMoneyCount()

   On Error Resume Next
   If chkCard.Value = vbChecked Then
     '如果卡的金額足夠時
      If CCur(ftRemain.Text) > CCur(txtFK.Text) Then
         txtSK.Text = 0
         txtZL.Text = 0
       Else
        '否則補上差額
         txtSK.Text = CCur(txtFK.Text) - CCur(ftRemain.Text)
         txtZL.Text = 0
      End If
     Else
     txtSK.Text = txtFK.Text
  End If

End Sub

Private Sub cmdSmallPrint_Click()
  
 '給出當前座位的ID
  PrintSmallSheet GetSiteID(sPubSite)
  
End Sub

Private Sub Form_Load()

  On Error GoTo CashERR
 
  GetFormSet Me, Screen
 '計算付款金額
  Me.MousePointer = 11
 
 '包廂費與金額
  cJE = 0: cBXF = 0: cRate = 0
  JSAmo = 0: JGAmo = 0: SFAmo = 0: FKAmo = 0
  
  cmbDZ.Text = "100"
 '計算金額,每次重新啟動計算機金額
 
  txtBXF.Text = cBXF
  txtJE.Text = cJE
  txtFK.Text = FKAmo
  Already = False
  
 '配置付款方式
  ConfigPayMethod
  
 '是否允許打折
  If AllowDZ = False And UserText <> "超級用戶" Then
     cmbDZ.Visible = False
     Label1(1).Visible = False
     Label1(0).Visible = False
  End If
  
 '設置目前餐桌狀態
  If SetCashOut(sPubSite, 3) = False Then
     
  End If
  
  Me.MousePointer = 0
 
  Exit Sub
CashERR:
  MsgBox "進入收款系統錯誤:" & Err.Description, vbCritical
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveSetting App.EXEName, "Option", "Acount", cmbDZ.ListIndex
  SaveSetting App.EXEName, "Option", "PayMethod", cmbPayMethod.ListIndex
  SaveFormSet Me
  
End Sub

Private Sub ftCID_Change()

  Already = False
  
End Sub

Private Sub ftCID_DblClick()

  cmdSelectMember_Click
 
End Sub

Private Sub ftCID_LostFocus()
  
  '較對會員是否存在
  If Trim(ftCID.Text) <> "" Then
    '如果已經查詢時，不必再查詢
     If Already = True Then Exit Sub
     If CheckCustomerRate(Trim(ftCID.Text)) = False Then
        cmbDZ.Text = "100"
        ftRemain.Text = "0"
        ftCID.Text = ""
        ftCName.Text = ""
        Already = True
        GetMoneyCount
        Exit Sub
     End If
    '給出打折率
     If AllowDZ = True Or UserText = "超級用戶" Then
        cmbDZ.Text = cRate
     End If
     ftCName.Text = sGuestName
     ftRemain.Text = cGuestRemain
     GetMoneyCount
     Already = True
    Else
     cmbDZ.Text = "100"
     ftRemain.Text = "0"
     ftCName.Text = ""
     GetMoneyCount
     Already = False
  End If
   
End Sub

Private Sub ftCName_DblClick()

  cmdSelectMember_Click

End Sub

Private Sub txtFK_Change()

   GetMoneyCount
   
End Sub

Private Sub txtJE_Change()

  On Error Resume Next
  'txtFK.Text = FKAmo + JGAmo + cBXF