frmhzsite.frm

星级酒店管理系统（附带系统自写控件源码）

Private Sub MnuDelete_Click()

  '删除消费单
  On Error GoTo DelErr
 
  If lstPro.ListItems.Count = 0 Then
     MsgBox "没有内容可以删除？   ", vbInformation
     Exit Sub
  End If
  
  If lstPro.SelectedItem.Text = "" Then
     MsgBox "没有内容可以删除？   ", vbInformation
     Exit Sub
  End If
 
 Dim bDB As Connection
 Dim sTmp As String
 Dim nID As Long
     nID = CLng(Trim(lstPro.SelectedItem.Text))
     
  If nID = 0 Then Exit Sub
  
  If MsgBox("真要删除[" & nID & "]号消费单吗？（Y/N）  ", vbInformation + vbYesNo) = vbNo Then Exit Sub
 
       Set bDB = CreateObject("ADODB.Connection")
           bDB.Open Constr
           
           Dim FG As Recordset
           Dim lID As Long
           Dim IsGZ As Integer
           Dim curMoney As Currency           '金额
           Dim sMemberID As String            '如果为会员时,必须修改该会员的累计
           Dim sPaymethod As String           '付款方式
           Dim tmpCur As Currency
           
               curMoney = 0: sMemberID = "": IsGZ = 0
           
           Set FG = CreateObject("ADODB.Recordset")
             '打开该坐位的所有记录
              FG.Open "Select * From Site Where ID=" & nID, bDB, adOpenStatic, adLockReadOnly, adCmdText
            '2没有找到该座位的消费记录
             If FG.EOF And FG.BOF Then '没有记录时
                FG.Close
                bDB.Close
                Set FG = Nothing
                Set bDB = Nothing
                MsgBox "对不起，没有找到编号为【" & nID & "】消费单！  " & vbCrLf _
                   & "请确认是不是其他用户已经删除该单,请刷新再试试？   ", vbInformation
                Exit Sub
               Else
                lID = FG.Fields("ID")            '给出该座位的最后一次消费的单号
                curMoney = FG("SFAmo")
                sMemberID = NullValue(FG("MID"))
                IsGZ = FG("IsArrearage")        '挂帐
                sPaymethod = NullValue(FG("tmpStr"))
                tmpCur = FG("tmpCur")
                FG.Close
              End If
              Set FG = Nothing
              
               bDB.BeginTrans
               
              '删除单据明细与座位信息
               sTmp = "Delete From Site Where ID=" & lID
               bDB.Execute sTmp
               sTmp = "Delete From Cust Where SheelID=" & lID
               bDB.Execute sTmp
               
              '如果非挂帐时
               If IsGZ = 0 Then
                 '还原流水帐
                  If tmpCur = curMoney Then        '所有都以卡付时
                    If tmpCur > 0 Then
                       Dim tmpRemain As Currency
                           tmpRemain = GetCount(bDB, sMemberID) + tmpCur
                          '补充卡值
                           InserToCard bDB, 1, "『" & lID & "』号消费单还原" & Time, tmpCur, sMemberID, lID, tmpRemain
                           InserToCash bDB, 0, "消费单还原", tmpCur, Date, sPaymethod
                          '修改今日与总金额
                           InserTodayCash bDB, "会员卡付", -tmpCur, Date
                          '更新最后余额
                           UpdateRemain bDB, sMemberID, tmpRemain
                    End If
                   Else                           '卡与其它合用时
                    If tmpCur > 0 Then
                        InserToCash bDB, 0, "消费单还原", curMoney - tmpCur, Date, sPaymethod
                        InserTodayCash bDB, sPaymethod, -(curMoney - tmpCur), Date
                        InserToCard bDB, 1, "『" & lID & "』号消费单还原" & Time, tmpCur, sMemberID, lID, tmpRemain
                        InserTodayCash bDB, "会员卡付", -tmpCur, Date
                        InserToCash bDB, 0, "消费单还原", tmpCur, Date, "会员卡付"
                      Else
                      '不使用卡时
                        InserToCash bDB, 0, "消费单还原", curMoney, Date, sPaymethod
                        InserTodayCash bDB, sPaymethod, -curMoney, Date
                     End If
                  End If
                 '如果客户不为空时
                  If sMemberID <> "" Then
                     UpdateGuestLJ bDB, sMemberID, -curMoney, 0
                  End If
                Else
                '挂帐时
                 If sMemberID <> "" Then
                    UpdateGuestLJ bDB, sMemberID, 0, -curMoney
                 End If
               '修改挂帐中金额及付款日期
                'sTmp = "Update tbdArrearage Set MSFAmount=" & curMoney & ",MReturn=1,MRDate=#" & Date & "# Where SheelID=" & lID
                '直接删除消费单
                 sTmp = "Delete tbdArrearage Where SheelID=" & lID
                 bDB.Execute sTmp
               End If
               
              bDB.CommitTrans
              bDB.Close
          Set bDB = Nothing
     
        '移去该行
         lstPro.ListItems.Remove lstPro.SelectedItem.Index
          
 Exit Sub
DelErr:
  MsgBox "不能删除该消费单。  " & vbCrLf & vbCrLf & Err.Description, vbCritical
  Exit Sub
    
End Sub

Private Sub MnuExit_Click()

  Call cmdExit_Click
  
End Sub

Private Sub RefreshGrid(sOrder As String)

 On Error GoTo LoadERR

 Dim DB As Connection
 Dim EF As Recordset
 
 Dim curAmount As Currency   '注入1
 Dim curGet As Currency      '支出0
     curAmount = 0: curGet = 0
 Set DB = CreateObject("ADODB.Connection")
 Set EF = CreateObject("ADODB.Recordset")
     DB.Open Constr
     EF.Open "Select * from Site " & sOrder, DB, adOpenForwardOnly, adLockReadOnly, adCmdText
         
     lstPro.Visible = False
     lstPro.ListItems.Clear
     Me.MousePointer = 11
     Dim bLoad As Boolean
     
     If Not (EF.EOF And EF.BOF) Then
        
        Dim ccQuanty As Currency, ccAmount As Currency, ccMoney As Currency
            ccQuanty = 0: ccAmount = 0: ccMoney = 0

        Do While Not EF.EOF
          '合计
           ccMoney = ccMoney + EF.Fields("SFAmo")    '总额
           ccAmount = ccAmount + EF("JEAmo")         '实付
           ccQuanty = ccQuanty + EF("BXF")           '包厢费
           InsertToHz lstPro, EF.Fields("ID"), EF.Fields("Date"), EF("lHour"), EF("lMinute") _
                        , EF("Site"), EF.Fields("BXF") & "元", EF.Fields("JEAmo") & "元", EF.Fields("Discount") & "%", EF("SFAmo") & "元", NullValue(EF("Waiter")), NullValue(EF("CheckOutMan"))
            EF.MoveNext
            DoEvents
         Loop
        '添加合计信息
         InsertToHz lstPro, "", "【 合 计 】", "", "", "", CStr(Round(ccQuanty, 2)) & "元", CStr(Round(ccAmount, 2)) & "元", _
                   "", CStr(ccMoney) & "元", "", ""
     End If
 
     IsAdd = False
     lstPro.Visible = True
     Me.MousePointer = 0
     
 Exit Sub
LoadERR:
  Me.MousePointer = 0
  MsgBox "安装消费记录出错？" & Err.Description, vbExclamation, "www.vb-code.net"""
  Exit Sub
   
End Sub

'添加到流水帐中
Private Sub InsertToHz(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 _
      , sText10 As String, sText11 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) = Trim(sText6)
       lstTmp.SubItems(6) = Trim(sText7)
       lstTmp.SubItems(7) = Trim(sText8)
       lstTmp.SubItems(8) = Trim(sText9)
       lstTmp.SubItems(9) = Trim(sText10)
       lstTmp.SubItems(10) = Trim(sText11)
End Sub

Private Sub mnuPrint_Click()
  
  Call cmdPrint_Click
  
End Sub

Private Sub mnuPrintSheet_Click()
  
 On Error GoTo PrintErr
 
  If lstPro.ListItems.Count = 0 Then
     MsgBox "单据为空,不能查看？  ", vbExclamation
     Exit Sub
  End If
  
  If lstPro.SelectedItem.Text = "" Then
     MsgBox "请选择任一单据后继续？  ", vbExclamation
     Exit Sub
  End If
  
  AfterPrintSheet lstPro.SelectedItem.Text

 Exit Sub
PrintErr:
 MsgBox "对不起，打印单据错误:" & Err.Description, vbCritical
 
End Sub

'结帐后打印帐单
Public Sub AfterPrintSheet(nID As Long)
     
    On Error GoTo PrintErr
     
    If nID = 0 Then
       MsgBox "消费单为空，不能打印？  ", vbInformation
       Exit Sub
    End If
        
   '首先给出当前桌的消费记录
    Dim iDiscount As Integer, iArrearage As Integer
    Dim curSfPay As Currency, curYinPay As Currency, curPackage As Currency, curHJ As Currency
    Dim sSQL As String, sMyGuestName As String, sMyGuestID As String, sMyOperator As String, sMysite As String
    Dim sMypaymethod As String
    Dim dMyDate As Date
    Dim sWaiter As String
   '当前座位,当前菜单中内容,每ID代表一桌消费
    sSQL = "Select Site.Site,Site.Date,Site.IsArrearage,Site.lHour,Site.lMinute,Site.CheckOutman,Site.MID," _
       & "tbdMember.Name,Site.JeAmo,Site.DCJE,Site.tmpStr,Site.SFAmo,Site.Waiter,Site.BXF,Site.Discount " _
       & " From Site Left Join tbdMember On Site.MID=tbdMember.ID  Where Site.ID=" & nID
        
    Dim DB As Connection, EF As Recordset
    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
           sMysite = EF("Site")
           iArrearage = EF("IsArrearage")
           sMypaymethod = EF("tmpStr")
           If Not IsNull(EF("Date")) Then
              dMyDate = EF("Date")
            Else
              dMyDate = Date
           End If
          'ftDate.Text = EF("Date")
          'ftHour.Text = EF("lHour")
          'ftMinute.Text = EF("lMinute")
           sMyOperator = NullValue(EF("checkOutMan"))
           sMyGuestID = NullValue(EF("MID"))
           sMyGuestName = NullValue(EF("Name"))
           curHJ = EF("DCJE")                     '点菜金额
           curPackage = NullValue(EF("BXF"))      '包厢
           curSfPay = EF("SFAmo")                 '实付
           sWaiter = NullValue(EF("Waiter"))
           iDiscount = EF("Discount")
       End If
       EF.Close
       Set EF = Nothing
       DB.Close
       Set DB = Nothing
        
    '打印格式
     Dim bExit As Boolean
     Dim sBB As String
     Set DB = CreateObject("ADODB.Connection")
         DB.Open Constr
         sBB = "Delete From prtCust"                              '清空所有数据
         DB.Execute sBB
     Set EF = CreateObject("ADODB.Recordset")
         EF.Open "SELECT DType AS DType, Name AS Name, Unit AS Unit, Price AS Price, Sum(Quanty) AS Quantys, Sum(JGF) AS JGFs, Sum(Amos) AS Amoss From Cust WHERE SheelID=" & nID & " GROUP BY DType, Name, Unit, Price", DB, adOpenStatic, adLockReadOnly, adCmdText
     Dim lPaperCountS As Integer, lPaperCount As Integer
     Dim lCurrent As Integer
         If EF.BOF And EF.EOF Then  '没有记录时 退出
            EF.Close
            Set EF = Nothing
            DB.Close
            Set DB = Nothing
            MsgBox "没有消费记录,不能打印。   ", vbExclamation
            Exit Sub
          Else
            lPaperCount = 0
           '给出该桌消费的记录数
            Do While Not EF.EOF
               lPaperCount = lPaperCount + 1
               EF.MoveNext
            Loop
            EF.MoveFirst
         End If
         
       '计算总页数
        lPaperCountS = lPaperCount / nPrintLine
        If (lPaperCount Mod nPrintLine) <> 0 And (lPaperCount > nPrintLine) Then '正除时不加0
           lPaperCountS = lPaperCountS + 1
        End If
        If lPaperCountS = 0 Then
           lPaperCountS = lPaperCountS + 1
        End If
          
          Dim x As Integer
          Dim sPN As String
          Dim cDJ As String
          Dim lSL As String
          Dim cJE As String
          Dim cDW As String
          Dim H As Integer
          Dim cJGF As String
          Dim sType As String '类型
          Dim sType1 As String '类型
        '开始打印
         Printer.ScaleMode = 6 'mm
         
   For x = 1 To lPaperCountS
      
         '打印单位名称
          Printer.FontSize = 24
          Printer.FontName = "黑体"
          Printer.FontBold = True
          Printer.CurrentX = ((110 - (Printer.TextWidth(sUnit))) / 2) + 8
          Printer.CurrentY = XTop + 8
         'NoTitle为不打印标题，客户可自行给出
         'NoTitle=1 Or -1
          If NoTitle = False Then
             Printer.Print sUnit
          End If
          Printer.FontSize = 9
          Printer.FontName = "黑体"
          Printer.FontBold = True
          Printer.CurrentX = 8 + XLeft
          Printer.CurrentY = 26 + XTop
          Printer.Print "单号:" & nID
                    
          If iArrearage = 1 Then
            '打印挂帐
             Printer.CurrentX = 42 + XLeft
             Printer.CurrentY = 26 + XTop
             Printer.Print "挂帐"
           Else
             Printer.CurrentX = 42 + XLeft
             Printer.CurrentY = 26 + XTop
             Printer.Print "结帐:" & sMypaymethod
          End If
          Printer.CurrentX = 75 + XLeft
          Printer.CurrentY = 26 + XTop
          Printer.Print "日期:" & Format(dMyDate, "Long Date")
         '桌号
          Printer.CurrentX = 8 + XLeft
          Printer.CurrentY = 32 + XTop
          Printer.Print "桌号:" & sMysite
         '会员信息
          If Trim(sMyGuestID) <> "" And Trim(sMyGuestName) <> "" Then
             Printer.CurrentX = 42 + XLeft
             Printer.CurrentY = 32 + XTop
             Printer.Print "会员:" & sMyGuestID
             Printer.CurrentX = 75 + XLeft
             Printer.CurrentY = 32 + XTop
             Printer.Print "姓名:" & sMyGuestName
          End If
         '打印菜单标题
          Printer.CurrentX = 8 + XLeft
          Printer.CurrentY = 40 + XTop
          Printer.FontBold = False
          Printer.Font = "宋体"
          Printer.Print "菜单类别    "
          Printer.CurrentX = 29 + XLeft
          Printer.CurrentY = 40 + XTop
          Printer.Print "菜  名    "
          Printer.CurrentY = 40 + XTop
          Printer.CurrentX = 65 + XLeft
          Printer.Print "单位"
          Printer.CurrentY = 40 + XTop
          Printer.CurrentX = 75 + XLeft
          Printer.Print "单价"
          Printer.CurrentY = 40 + XTop
          Printer.CurrentX = 83 + XLeft
          Printer.Print "数量"
          Printer.CurrentY = 40 + XTop
          Printer.CurrentX = 89 + XLeft
          Printer.Print "加工"
          Printer.CurrentY = 40 + XTop
          Printer.CurrentX = 98 + XLeft
          Printer.Print "金额"
         '-----------------------------------------
                 H = 1
              If x = 1 Then  '分页
                 EF.MoveFirst
                Else
                 EF.MoveFirst
                 EF.Move ((x - 1) * nPrintLine)
              End If
            '打印所有菜单
             Do While Not EF.EOF