frmcash.frm

餐饮茶馆管理系统

End Sub

Private Sub cmdPay_Click()

  On Error Resume Next
   '检验收款是否正确
    If Val(txtSK) = 0 Or Val(txtSK) < Val(txtFK) - 20 Then
       MsgBox "对不起，付款不正确，请检查后继续！    " & vbCrLf & vbCrLf & "    付款金额：" & txtFK & "元", vbInformation
       txtSK.SetFocus
       Exit Sub
     ElseIf MsgBox("确认入帐吗？(Y/N)   ", vbYesNo + vbInformation) = vbNo Then
       Exit Sub
    End If
        
    Dim DB As Database
    Set DB = OpenDatabase(ConData, False, False, Constr)
      
   
   '打印函数
    Call cmdPrint_Click
   '等待
      
  ' 事务处理
    DBEngine.BeginTrans
    Dim SellID As Recordset

    '获得最后消费号
    Set SellID = DB.OpenRecordset("SellCount", dbOpenDynaset)
      If SellID.EOF And SellID.BOF Then
         nLast = 1
       Else
         SellID.MoveLast
         nLast = SellID.Fields(0) + 1
      End If
      SellID.Close
             
    '给出最后时间与上台时间
    Dim EF As Recordset
    Dim sEXE As String
        Set EF = DB.OpenRecordset("tmpSell", dbOpenDynaset)
        Dim sTmp As String, sTime1 As Date, sTime2 As Date
        sTmp = "座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
        EF.FindFirst sTmp
     If EF.NoMatch Then
        MsgBox "上台时间为当前时间？  ", vbInformation
        sTime1 = Format(Time(), "Short Time")
      Else
        sTime1 = EF.Fields("上台时间")
     End If
        sTmp = ""
        sTime2 = Format(Time(), "Short Time")  '下台时间
     EF.Close
     
    '消费单
    sTmp1 = "Insert into SellCount (SiteName,卡号,金额,日期,时间,ID,上台时间,下台时间,付款方式,消费总额) values('" & Trim(frmCustomerForm.cmbSite.Text) & "','" & CardNO & "'," & Val(txtFK.Text) & ",#" & Date & "#," & Val(Time()) & "," & nLast & ",#" & sTime1 & "#,#" & sTime2 & "#,'" & Trim(cmbPayMethod.Text) & "'," & Val(txtJE.Text) & ")"
    
    DB.Execute sTmp1
   
    Dim sSql1 As String, sSql2 As String, sSql3 As String

      sSql3 = "Update tmpSell Set ID=" & nLast & " Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
      DB.Execute sSql3
      
      '更新仓库
      Dim HG As Recordset
      Dim sTmpCode As String
          sTmp1 = ""
    
    Set EF = DB.OpenRecordset("Select * From tmpSell Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'", dbOpenDynaset)
    Set HG = DB.OpenRecordset("Select * From StoreList", dbOpenDynaset)
    Do While Not EF.EOF
       ' 减少库存记录，首先查找是否存在库存中，然后更新
         sTmpCode = EF.Fields(3).Value
         sTmp = "代码='" & sTmpCode & "'"
            HG.FindFirst sTmp
            If HG.NoMatch Then
               '播入记录
               sTmp1 = "Insert into StoreList Select Menutype,名称,单位,单价,金额,代码,数量 From tmpSell Where 代码='" & sTmpCode & "'"
               DB.Execute sTmp1
               sTmp1 = "Update StoreList Set 数量=-(数量),金额=-(金额) Where 代码='" & sTmpCode & "'"
             Else
               '更新记录
               sTmp1 = "Update StoreList Set 数量=数量-" & EF.Fields("数量") & ",金额=金额-" & EF.Fields("金额") & " Where 代码='" & sTmpCode & "'"
            End If
            DB.Execute sTmp1
      EF.MoveNext   '记录下翻
    Loop
    EF.Close
    HG.Close
      
    sSql1 = "Insert into SellList Select * From tmpSell Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
    DB.Execute sSql1
      
    sSql2 = "Delete * From tmpSell Where 座位='" & Trim(frmCustomerForm.cmbSite.Text) & "'"
    DB.Execute sSql2
                    
    DBEngine.CommitTrans
    DB.Close
    
   '清空
    frmCustomerForm.ConfigGrid2 Trim(frmCustomerForm.cmbSite.Text)
    
   '御载
    Unload Me
    Exit Sub
    
Err_:
    MsgBox "未知错误：" & vbCrLf & vbCrLf & Err.Description, vbCritical, vbOKOnly

End Sub

Private Sub cmdPrint_Click()

  On Error Resume Next
  
  '打印模块
  Dim lRet As Long
  Dim bRet As Boolean
 
  bRet = ShellAndWait(App.Path & "\Printer.exe " & "ID=" & Trim(Str(nLast)) & "NO=" & Trim(txtCardNO.Text) & "JE=" & Trim(txtJE.Text) & "FK=" & Trim(txtFK.Text) & "ST=" & Trim(frmCustomerForm.cmbSite.Text) & "US=" & UserText, 1, lRet, "", App.Path)
 
 'Shell App.Path & "\Printer.exe " & "ID=" & Trim(Str(nLast)) & "NO=" & Trim(txtCardNO.Text) & "JE=" & Trim(txtJE.Text) & "FK=" & Trim(txtFK.Text) & "ST=" & Trim(frmCustomerForm.cmbSite.Text), vbNormalFocus
 'retVal = ShellExecute(Me.hwnd, "Open", strPrint, 0, 0, 1)
 
End Sub

Private Sub Form_Load()

    txtJE = cJE
    txtFK = cJE
    
    cmbDZ.ListIndex = Val(GetSetting(App.EXEName, "Option", "Acount", 10))
 
    CardNO = ""
    
    '配置付款方式
     ConfigPayMethod
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
  
  SaveSetting App.EXEName, "Option", "Acount", cmbDZ.ListIndex

End Sub

Private Sub txtCardNO_Change()
  
  Dim TmpStr As String
  
   TmpStr = GetCardNO(Trim(txtCardNO))
 If TmpStr <> "" Then
    cmbDZ.Visible = True
    txtCardNO.Enabled = False
    txtFK = Val(txtJE) * Val(cmbDZ.Text) / 100
    txtSK = txtFK
    txtSK.SetFocus
 End If
  
End Sub

Private Sub txtCardNO_GotFocus()

  SetItFocus txtCardNO
  
End Sub

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

  DirectFocus txtCardNO, txtSK, txtSK, txtSK, KeyCode
    
End Sub

Private Sub txtCardNO_KeyPress(KeyAscii As Integer)

  If KeyAscii = 8 Then Exit Sub
  
  If KeyAscii < 48 Or KeyAscii > 57 Then
     KeyAscii = 0
  End If
  
End Sub

Private Sub txtFK_Change()

  txtSK = txtFK
  
End Sub

Private Sub txtSK_Change()

  txtZL = Val(txtSK) - Val(txtFK)
  
End Sub

Private Sub txtSK_DblClick()

  txtSK = txtFK
  txtSK.SelStart = 0
  txtSK.SelLength = Len(txtSK)
  
End Sub

Private Sub txtSK_GotFocus()

  SetItFocus txtSK
  
End Sub

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

  If KeyCode = 13 Then
     KeyCode = 0
  End If
  
 DirectFocus txtCardNO, cmdPay, txtCardNO, txtCardNO, KeyCode
  
End Sub

Private Sub txtSK_KeyPress(KeyAscii As Integer)
  
  If KeyAscii = 8 Then Exit Sub
  
  If (KeyAscii < 46 Or KeyAscii > 57) Or KeyAscii = 47 Then
     KeyAscii = 0
  End If
  
End Sub

Private Sub txtZL_KeyPress(KeyAscii As Integer)
  
  If KeyAscii = 13 Then
     cmdPay.SetFocus
     Exit Sub
  End If
  If KeyAscii = 8 Then
     Exit Sub
  End If
  If (KeyAscii < 46 Or KeyAscii > 57) And KeyAscii <> 47 Then
     KeyAscii = 0
  End If
  
End Sub

Private Function GetCardNO(sPM As String) As String

   On Error GoTo Err_dj
   
   sPM = Trim(sPM)
   
   Dim DB As Database, EF As Recordset
    Set DB = OpenDatabase(ConData, False, False, Constr)
    
    Set EF = DB.OpenRecordset("Select * From Detail Where 卡号='" & sPM & "'", dbOpenDynaset)
        
        If EF.BOF And EF.EOF Then
           GetCardNO = ""
           CardNO = ""
         Else
           GetCardNO = sPM
           CardNO = sPM
        End If
         
    EF.Close
    DB.Close
      Exit Function
Err_dj:
 MsgBox "给出卡号错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Function

Private Sub ConfigPayMethod()

  Dim DB As Database, EF As Recordset, HH As Integer
  Set DB = OpenDatabase(ConData, False, False, Constr)
           
    Set EF = DB.OpenRecordset("Select * From PayType", dbOpenDynaset)
        HH = 1
        Do While Not EF.EOF()
          If Not IsNull(EF.Fields(1)) Then
             cmbPayMethod.AddItem EF.Fields(1).Value
          End If
          EF.MoveNext
          HH = HH + 1
        Loop
        
  EF.Close
  DB.Close
  
  If HH > 1 Then
     cmbPayMethod.ListIndex = GetSetting(App.EXEName, "Option", "PayMethod", 0)
     SaveSetting App.EXEName, "Option", "PayMethod", cmbPayMethod.ListIndex
  End If
 
End Sub