frmroommanage.frm

< SQL SERVER 2000 案例教程>>,冶金工业出版社,这本书的代码

            cmd.ActiveConnection = cnn
            cmd.CommandType = adCmdStoredProc
            cmd.CommandText = "Hotel_UpdateCustomRoom"
        
            cmd.Parameters.Append cmd.CreateParameter("@worksheet", adChar, adParamInput, 10)
            cmd.Parameters.Append cmd.CreateParameter("@room", adChar, adParamInput, 5)

            cmd.Parameters("@worksheet").Value = Label25.Caption   '工作单号
            cmd.Parameters("@room").Value = DataCombo1.Text       '要更换的房间号
                 
            cmd.Execute
            MsgBox "修改成功"
            Adodc2.Refresh
            DataGrid5.Refresh
            Adodc1.Refresh
            DataCombo1.Refresh
            
        
            Exit Sub
errHandle:
        MsgBox "Error: " + Err.Description
End If
End Sub

Private Sub DataGrid5_RowColChange(LastRow As Variant, ByVal LastCol As Integer) '取得当前记录的工作单号
        Label25.Caption = DataGrid5.Columns.Item(1)
        
        
End Sub


Private Sub dtlRoomLevel_Click()  '显示相应等级的可用客房
        GetValidRoom
End Sub

Private Sub Form_Load()
        strCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=sa;Initial Catalog=酒店客房管理系统;Data Source=127.0.0.1"
        cnn.Open strCnn
        ' 显示可用客房
       GetValidRoom
       
        
        If Adodc2.Recordset.RecordCount > 0 Then
            Label25.Caption = DataGrid5.Columns.Item(1)
        End If
        
        TimeBegin.Value = Now()
        TimeEnd.Value = Now()
        
End Sub

' 取得可用客房
Private Sub GetValidRoom()

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_GetValidRoom"
        
        cmd.Parameters.Append cmd.CreateParameter("@level", adVarChar, adParamInput, 100)
        cmd.Parameters.Append cmd.CreateParameter("@startTime", adDate, adParamInput)
        cmd.Parameters.Append cmd.CreateParameter("@endTime", adDate, adParamInput)
        
        cmd.Parameters("@level").Value = dtlRoomLevel.Text
        cmd.Parameters("@startTime").Value = TimeBegin.Value
        cmd.Parameters("@endTime").Value = TimeEnd.Value
        
        Set rs = cmd.Execute
        If rs.State = adStateClosed Then
                rs.Open
        End If
        'Set dtgRoom.DataSource = Nothing
        'dtgRoom.DataMember = ""
        Set MSHFlexGrid1.DataSource = rs
        
        ' 显示第一行REMARK
        If (MSHFlexGrid1.Rows > 0) Then
                txtRoomMemo.Text = MSHFlexGrid1.TextMatrix(1, 2)
        Else
                txtRoomMemo.Text = ""
        End If
        
        
        Exit Sub
errHandle:
        MsgBox Err.Description
        
End Sub

Private Sub Form_Unload(Cancel As Integer)
        cnn.Close
        Set cnn = Nothing

End Sub

Private Sub AppendOrder()  '添加预订工作单子函数，向工作单信息表“Hotel_WORKSHEET”添加一条记录

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_AddWorkSheet"
        
        cmd.Parameters.Append cmd.CreateParameter("@id", adChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@stage", adChar, adParamInput, 1)
        cmd.Parameters.Append cmd.CreateParameter("@recorder", adChar, adParamInput, 6)
        cmd.Parameters.Append cmd.CreateParameter("@remark", adVarChar, adParamInput, 1000)
        
        SheetOrder = GenerateOrderNO
        CustomNo = txtCardID.Text
        
        lblOrderNo.Caption = SheetOrder
        cmd.Parameters("@id").Value = SheetOrder ' 生成的表单号
        cmd.Parameters("@stage").Value = "0"     ' 预订
        ' 先默认为ADMIN, 最终设置用户管理
        cmd.Parameters("@recorder").Value = "A00001"  ' ADMIN
        cmd.Parameters("@remark").Value = ""
                
        cmd.Execute
        MsgBox "添加成功"
        Exit Sub
errHandle:
        SheetOrder = ""
        CustomNo = ""
        
        MsgBox Err.Description
        
End Sub

' 新建入住模式的订单, 向工作单信息表“Hotel_WORKSHEET”添加一条记录
Private Sub AppendInOrder()
        
        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_AddWorkSheet"
        
        cmd.Parameters.Append cmd.CreateParameter("@id", adChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@stage", adChar, adParamInput, 1)
        cmd.Parameters.Append cmd.CreateParameter("@recorder", adChar, adParamInput, 6)
        cmd.Parameters.Append cmd.CreateParameter("@remark", adVarChar, adParamInput, 1000)
        
        SheetOrder = GenerateOrderNO
        CustomNo = txtCardID.Text
        
        lblOrderNo.Caption = SheetOrder
        cmd.Parameters("@id").Value = SheetOrder ' 生成的表单号
        cmd.Parameters("@stage").Value = "1"     ' 入住
        ' 先默认为ADMIN, 最终设置用户管理
        cmd.Parameters("@recorder").Value = "A00001"  ' ADMIN
        cmd.Parameters("@remark").Value = ""
                
        cmd.Execute
        MsgBox "添加成功"
        Exit Sub
errHandle:
        SheetOrder = ""
        CustomNo = ""
        
        MsgBox Err.Description
        
End Sub

Private Function GenerateOrderNO() As String  '此子函数用于自动生成一个订单号
        Dim orderNo As String
        Dim count As Integer
        orderNo = ""
        count = 0
        
        Dim rs As Recordset
        Set rs = DataEnvironment1.rsCmdOrderCount
        If rs.State = adStateClosed Then
                rs.Open
        End If
        count = rs.RecordCount
        rs.Close
        
        orderNo = "000" + CStr(count)
        orderNo = Right(orderNo, 4)     ' 右4位
        orderNo = GetDate + orderNo
        GenerateOrderNO = orderNo
        'MsgBox orderNo
        
        
End Function

Private Function GetDate() As String
        Dim yy As String
        Dim mm As String
        Dim dd As String
        ' Dim strDate As String
        yy = Right(CStr(Year(Now)), 2)
        mm = CStr(Month(Now))
        If Len(mm) = 1 Then
                mm = "0" + mm
        End If
        dd = CStr(Day(Now))
        If Len(dd) = 1 Then
                dd = "0" + dd
        End If
                
        GetDate = yy + mm + dd
End Function

' 添加订单明细表
Private Sub AppendWorkSheetItem()

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_AddSheetItem"
        
        cmd.Parameters.Append cmd.CreateParameter("@worksheet", adChar, adParamInput, 10)
        cmd.Parameters.Append cmd.CreateParameter("@custom", adChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@room", adChar, adParamInput, 5)
        cmd.Parameters.Append cmd.CreateParameter("@mode", adChar, adParamInput, 1)
        cmd.Parameters.Append cmd.CreateParameter("@startTime", adDate, adParamInput)
        cmd.Parameters.Append cmd.CreateParameter("@endTime", adDate, adParamInput)
                
        ' validate SheetOrder | Custom
        ' 如果没有生成的表单号和CUSTOM, 则禁止添加按钮
        cmd.Parameters("@worksheet").Value = SheetOrder ' 生成的表单号
        cmd.Parameters("@custom").Value = CustomNo
        ' 从可用的客房列表中选择
    Dim row As Integer
    row = MSHFlexGrid1.row
    cmd.Parameters("@room").Value = MSHFlexGrid1.TextMatrix(row, 0)
        cmd.Parameters("@mode").Value = "0"     ' 预订
        cmd.Parameters("@startTime").Value = TimeBegin.Value
        cmd.Parameters("@endTime").Value = TimeEnd.Value
                
        cmd.Execute
        MsgBox "添加成功"

                
        'Set dtgOrderList.DataSource = Nothing
        'dtgOrderList.DataMember = ""
        'Set MSHFlexGrid2.DataSource = DataEnvironment1.rsCmdOrderCount
        'MSHFlexGrid2.Refresh
        
        Exit Sub
errHandle:
        MsgBox "Error: " + Err.Description
        
End Sub
' 添加入住订单明细表
Private Sub AppendInWorkSheetItem()

        On Error GoTo errHandle
        
        Dim cmd As New Command
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_AddSheetItem"
        
        cmd.Parameters.Append cmd.CreateParameter("@worksheet", adChar, adParamInput, 10)
        cmd.Parameters.Append cmd.CreateParameter("@custom", adChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@room", adChar, adParamInput, 5)
        cmd.Parameters.Append cmd.CreateParameter("@mode", adChar, adParamInput, 1)
        cmd.Parameters.Append cmd.CreateParameter("@startTime", adDate, adParamInput)
        cmd.Parameters.Append cmd.CreateParameter("@endTime", adDate, adParamInput)
                
        ' validate SheetOrder | Custom
        ' 如果没有生成的表单号和CUSTOM, 则禁止添加按钮
        cmd.Parameters("@worksheet").Value = SheetOrder ' 生成的表单号
        cmd.Parameters("@custom").Value = txtInID.Text
        
     Dim row As Integer
    row = MSHFlexGrid1.row
    cmd.Parameters("@room").Value = MSHFlexGrid1.TextMatrix(row, 0)
        
        cmd.Parameters("@mode").Value = "1"     ' 入住
        cmd.Parameters("@startTime").Value = TimeBegin.Value
        cmd.Parameters("@endTime").Value = TimeEnd.Value
                
        cmd.Execute
        MsgBox "添加成功"
                
        ' 显示订单
        Adodc3.Refresh
        FgInOrder.Refresh
        

        
        Exit Sub
errHandle:
        MsgBox "Error: " + Err.Description
        
End Sub

Private Sub MSHFlexGrid1_SelChange()
        Dim row As Integer
        row = MSHFlexGrid1.row
        If MSHFlexGrid1.TextMatrix(row, 2) <> "" Then
                txtRoomMemo.Text = MSHFlexGrid1.TextMatrix(row, 2)
        End If
End Sub



Private Sub SSTab1_Click(PreviousTab As Integer)
        If SSTab1.Tab = 2 Then
            Adodc1.Refresh
            DataCombo1.Refresh
            Adodc2.Refresh
            DataGrid5.Refresh
            If Adodc2.Recordset.RecordCount > 0 Then
                Label25.Caption = DataGrid5.Columns.Item(1)
            End If
        End If
        If SSTab1.Tab = 1 Then
            Adodc3.Refresh
            FgInOrder.Refresh
        End If
End Sub

Private Sub TimeBegin_Change() '取得相应时间段的可用客房
        GetValidRoom
End Sub


Private Sub TimeEnd_Click()  '取得相应时间段的可用客房
        GetValidRoom
End Sub

' 添加订单明细表
Private Sub ShowOrderList(workSheet As String)

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_GetOrderListByID"
        
        cmd.Parameters.Append cmd.CreateParameter("@worksheet", adChar, adParamInput, 10)
                
        ' validate SheetOrder | Custom
        cmd.Parameters("@worksheet").Value = workSheet '
                
        Set rs = cmd.Execute
        
        Set MSHFlexGrid2.DataSource = rs
        MSHFlexGrid2.Refresh
        
        Exit Sub
errHandle:
        MsgBox "Error: " + Err.Description
        
End Sub

' 显示已预定的订单
Private Sub ShowBookSheet()

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_GetBookSheet"
        
        cmd.Parameters.Append cmd.CreateParameter("@customID", adChar, adParamInput, 20)
                
        cmd.Parameters("@customID").Value = txtInID.Text
                
        Set rs = cmd.Execute
                        
        Set fgdtgInSheetList.DataSource = Nothing
        fgdtgInSheetList.DataMember = ""
        Set fgdtgInSheetList.DataSource = rs
        fgdtgInSheetList.Refresh
        
        Exit Sub
errHandle:
        MsgBox "Error: " + Err.Description
        
End Sub