frmcheckout1.frm

宾馆管理信息系统

VERSION 5.00
Begin VB.Form frmCheckout1 
   BackColor       =   &H00C0C0FF&
   Caption         =   "结算信息"
   ClientHeight    =   5070
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7635
   LinkTopic       =   "Form9"
   ScaleHeight     =   5070
   ScaleWidth      =   7635
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtNo 
      Height          =   375
      Left            =   1440
      TabIndex        =   22
      Top             =   4560
      Width           =   855
   End
   Begin VB.CommandButton cmdSave 
      BackColor       =   &H00C0C0FF&
      Caption         =   "保存(&S)"
      Height          =   375
      Left            =   3360
      Style           =   1  'Graphical
      TabIndex        =   21
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton cmdExit 
      BackColor       =   &H00C0C0FF&
      Caption         =   "返回(&X)"
      Height          =   375
      Left            =   5040
      Style           =   1  'Graphical
      TabIndex        =   20
      Top             =   4560
      Width           =   1215
   End
   Begin VB.Frame Frame3 
      BackColor       =   &H00C0C0FF&
      Caption         =   "备注信息"
      Height          =   1215
      Left            =   360
      TabIndex        =   19
      Top             =   3120
      Width           =   6975
      Begin VB.TextBox txtItem 
         BackColor       =   &H00C0C0C0&
         Height          =   855
         Index           =   5
         Left            =   240
         TabIndex        =   25
         Top             =   240
         Width           =   6615
      End
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H00C0C0FF&
      Caption         =   "顾客信息："
      Height          =   2655
      Left            =   3960
      TabIndex        =   9
      Top             =   240
      Width           =   3375
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   4
         Left            =   1320
         TabIndex        =   24
         Top             =   2280
         Width           =   1815
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   0
         Left            =   1320
         TabIndex        =   13
         Top             =   360
         Width           =   1815
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   1
         Left            =   1320
         TabIndex        =   12
         Top             =   840
         Width           =   1815
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   2
         Left            =   1320
         TabIndex        =   11
         Top             =   1320
         Width           =   1815
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   3
         Left            =   1320
         TabIndex        =   10
         Top             =   1800
         Width           =   1455
      End
      Begin VB.Label Label5 
         BackColor       =   &H00C0C0FF&
         Caption         =   "结算 时间："
         Height          =   255
         Left            =   120
         TabIndex        =   23
         Top             =   2280
         Width           =   1095
      End
      Begin VB.Label Label6 
         BackColor       =   &H00C0C0FF&
         Caption         =   "顾客 姓名："
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label7 
         BackColor       =   &H00C0C0FF&
         Caption         =   "身份证号码："
         Height          =   255
         Left            =   120
         TabIndex        =   17
         Top             =   840
         Width           =   1095
      End
      Begin VB.Label Label8 
         BackColor       =   &H00C0C0FF&
         Caption         =   "入住 时间："
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   1320
         Width           =   1095
      End
      Begin VB.Label Label9 
         BackColor       =   &H00C0C0FF&
         Caption         =   "折    扣："
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   1800
         Width           =   975
      End
      Begin VB.Label Label11 
         BackColor       =   &H00C0C0FF&
         Caption         =   "%"
         Height          =   255
         Left            =   2880
         TabIndex        =   14
         Top             =   1800
         Width           =   255
      End
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0C0FF&
      Caption         =   "客房信息"
      Height          =   2655
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   3255
      Begin VB.ComboBox cboItem 
         Height          =   300
         Index           =   0
         Left            =   1080
         TabIndex        =   4
         Top             =   480
         Width           =   1935
      End
      Begin VB.ComboBox cboItem 
         Height          =   300
         Index           =   1
         Left            =   1080
         TabIndex        =   3
         Top             =   1080
         Width           =   1935
      End
      Begin VB.ComboBox cboItem 
         Height          =   300
         Index           =   2
         Left            =   1080
         TabIndex        =   2
         Top             =   1680
         Width           =   1935
      End
      Begin VB.ComboBox cboItem 
         Height          =   300
         Index           =   3
         Left            =   1080
         TabIndex        =   1
         Top             =   2160
         Width           =   1935
      End
      Begin VB.Label Label1 
         BackColor       =   &H00C0C0FF&
         Caption         =   "客房编号："
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   480
         Width           =   975
      End
      Begin VB.Label Label2 
         BackColor       =   &H00C0C0FF&
         Caption         =   "客房种类："
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   1080
         Width           =   975
      End
      Begin VB.Label Label3 
         BackColor       =   &H00C0C0FF&
         Caption         =   "客房位置："
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   1680
         Width           =   975
      End
      Begin VB.Label Label4 
         BackColor       =   &H00C0C0FF&
         Caption         =   "客房单价："
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   2160
         Width           =   975
      End
   End
End
Attribute VB_Name = "frmCheckout1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String
Private Sub cboItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
End Sub
Private Sub cboItem_Click(Index As Integer)
    Dim sSql As String
    Dim MsgText As String
    Dim mrcc As ADODB.Recordset
    Dim intCount As Integer
    If gintCmode = 1 Then
        '初始化员工名称和ID
        If Index = 0 Then
            cboItem(1).Enabled = True
            cboItem(2).Enabled = True
            cboItem(3).Enabled = True
            cboItem(1).Clear
            cboItem(2).Clear
            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
    txtItem(4) = Date
    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
   ' txtItem(4) = 10
    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
     cboItem(0).Enabled = False
       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 If
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