酒店行业

开发平台：
Visual Basic

frmCheckout1.frm：源码内容
							VERSION 5.00
Begin VB.Form frmCheckout1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "结算信息"
   ClientHeight    =   4596
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   7836
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4596
   ScaleWidth      =   7836
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame Frame2 
      Caption         =   "顾客信息"
      Height          =   2412
      Left            =   3960
      TabIndex        =   19
      Top             =   120
      Width           =   3735
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   4
         Left            =   1320
         MaxLength       =   10
         TabIndex        =   8
         Top             =   1920
         Width           =   2172
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   3
         Left            =   1320
         MaxLength       =   3
         TabIndex        =   7
         Top             =   1440
         Width           =   1572
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   2
         Left            =   1320
         MaxLength       =   10
         TabIndex        =   6
         Top             =   1080
         Width           =   2172
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   1
         Left            =   1320
         MaxLength       =   18
         TabIndex        =   5
         Top             =   720
         Width           =   2175
      End
      Begin VB.TextBox txtItem 
         Height          =   270
         Index           =   0
         Left            =   1320
         MaxLength       =   5
         TabIndex        =   4
         Top             =   360
         Width           =   2175
      End
      Begin VB.Label Label2 
         Caption         =   "结  帐  时 间："
         Height          =   252
         Index           =   2
         Left            =   240
         TabIndex        =   25
         Top             =   1920
         Width           =   972
      End
      Begin VB.Label Label2 
         Caption         =   "顾 客  姓 名："
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   24
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "身份证号码："
         Height          =   255
         Index           =   5
         Left            =   240
         TabIndex        =   23
         Top             =   720
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "折            扣："
         Height          =   252
         Index           =   6
         Left            =   240
         TabIndex        =   22
         Top             =   1440
         Width           =   972
      End
      Begin VB.Label Label2 
         Caption         =   "入 住 时 间："
         Height          =   252
         Index           =   11
         Left            =   240
         TabIndex        =   21
         Top             =   1080
         Width           =   972
      End
      Begin VB.Label Label2 
         Caption         =   "%"
         Height          =   252
         Index           =   8
         Left            =   3120
         TabIndex        =   20
         Top             =   1440
         Width           =   492
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "客房信息"
      Height          =   2412
      Left            =   120
      TabIndex        =   14
      Top             =   120
      Width           =   3735
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   0
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   0
         Top             =   480
         Width           =   2175
      End
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   1
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   960
         Width           =   2175
      End
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   2
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   1440
         Width           =   2175
      End
      Begin VB.ComboBox cboItem 
         Height          =   288
         Index           =   3
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   1920
         Width           =   2175
      End
      Begin VB.Label Label2 
         Caption         =   "客房位置："
         Height          =   255
         Index           =   16
         Left            =   240
         TabIndex        =   18
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "客房种类："
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   17
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "客房编号："
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   16
         Top             =   480
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "客房单价："
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   15
         Top             =   1920
         Width           =   975
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "备注信息"
      Height          =   1215
      Left            =   120
      TabIndex        =   13
      Top             =   2640
      Width           =   7575
      Begin VB.TextBox txtItem 
         Height          =   840
         Index           =   5
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Width           =   7332
      End
   End
   Begin VB.TextBox txtNo 
      Height          =   270
      Left            =   1320
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   4080
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "返回 (&X)"
      Height          =   375
      Left            =   4680
      TabIndex        =   11
      Top             =   4080
      Width           =   1215
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存 (&S)"
      Height          =   375
      Left            =   3240
      TabIndex        =   10
      Top             =   4080
      Width           =   1215
   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
    
    
    
    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

						