frmroommanage.frm

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

            BackColor       =   &H80000005&
            BorderStyle     =   0  'None
            ForeColor       =   &H80000008&
            Height          =   735
            Left            =   300
            Picture         =   "frmRoomManage.frx":00F0
            ScaleHeight     =   735
            ScaleWidth      =   795
            TabIndex        =   49
            Top             =   180
            Width           =   795
         End
         Begin VB.CommandButton cmdDelRecord 
            Caption         =   "删除记录"
            Enabled         =   0   'False
            Height          =   375
            Left            =   6000
            TabIndex        =   4
            ToolTipText     =   "删除选定的预订单的订单细节"
            Top             =   360
            Width           =   1155
         End
         Begin VB.CommandButton cmdAppendRecord 
            Caption         =   "添加记录"
            Enabled         =   0   'False
            Height          =   375
            Left            =   4860
            TabIndex        =   3
            ToolTipText     =   "先选定要预订入住的时间和房间，然后单击按钮，即可为新建的预订单添加订单细节"
            Top             =   360
            Width           =   915
         End
         Begin VB.CommandButton cmdNewOrder 
            Caption         =   "新建订单"
            Height          =   375
            Left            =   1260
            Picture         =   "frmRoomManage.frx":0F9A
            TabIndex        =   2
            Top             =   360
            Width           =   1395
         End
         Begin VB.Label lblOrderNo 
            Height          =   315
            Left            =   3840
            TabIndex        =   57
            Top             =   420
            Width           =   1035
         End
         Begin VB.Label Label8 
            Caption         =   "订单编号:"
            Height          =   315
            Left            =   2880
            TabIndex        =   5
            Top             =   420
            Width           =   855
         End
      End
      Begin VB.Label Label25 
         Height          =   315
         Left            =   -68700
         TabIndex        =   45
         Top             =   780
         Width           =   1995
      End
      Begin VB.Label Label24 
         Caption         =   "工作单:"
         Height          =   255
         Left            =   -69900
         TabIndex        =   44
         Top             =   780
         Width           =   855
      End
      Begin VB.Label Label23 
         Caption         =   "可用客房:"
         Height          =   435
         Left            =   -74460
         TabIndex        =   43
         Top             =   780
         Width           =   855
      End
      Begin VB.Label Label20 
         Caption         =   "预订的订单列表:"
         Height          =   255
         Left            =   240
         TabIndex        =   30
         Top             =   3660
         Width           =   1575
      End
   End
End
Attribute VB_Name = "frmRoomManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' TO-DO LIST
' 1 FrmRoomManger 的 GenerateOrder问题, 格式问题
' 2 刷新datagrid的问题
' 3 用户权限管理, FrmRoomManger的添加Order的

Dim strCnn As String
Dim cnn As New Connection
Dim SheetOrder As String
Dim CustomNo As String

Dim mstream As ADODB.Stream     ' 方便存取SQL Server中的BLOB字段
Private strFileName As String       ' 证件复印图像文件


Private Sub cmdDelRecord_Click()  '预订表单中的删除记录
    Dim no As String
    On Error GoTo errHandle
        'no = MSHFlexGrid2.TextMatrix(FgOrder.RowSel, 1)
        
        Dim cmd As New Command
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_DelSheetItem"
        
        cmd.Parameters.Append cmd.CreateParameter("@worksheet", adChar, adParamInput, 10)
        cmd.Parameters.Append cmd.CreateParameter("@custom", adChar, adParamInput, 20)
  
        cmd.Parameters("@worksheet").Value = lblOrderNo.Caption  ' 表单号
        cmd.Parameters("@custom").Value = txtCardID
        
    
                
        cmd.Execute
        MsgBox "操作成功"
                
        MSHFlexGrid2.Clear
                
        Exit Sub

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

Private Sub CmdInAddCustom_Click()  '入住表单中的添加客户
        AppendInModeCustom
         '显示已预定的订单
        ShowBookSheet
End Sub

Private Sub Command1_Click() '清空
        Reset1
End Sub

Private Sub cmdAddCustom_Click() '添加客户
        
        ' validate
        AppendCustom
        
        If SheetOrder <> "" And CustomNo <> "" Then
                cmdAppendRecord.Enabled = True
                cmdDelRecord.Enabled = True
        End If
        
End Sub


Private Sub AppendCustom() '预订表单中添加客户的子函数

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_AddCustom"
        
        cmd.Parameters.Append cmd.CreateParameter("@id", adChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@cardDes", adVarChar, adParamInput, 100)
        cmd.Parameters.Append cmd.CreateParameter("@name", adVarChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@sex", adChar, adParamInput, 2)
        cmd.Parameters.Append cmd.CreateParameter("@native", adVarChar, adParamInput, 250)
        cmd.Parameters.Append cmd.CreateParameter("@address", adVarChar, adParamInput, 250)
        cmd.Parameters.Append cmd.CreateParameter("@cardCopy", adBinary, adParamInput, -1)
        cmd.Parameters.Append cmd.CreateParameter("@remark", adVarChar, adParamInput, 250)
        
        cmd.Parameters("@id").Value = txtCardID.Text
        cmd.Parameters("@cardDes").Value = cmbCardType.Text
        cmd.Parameters("@name").Value = txtName.Text
        If optMale.Value = True Then
                cmd.Parameters("@sex").Value = "男"
        Else
                cmd.Parameters("@sex").Value = "女"
        End If
        cmd.Parameters("@native").Value = txtNative.Text
        cmd.Parameters("@cardCopy").Value = Null
        cmd.Parameters("@address").Value = txtContact.Text
        cmd.Parameters("@remark").Value = txtRemark.Text
                
        cmd.Execute
        MsgBox "添加成功"
        Exit Sub
errHandle:
        MsgBox Err.Description
        
End Sub


Private Sub AppendInModeCustom() '入住表单中的添加客户子函数

        On Error GoTo errHandle
        
        Dim cmd As New Command
        Dim rs As New Recordset
        
        Set mstream = New ADODB.Stream
        mstream.Type = adTypeBinary
        mstream.Open
        mstream.LoadFromFile strFileName
        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_AddCustom"
        
        cmd.Parameters.Append cmd.CreateParameter("@id", adChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@cardDes", adVarChar, adParamInput, 100)
        cmd.Parameters.Append cmd.CreateParameter("@name", adVarChar, adParamInput, 20)
        cmd.Parameters.Append cmd.CreateParameter("@sex", adChar, adParamInput, 2)
        cmd.Parameters.Append cmd.CreateParameter("@native", adVarChar, adParamInput, 250)
        cmd.Parameters.Append cmd.CreateParameter("@address", adVarChar, adParamInput, 250)
        cmd.Parameters.Append cmd.CreateParameter("@cardCopy", adBinary, adParamInput, -1)
        cmd.Parameters.Append cmd.CreateParameter("@remark", adVarChar, adParamInput, 250)
        
        cmd.Parameters("@id").Value = txtInID.Text
        cmd.Parameters("@cardDes").Value = cmbInCardType.Text
        cmd.Parameters("@name").Value = txtInName.Text
        If optInM.Value = True Then
                cmd.Parameters("@sex").Value = "男"
        Else
                cmd.Parameters("@sex").Value = "女"
        End If
        cmd.Parameters("@native").Value = txtInNative.Text
        cmd.Parameters("@address").Value = txtInContact.Text

        If strFileName <> "" Or strFileName <> Null Then
                cmd.Parameters("@cardCopy").Value = mstream.Read
        Else
                cmd.Parameters("@cardCopy").Value = Nothing
        End If
        cmd.Parameters("@remark").Value = txtInRemark.Text
                
        cmd.Execute
        MsgBox "添加成功"
        Exit Sub
errHandle:
        MsgBox Err.Description
        
End Sub

Private Sub cmdAppendRecord_Click()  '预订表单中的添加记录，添加客房预订信息，即向工作单明细表“Hotel_WorkSheetItem”添加一条记录
        AppendWorkSheetItem
        ShowOrderList (SheetOrder)
End Sub

Private Sub cmdNewOrder_Click()  '预订表单中的新建订单，向工作单信息表“Hotel_WorkSheet”添加一条记录
        ' 生成表单号
        
        AppendOrder
        
        If SheetOrder <> "" And CustomNo <> "" Then
                cmdAppendRecord.Enabled = True
                cmdDelRecord.Enabled = True
        End If
End Sub

Private Sub cmdResetCustom_Click()  '清空
         Reset
        
End Sub

Private Sub Reset()  '预订表单中的情况子函数
        
        txtCardID.Text = ""
        cmbCardType.Text = ""
        txtName.Text = ""
        txtNative.Text = ""
        txtContact.Text = ""
        txtRemark.Text = ""
        
End Sub
Private Sub Reset1() '入住表单中的情况子函数
        
        txtInID.Text = ""
        cmbInCardType.Text = ""
        txtInName.Text = ""
        txtInNative.Text = ""
        txtInContact.Text = ""
        txtInRemark.Text = ""
        
End Sub

Private Sub Command2_Click() '上传复印件
        CommonDialog1.Filter = "位图图像(*.bmp)|*.bmp|其它图片(*.*)|*.*"
        CommonDialog1.ShowOpen
        strFileName = CommonDialog1.FileName
        picInCardCopy.Picture = LoadPicture(strFileName)


End Sub

Private Sub Command4_Click()  '应用订单，即把在“预订的订单列表”中选定的订单变成入住订单
    Dim no As String
    On Error GoTo errHandle
    If fgdtgInSheetList.TextMatrix(1, 0) <> "" Then
        no = fgdtgInSheetList.TextMatrix(fgdtgInSheetList.RowSel, 0)
               
        
        Dim cmd As New Command

        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_UpdateWorkSheet"
        
        cmd.Parameters.Append cmd.CreateParameter("@id", adChar, adParamInput, 10)
        cmd.Parameters.Append cmd.CreateParameter("@stage", adChar, adParamInput, 1)
  
        cmd.Parameters("@id").Value = no ' 表单号
        cmd.Parameters("@stage").Value = "1"
        
    
                
        cmd.Execute
        MsgBox "应用成功"
                
        ' 显示订单
        Adodc3.Refresh
        FgInOrder.Refresh
        

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

End Sub

Private Sub Command5_Click() '新建入住单，，向工作单信息表“Hotel_WorkSheet”添加一条记录
        AppendInOrder
End Sub

Private Sub Command6_Click()   '入住表单中的添加，添加入住订单细节，即向工作单明细表“Hotel_WorkSheetItem”添加一条记录，
        AppendInWorkSheetItem  '在单击添加按钮前必须先在“预订”表单中选定要入住的时间和房间
End Sub

Private Sub Command7_Click() '入住表单中的删除，删除此顾客的某条入住记录，即删除工作单明细表“Hotel_WorkSheetItem”中此顾客的某条入住记录
    Dim no As String
    On Error GoTo errHandle
    If FgInOrder.TextMatrix(1, 1) <> "" Then
        no = FgInOrder.TextMatrix(FgInOrder.RowSel, 1) '取得选定的工作单号
        
        Dim cmd As New Command

        
        cmd.ActiveConnection = cnn
        cmd.CommandType = adCmdStoredProc
        cmd.CommandText = "Hotel_DelSheetItem"
        
        cmd.Parameters.Append cmd.CreateParameter("@worksheet", adChar, adParamInput, 10)
        cmd.Parameters.Append cmd.CreateParameter("@custom", adChar, adParamInput, 20)
  
        cmd.Parameters("@worksheet").Value = no ' 工作单号
        cmd.Parameters("@custom").Value = txtInID.Text
        
    
                
        cmd.Execute
        MsgBox "操作成功"
                
        Adodc3.Refresh
        FgInOrder.Refresh
        

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




Private Sub DataCombo1_KeyPress(KeyAscii As Integer) '先在表中选定要更换房间的客户的订单，然后选定要更换的房间后按回车键，即可为客户更换房间
        If (KeyAscii = vbKeyReturn) Then

            On Error GoTo errHandle
        
            Dim cmd As New Command