frmcustomsearch.frm

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

         Height          =   375
         Left            =   8460
         TabIndex        =   8
         ToolTipText     =   "输入客房号后按回车键，即可按客房号查询客户"
         Top             =   420
         Width           =   1575
      End
      Begin VB.TextBox txtNative 
         Height          =   375
         Left            =   5820
         TabIndex        =   6
         ToolTipText     =   "输入来源地后按回车键，即可按来源地查询客户"
         Top             =   420
         Width           =   1815
      End
      Begin VB.TextBox txtName 
         Height          =   375
         Left            =   3000
         TabIndex        =   4
         ToolTipText     =   "输入姓名后按回车键，即可按姓名查询客户"
         Top             =   420
         Width           =   1935
      End
      Begin VB.TextBox txtID 
         Height          =   375
         Left            =   780
         TabIndex        =   2
         ToolTipText     =   "输入证件号后按回车键，即可按证件号查询客户"
         Top             =   420
         Width           =   1575
      End
      Begin VB.Label Label4 
         Caption         =   "客房号:"
         Height          =   315
         Left            =   7800
         TabIndex        =   7
         Top             =   480
         Width           =   735
      End
      Begin VB.Label Label3 
         Caption         =   "来源地:"
         Height          =   315
         Left            =   5040
         TabIndex        =   5
         Top             =   480
         Width           =   675
      End
      Begin VB.Label Label2 
         Caption         =   "姓名:"
         Height          =   315
         Left            =   2520
         TabIndex        =   3
         Top             =   480
         Width           =   615
      End
      Begin VB.Label Label1 
         Caption         =   "证件号:"
         Height          =   315
         Left            =   180
         TabIndex        =   1
         Top             =   480
         Width           =   735
      End
   End
   Begin VB.Label Label14 
      Caption         =   "入住情况:"
      Height          =   255
      Left            =   4860
      TabIndex        =   27
      Top             =   1440
      Width           =   1095
   End
   Begin VB.Label Label5 
      Caption         =   "客户列表:"
      Height          =   255
      Left            =   180
      TabIndex        =   9
      Top             =   1380
      Width           =   1155
   End
End
Attribute VB_Name = "frmCustomSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strCnn As String
Dim cnn As New Connection

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
End Sub

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

'查询
'在四个条件输入框中按回车键，程序即会根据此输入的条件进行查询，将记录分别显示出来。
' 响应回车键开始查询
Private Sub TxtID_KeyPress(KeyAscii As Integer)  '证件号
        If (KeyAscii = vbKeyReturn) Then
                SearchID
        End If
End Sub

Private Sub TxtName_KeyPress(KeyAscii As Integer) '姓名
        If (KeyAscii = vbKeyReturn) Then
                SearchName
        End If
End Sub

Private Sub TxtNative_KeyPress(KeyAscii As Integer) '来源地
        If (KeyAscii = vbKeyReturn) Then
                SearchNative
        End If
End Sub

Private Sub TxtRoomNo_KeyPress(KeyAscii As Integer) '客房号
        If (KeyAscii = vbKeyReturn) Then
                SearchRoomNo
        End If
End Sub


' 根据证件号查询，并显示符合条件的客户列表
Private Sub SearchID()
        On Error GoTo errHandle
        Dim strSql As String
        strSql = ""
       ' 模糊查找
        strSql = "SELECT ID as 证件号码 FROM Hotel_Custom WHERE ID LIKE '%" + Trim(txtID.Text) + "%'"
        
        Dim rs As New Recordset
        With rs
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .Open strSql
        End With
        
        ' 如找到
        If (rs.RecordCount > 0) Then
                ' 显示客户列表
                Set Adodc1.Recordset = rs
                Set MSHFlexGrid1.DataSource = Nothing
                MSHFlexGrid1.DataMember = ""
                Set MSHFlexGrid1.DataSource = Adodc1
                MSHFlexGrid1.Refresh
        Else
                MsgBox "查无记录!"
        End If
        Exit Sub
errHandle:
        MsgBox Err.Description
End Sub

' 根据姓名查询，并显示符合条件的客户列表
Private Sub SearchName()
        On Error GoTo errHandle
        Dim strSql As String
        strSql = ""
       ' 模糊查找
        strSql = "SELECT ID as 证件号码,Name as 客户姓名 FROM Hotel_Custom WHERE Name LIKE '%" + Trim(txtName.Text) + "%'"
        
        Dim rs As New Recordset
        With rs
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .Open strSql
        End With
        
        ' 如找到
        If (rs.RecordCount > 0) Then
                ' 显示客户列表
                Set Adodc1.Recordset = rs
                Set MSHFlexGrid1.DataSource = Nothing
                MSHFlexGrid1.DataMember = ""
                Set MSHFlexGrid1.DataSource = Adodc1
                MSHFlexGrid1.Refresh
        Else
                MsgBox "查无记录!"
        End If
        Exit Sub
errHandle:
        MsgBox Err.Description
End Sub


' 根据来源地查询，并显示符合条件的客户列表
Private Sub SearchNative()
        On Error GoTo errHandle
        Dim strSql As String
        strSql = ""
       ' 模糊查找
        strSql = "SELECT ID as 证件号码,Native as 来源地 FROM Hotel_Custom WHERE native LIKE '%" + Trim(txtNative.Text) + "%'"
        
        Dim rs As New Recordset
        With rs
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .Open strSql
        End With
        
        ' 如找到
        If (rs.RecordCount > 0) Then
                ' 显示客户列表
                Set Adodc1.Recordset = rs
                Set MSHFlexGrid1.DataSource = Nothing
                MSHFlexGrid1.DataMember = ""
                Set MSHFlexGrid1.DataSource = Adodc1
                MSHFlexGrid1.Refresh
        Else
                MsgBox "查无记录!"
        End If
        Exit Sub
errHandle:
        MsgBox Err.Description
End Sub

' 根据客房号查询，并显示符合条件的客户列表
Private Sub SearchRoomNo()
        On Error GoTo errHandle
        Dim strSql As String
        strSql = ""
       ' 模糊查找
        strSql = "SELECT custom as 证件号码,room as 客房号 FROM Hotel_WorkSheetItem WHERE room LIKE '%" + Trim(txtRoomNo.Text) + "%'"
        
        Dim rs As New Recordset
        With rs
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .Open strSql
        End With
        
        ' 如找到
        If (rs.RecordCount > 0) Then
                ' 显示客户列表
                Set Adodc1.Recordset = rs
                Set MSHFlexGrid1.DataSource = Nothing
                MSHFlexGrid1.DataMember = ""
                Set MSHFlexGrid1.DataSource = Adodc1
                MSHFlexGrid1.Refresh
        Else
                MsgBox "查无记录!"
        End If
        Exit Sub
errHandle:
        MsgBox Err.Description
End Sub

' 再根据查询出来的客户列表（在MSHFlexGrid1中），逐一浏览查看其详细信息
Private Sub MSHFlexGrid1_Click()
        ShowList            ' 显示此记录的详细信息
        showRecord          ' 显示此客户的入住记录
End Sub

'显示此记录的详细信息。
Private Sub ShowList()
        On Error GoTo errHandle
        Dim strSql As String
        strSql = ""
        strSql = "SELECT Hotel_Custom.id, Hotel_Custom.name, Code_IDType.description, Hotel_Custom.sex, Hotel_Custom.native, Hotel_Custom.address, Hotel_Custom.CardCopy , Hotel_Custom.remark FROM Hotel_Custom INNER JOIN Code_IDType ON Hotel_Custom.id_type = Code_IDType.code WHERE id='" + MSHFlexGrid1.TextMatrix(MSHFlexGrid1.row, 0) + "'"
        Dim rs As New Recordset
        With rs
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .Open strSql
        End With
        ' 如找到
        If (rs.RecordCount > 0) Then
                LblCardID.Caption = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.row, 0)
                cmbCardType.Text = rs("description").Value
                txtContact.Text = rs("address").Value
                LblName.Caption = rs("name").Value
                If (rs("sex").Value = "男") Then
                        OptM.Value = True
                Else
                        OptF.Value = True
                End If
                txtNative2.Text = rs("native").Value
                txtMemo.Text = rs("remark").Value
                Picture1.Picture = Nothing
                ' 显示图片
                If Not IsNull(rs("cardCopy").Value) Then
                        Dim c As New ADODB.Stream
                        Set c = New ADODB.Stream
                        c.Mode = adModeReadWrite
                        c.Type = adTypeBinary
                        c.Open
                        c.Write rs("cardCopy").Value
                        c.SaveToFile "temp", adSaveCreateOverWrite
                        Picture1.Picture = LoadPicture("temp")
                End If
        Else
                MsgBox "查无记录！"
        End If
        Exit Sub
errHandle:
        MsgBox Err.Description
End Sub

'显示入住情况（历史）。
Private Sub showRecord()
        On Error GoTo errHandle
        Dim strSql As String
        Dim Customer As String
        Customer = Trim(MSHFlexGrid1.TextMatrix(MSHFlexGrid1.row, 0))
        strSql = ""
        strSql = "SELECT Hotel_WorkSheetItem.room AS 客房,Code_MoveInMode.descript AS 方式,Hotel_WorkSheetItem.startTime AS 起始时间,Hotel_WorkSheetItem.endTime AS 结束时间 FROM Hotel_WorkSheetItem INNER JOIN Code_MoveInMode ON Hotel_WorkSheetItem.Mode = Code_MoveInMode.code WHERE Hotel_WorkSheetItem. custom = '" + Customer + "'"
        Dim rs As New Recordset
        With rs
                .ActiveConnection = cnn
                .CursorLocation = adUseClient
                .Open strSql
        End With
        ' 如找到
        Set DtgMoveIn.DataSource = Nothing
        DtgMoveIn.DataMember = ""
        DtgMoveIn.ClearFields
        DtgMoveIn.Refresh
        If (rs.RecordCount > 0) Then
                Set Adodc2.Recordset = rs

                Set DtgMoveIn.DataSource = Adodc2
                DtgMoveIn.Refresh
        End If
        Exit Sub
errHandle:
        MsgBox Err.Description
End Sub