frmcheckout1.frm

简单的酒店管理程序。

            cboItem(3).Clear
            
            
            txtSQL = "select roomNO,roomtype,roomposition,roomprice from rooms where roomNO ='" & Trim(cboItem(0)) & "'"
            Set mrcc = ExecuteSQL(txtSQL, MsgText)
            
            If Not mrcc.EOF Then
                
                cboItem(1).AddItem mrcc!roomtype
                cboItem(2).AddItem mrcc!roomposition
                cboItem(3).AddItem mrcc!roomprice
                
                cboItem(1).Enabled = False
                cboItem(2).Enabled = False
                cboItem(3).Enabled = False
                
                cboItem(1).ListIndex = 0
                cboItem(2).ListIndex = 0
                cboItem(3).ListIndex = 0
                
                
                cmdSave.Enabled = True
            Else
                MsgBox "没有订房信息！", vbOKOnly + vbExclamation, "警告"
                cmdSave.Enabled = False
                Exit Sub
            End If
            mrcc.Close
            
            txtSQL = "select * from bookin where ammount = '0' and roomno = '" & Trim(cboItem(0)) & "'"
            Set mrcc = ExecuteSQL(txtSQL, MsgText)
            If Not mrcc.EOF Then
                txtNo = mrcc!bookno
                txtItem(0) = mrcc!customname
                txtItem(1) = mrcc!customID
                txtItem(2) = mrcc!indate
                txtItem(3) = mrcc!discount
                txtItem(5) = mrcc!inmemo
                
                For intCount = 0 To 3
                    txtItem(intCount).Enabled = False
                Next intCount
                
                
            End If
            mrcc.Close
                
        
        End If
    End If
    Exit Sub
    
End Sub

Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
    
End Sub

Private Sub cmdExit_Click()
    If mblChange And cmdSave.Enabled Then
        If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            '保存
            Call cmdSave_Click
        End If
    End If
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim intCount As Integer
    Dim sMeg As String
    Dim mrcc As ADODB.Recordset
    Dim MsgText As String
    Dim bYear As Integer
    Dim eYear As Integer
    Dim bDays As Integer
    Dim eDays As Integer
    Dim aDays As Integer
    Dim amMount As Double
    
    
    
    If Trim(txtItem(4) & " ") = "" Then
        MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
        txtItem(4).SetFocus
        Exit Sub
    End If
    
   
    If IsDate(txtItem(4)) Then
        txtItem(4) = Format(txtItem(4), "yyyy-mm-dd")
    Else
        MsgBox "入库时间应输入日期（yyyy-mm-dd）！", vbOKOnly + vbExclamation, "警告"
        txtItem(4).SetFocus
        Exit Sub
    End If
    
    
    '再加入新记录
    txtSQL = "select * from bookin where bookno = '" & Trim(txtNo) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    
    
        
    mrcc.Fields(6) = txtItem(5)
    mrcc.Fields(7) = txtItem(4)
    
    
    bYear = DatePart("yyyy", txtItem(2))
    eYear = DatePart("yyyy", txtItem(4))
    bDays = DatePart("y", txtItem(2))
    eDays = DatePart("y", txtItem(4))
    If bYear = eYear Then
        aDays = eDays - bDays
    Else
        aDays = (eYear - bYear - 1) * 365 + (365 - bDays) + eDays
    End If
    
    mrcc.Fields(8) = aDays * Trim(cboItem(3)) * Trim(txtItem(3)) / 100
    amMount = aDays * Trim(cboItem(3)) * Trim(txtItem(3)) / 100
    
    mrcc.Update
    mrcc.Close
    
    txtSQL = "select * from rooms where roomNO = '" & cboItem(0) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If Not mrcc.EOF Then
        mrcc!putup = " "
    End If
    mrcc.Update
    mrcc.Close
    If gintCmode = 1 Then
        Unload Me
        mblChange = False
        MsgBox "金额为" & amMount & "元，结算完毕！", vbOKOnly + vbExclamation, "添加结算信息"
        If flagCedit Then
            Unload frmCheckout
        End If
        frmCheckout.txtSQL = "select * from bookin where ammount <> '0'"
        frmCheckout.Show
        
    ElseIf gintCmode = 2 Then
        MsgBox "金额为" & amMount & "元，结算信息修改完毕！", vbOKOnly + vbExclamation, "修改结算信息"
        Unload Me
        If flagCedit Then
            Unload frmCheckout
        End If
        frmCheckout.txtSQL = "select * from bookin where ammount <> '0'"
        frmCheckout.Show
        
    End If
    
End Sub

Private Sub Form_Load()
    Dim sSql As String
    Dim intCount As Integer
    Dim MsgText As String
    
    
   
    If gintCmode = 1 Then
        Me.Caption = Me.Caption & "添加"
        
        '初始化物资名称
        txtSQL = "select DISTINCT roomno from bookin where ammount = '0'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            
                Do While Not mrc.EOF
                    cboItem(0).AddItem Trim(mrc!roomno)
                    mrc.MoveNext
                Loop
                
            
        Else
            MsgBox "没有顾客入住！", vbOKOnly + vbExclamation, "警告"
            cmdSave.Enabled = False
            Exit Sub
        End If
        
        
        mrc.Close
        
        
        
                
    ElseIf gintCmode = 2 Then
       
        
        
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If mrc.EOF = False Then
            With mrc
                txtNo = mrc.Fields(0)
                
                
                For intCount = 0 To 1
                    txtItem(intCount) = .Fields(intCount + 1)
                Next intCount
                
                cboItem(0).AddItem .Fields(3)
                cboItem(0).ListIndex = 0
                
                For intCount = 2 To 3
                    If Not IsNull(.Fields(intCount + 2)) Then
                        txtItem(intCount) = .Fields(intCount + 2)
                    End If
                Next intCount
                
                txtItem(5) = .Fields(6)
                txtItem(4) = .Fields(7)
            End With
            
        End If
        mrc.Close
        
        txtSQL = "select * from rooms where roomNO = '" & cboItem(0) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF = False Then
            With mrc
                For intCount = 1 To 3
                    cboItem(intCount).AddItem .Fields(intCount)
                    cboItem(intCount).ListIndex = 0
                Next intCount
            End With
        End If
        mrc.Close
        
        For intCount = 0 To 3
            txtItem(intCount).Enabled = False
        Next intCount
        
        
        Me.Caption = Me.Caption & "修改"
            
        
    End If
    
    mblChange = False
    
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    gintCmode = 0
End Sub





Private Sub txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
    
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
    
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
        EnterToTab KeyCode

End Sub