frmback.frm

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

      BorderStyle     =   6  'Inside Solid
      FillColor       =   &H00C0E0FF&
      FillStyle       =   0  'Solid
      Height          =   2070
      Index           =   1
      Left            =   105
      Shape           =   4  'Rounded Rectangle
      Top             =   105
      Width           =   5655
   End
End
Attribute VB_Name = "frmBack"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()

  If Trim(cmbSite.Text) = "" Then
     MsgBox "座位号不能为空？   ", vbInformation
     cmbSite.SetFocus
     Exit Sub
  End If
  
  BackIt
  
End Sub

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

  If KeyCode = 27 Then
     Unload Me
  End If
  
End Sub

Private Sub Form_Load()

  GetFormSet Me, Screen
  ConfigSite
  
End Sub

'结帐后退单
Private Sub BackIt()

    On Error GoTo BackERR
    
    Dim bDB As Connection
    Dim EF As Recordset
    Dim lSheelID As Long
    Dim tmpCur As Currency
    
    Set bDB = CreateObject("ADODB.Connection")
    Set EF = CreateObject("ADODB.Recordset")
        bDB.Open Constr
        EF.Open "Select * From tmpSite Where Site='" & Trim(cmbSite.Text) & "'", bDB, adOpenStatic, adLockOptimistic, adCmdText
        
       '1/首先检测该座位有没有上台，如果上台，将不能退单
        If EF.BOF And EF.EOF Then  '没有记录时为0
           '可以退单
           '事务处理
           Dim FG As Recordset
           Dim lID As Long
           Dim IsGZ As Integer
           Dim sTmp As String
           Dim curMoney As Currency           '金额
           Dim sMemberID As String            '如果为会员时,必须修改该会员的累计
           Dim sPaymethod As String           '付款方式
               curMoney = 0: sMemberID = "": IsGZ = 0
           Set FG = CreateObject("ADODB.Recordset")
             '打开该坐位的所有记录
              FG.Open "Select * From Site Where Site='" & Trim(cmbSite.Text) & "' Order By ID ASC", bDB, adOpenStatic, adLockReadOnly, adCmdText
            '2没有找到该座位的消费记录
             If FG.EOF And FG.BOF Then '没有记录时
                FG.Close
                EF.Close
                bDB.Close
                Set FG = Nothing
                Set EF = Nothing
                Set bDB = Nothing
                MsgBox "对不起，没有找到座位（餐桌）【" & cmbSite.Text & "】消费单！  " & vbCrLf _
                       & "请确认是不是输入错误餐桌号，请再试试？   ", vbInformation
                cmbSite.SetFocus
                Exit Sub
               Else
                    FG.MoveLast
                    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: Set EF = Nothing
              If MsgBox("〖" & Trim(cmbSite.Text) & "〗桌,最后一次消费的单号为【" & CStr(lID) & "】。 " & vbCrLf & vbCrLf _
                  & "如果正确,按『是』还原消费单,否则按『否』取消还原。  ", vbInformation + vbYesNo) = vbNo Then
                 bDB.Close
                 Set bDB = Nothing
                 Exit Sub
              End If
              
               bDB.BeginTrans
               
              'A.还原座位及付款消息
               sTmp = "Insert Into tmpSite Select * From Site Where ID=" & lID
               bDB.Execute sTmp
              'B.还原点菜记录
               sTmp = "Insert Into tmpCust Select * From Cust Where SheelID=" & lID
               bDB.Execute sTmp
               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
              'C 修改该座位为上台
               sTmp = "Update SiteType Set SiteStatus=2 Where Class='" & Trim(cmbSite.Text) & "'"
               bDB.Execute sTmp
               
               bDB.CommitTrans
         Else
            EF.Close
            bDB.Close
            Set EF = Nothing
            Set bDB = Nothing
                MsgBox "对不起，该座位已经上台，不能再退单。  " & vbCrLf _
              & "请注意，结帐后退单必须在该单还未上台的情况下。  ", vbInformation
            Exit Sub
        End If

    bDB.Close
    Set bDB = Nothing
    
    MsgBox "消费单已经恢复，请立即到【客人上台】区退单，并且结帐。    ", vbInformation
    Unload Me
    
    Exit Sub
BackERR:
    MsgBox "对不起，还原消费单错误？" & Err.Description, vbCritical
    Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)

   SaveFormSet Me
   
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<2"
       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
        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
    '直接指向座位号
     If cmbSite.ListCount > 1 Then
        If sInfoSite <> "" Then
           cmbSite.ListIndex = SendMessage(cmbSite.hwnd, CB_FINDSTRING, -1, ByVal sInfoSite)
         Else
           cmbSite.ListIndex = 0
        End If
     End If
     Exit Sub
     
Err_init:
    MsgBox "装载（座位）未知错误！" & Err.Description, vbExclamation, "错误：By Yusilong."

End Sub