setroomm.frm

星级酒店客房管理系统一套很不错的系统

      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   975
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   11535
      TabIndex        =   1
      Top             =   0
      Width           =   11535
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1 
      Bindings        =   "setroomm.frx":6F6E
      Height          =   5550
      Left            =   120
      TabIndex        =   0
      ToolTipText     =   "双击选择项，可直接弹出修改窗口！"
      Top             =   1080
      Width           =   7980
      _ExtentX        =   14076
      _ExtentY        =   9790
      _Version        =   393216
      FixedCols       =   0
      SelectionMode   =   1
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
      _Band(0).GridLinesBand=   1
      _Band(0).TextStyleBand=   0
      _Band(0).TextStyleHeader=   0
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   345
      Left            =   45
      Top             =   6270
      Visible         =   0   'False
      Width           =   1935
      _ExtentX        =   3413
      _ExtentY        =   609
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "setroomm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim Room(6) As Long
Private Sub roomcolor()
For i = 0 To Me.MSHFlexGrid1.Rows - 1
        
        Me.MSHFlexGrid1.Col = 7
        Me.MSHFlexGrid1.Row = i
        If Me.MSHFlexGrid1.Text = "空房" Then
            For j = 0 To Me.MSHFlexGrid1.Cols - 1
                Me.MSHFlexGrid1.Col = j
                Me.MSHFlexGrid1.Row = i
                Me.MSHFlexGrid1.CellBackColor = &HFF00&
            Next
        ElseIf Me.MSHFlexGrid1.Text = "脏房" Then
            For j = 0 To Me.MSHFlexGrid1.Cols - 1
                Me.MSHFlexGrid1.Col = j
                Me.MSHFlexGrid1.Row = i
                Me.MSHFlexGrid1.CellBackColor = &H80000010
            Next
        ElseIf Me.MSHFlexGrid1.Text = "维修房" Then
            For j = 0 To Me.MSHFlexGrid1.Cols - 1
                Me.MSHFlexGrid1.Col = j
                Me.MSHFlexGrid1.Row = i
                Me.MSHFlexGrid1.CellBackColor = &HC0C000
            Next
        ElseIf Me.MSHFlexGrid1.Text = "售出" Then
            For j = 0 To Me.MSHFlexGrid1.Cols - 1
                Me.MSHFlexGrid1.Col = j
                Me.MSHFlexGrid1.Row = i
                Me.MSHFlexGrid1.CellBackColor = &H80FF&
            Next
        ElseIf Me.MSHFlexGrid1.Text = "上锁" Then
            For j = 0 To Me.MSHFlexGrid1.Cols - 1
                Me.MSHFlexGrid1.Col = j
                Me.MSHFlexGrid1.Row = i
                Me.MSHFlexGrid1.CellBackColor = &H8000000D
            Next
        ElseIf Me.MSHFlexGrid1.Text = "预订" Then
            For j = 0 To Me.MSHFlexGrid1.Cols - 1
                Me.MSHFlexGrid1.Col = j
                Me.MSHFlexGrid1.Row = i
                Me.MSHFlexGrid1.CellBackColor = &H8080FF
            Next
        End If
    Next
End Sub

Private Sub Command1_Click()
    RoomForm_Type = "增加"
    setroom1.Show 1
    Adodc1.Refresh
    Me.MSHFlexGrid1.Refresh
    roomcolor
End Sub

Private Sub Command2_Click()
    Me.MSHFlexGrid1.Col = 0
    RoomNO = Me.MSHFlexGrid1.Text
    RoomForm_Type = "修改"
    setroom1.Show 1
    Adodc1.Refresh
    Me.MSHFlexGrid1.Refresh
    roomcolor
End Sub

Private Sub Command3_Click()
    Me.MSHFlexGrid1.Col = 0
    RoomNO = Me.MSHFlexGrid1.Text
    Adodc1.Recordset.Delete
    Adodc1.Recordset.Update
    Adodc1.Refresh
    Me.MSHFlexGrid1.Refresh

End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Command5_Click()
 On Error GoTo err13
    Dim List_item As ListItem
    Dim i As Integer
    If Me.Text2.Text <> "" Then
        Adodc1.ConnectionString = My_PROVIDER
        Adodc1.CommandType = adCmdText
        Adodc1.RecordSource = "select * from 客房 where 楼号 like '" & Me.Text1.Text & "' and 层 like '" & Me.Text2.Text & "'"
        Adodc1.Refresh
    Else
        Adodc1.ConnectionString = My_PROVIDER
        Adodc1.CommandType = adCmdText
        Adodc1.RecordSource = "select * from 客房 where 楼号 like '" & Me.Text1.Text & "'"
        Adodc1.Refresh
    End If
    For i = 0 To 5
        Room(i) = 0
    Next
    While Not Adodc1.Recordset.EOF
        Select Case Adodc1.Recordset.Fields("当前状态")
        Case "空房"
            Room(0) = Room(0) + 1
        Case "脏房"
            Room(1) = Room(1) + 1
        Case "维修房"
            Room(2) = Room(2) + 1
        Case "售出"
            Room(3) = Room(3) + 1
        Case "预订"
            Room(4) = Room(4) + 1
        Case "上锁"
            Room(4) = Room(5) + 1
        Case Else
        End Select
        Adodc1.Recordset.MoveNext
        
    Wend
    
    Me.Label7.Caption = "空房：" & CStr(Room(0))
    Me.Label8.Caption = "脏房：" & CStr(Room(1))
    Me.Label9.Caption = "维修房：" & CStr(Room(2))
    Me.Label10.Caption = "售出：" & CStr(Room(3))
    Me.Label11.Caption = "预订：" & CStr(Room(4))
    Me.Label12.Caption = "合计：" & CStr(Room(0) + Room(1) + Room(2) + Room(3) + Room(4))
    roomcolor
    Exit Sub
    
err13:
    MsgBox "操作错误,错误代码1013", 48, "提示"
End Sub

Private Sub Command6_Click()
On Error GoTo err14
    Dim List_item As ListItem
    Dim i As Long
    
    If Me.Option3 Then
        Adodc1.RecordSource = "select * from 客房 where 类型 like '" & Me.Combo1.Text & "'"
        Adodc1.Refresh
    Else
        Adodc1.RecordSource = "select * from 客房 where 当前状态 like '" & Me.Combo1.Text & "'"
        Adodc1.Refresh
    End If
    For i = 0 To 5
        Room(i) = 0
    Next
    While Not Adodc1.Recordset.EOF
        Select Case Adodc1.Recordset.Fields("当前状态")
        Case "空房"
            Room(0) = Room(0) + 1
        Case "脏房"
            Room(1) = Room(1) + 1
        Case "维修房"
            Room(2) = Room(2) + 1
        Case "售出"
            Room(3) = Room(3) + 1
        Case "预订"
            Room(4) = Room(4) + 1
        Case "上锁"
            Room(4) = Room(5) + 1
        Case Else
        End Select
        Adodc1.Recordset.MoveNext
        
    Wend
    Me.Label7.Caption = "空房：" & CStr(Room(0))
    Me.Label8.Caption = "脏房：" & CStr(Room(1))
    Me.Label9.Caption = "维修房：" & CStr(Room(2))
    Me.Label10.Caption = "售出：" & CStr(Room(3))
    Me.Label11.Caption = "预订：" & CStr(Room(4))
    Me.Label12.Caption = "合计：" & CStr(Room(0) + Room(1) + Room(2) + Room(3) + Room(4))
    
roomcolor
    Exit Sub
    
err14:
    MsgBox "操作错误,错误代码1014", 48, "提示"
End Sub

Private Sub Form_Load()
    Dim i, j As Integer
    
    If PIC_load Then
        Me.Picture1.Picture = LoadPicture(App.Path & "\pic\pic0001.jpg")
    End If
    '调整窗口位置
    Me.Left = MDIForm1.Picture1.Width
    Me.Top = (MDIForm1.Height - Me.Height) / 2
    
    Adodc1.ConnectionString = My_PROVIDER
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from 客房 order by 房号"
    Adodc1.Refresh
    
    Set Me.MSHFlexGrid1.DataSource = Adodc1
    Me.MSHFlexGrid1.Refresh
    For i = 0 To 5
        Room(i) = 0
    Next
    Adodc1.Recordset.MoveFirst
    While Not Adodc1.Recordset.EOF
        Select Case Adodc1.Recordset.Fields("当前状态")
        Case "空房"
            Room(0) = Room(0) + 1
        Case "脏房"
            Room(1) = Room(1) + 1
        Case "维修房"
            Room(2) = Room(2) + 1
        Case "售出"
            Room(3) = Room(3) + 1
        Case "预订"
            Room(4) = Room(4) + 1
         Case "上锁"
            Room(4) = Room(5) + 1
        Case Else
        End Select
        Adodc1.Recordset.MoveNext
    Wend
    Adodc1.Recordset.MoveFirst
    Me.Label7.Caption = "空房：" & CStr(Room(0))
    Me.Label8.Caption = "脏房：" & CStr(Room(1))
    Me.Label9.Caption = "维修房：" & CStr(Room(2))
    Me.Label10.Caption = "售出：" & CStr(Room(3))
    Me.Label11.Caption = "预订：" & CStr(Room(4))
    Me.Label2.Caption = "上锁：" & CStr(Room(5))
    Me.Label12.Caption = "合计：" & CStr(Room(0) + Room(1) + Room(2) + Room(3) + Room(4))
    
    roomcolor
    
End Sub

Private Sub MSHFlexGrid1_Click()
Dim homeNo As Integer
homeNo = MSHFlexGrid1.Text
Adodc2.ConnectionString = My_PROVIDER
    Adodc2.CommandType = adCmdText
    Adodc2.RecordSource = "select * from 客房 where 房号 like '" & homeNo & "'"
    Adodc2.Refresh
    
    Me.Text6.Text = Adodc2.Recordset.Fields("床位数") - Adodc2.Recordset.Fields("住客")
    Me.Text4.Text = IIf(IsNull(Adodc2.Recordset.Fields("床位数")), 0, Adodc2.Recordset.Fields("床位数"))
    Me.Text5.Text = IIf(IsNull(Adodc2.Recordset.Fields("类型")), "", Adodc2.Recordset.Fields("类型"))
    Me.Text3.Text = IIf(IsNull(Adodc2.Recordset.Fields("出售方式")), "", Adodc2.Recordset.Fields("出售方式"))
End Sub

Private Sub MSHFlexGrid1_DblClick()
    Me.MSHFlexGrid1.Col = 0
    RoomNO = Me.MSHFlexGrid1.Text
    RoomForm_Type = "修改"
    setroom1.Show 1
    Adodc1.Refresh
    Me.MSHFlexGrid1.Refresh
    roomcolor
End Sub

Private Sub Option1_Click()
   Me.Frame4.Visible = True
    Me.Frame3.Visible = False
    Me.Text1.SetFocus
End Sub

Private Sub Option2_Click()
    On Error GoTo err20
    
    Me.Combo1.Clear
    Me.Frame4.Visible = False
    Me.Frame3.Visible = True
    
    Adodc2.ConnectionString = My_PROVIDER
    Adodc2.CommandType = adCmdText
    Adodc2.RecordSource = "select * from 房间状态"
    Adodc2.Refresh
    If Adodc2.Recordset.RecordCount > 0 Then
        While Not Adodc2.Recordset.EOF
            Me.Combo1.AddItem Adodc2.Recordset.Fields("房间状态")
            Adodc2.Recordset.MoveNext
        Wend
    End If

    Exit Sub
    
err20:
    MsgBox "操作错误,错误代码1020", 48, "提示"
End Sub

Private Sub Option3_Click()
On Error GoTo err21

    Me.Combo1.Clear
    Me.Frame4.Visible = False
    Me.Frame3.Visible = True
    Adodc2.ConnectionString = My_PROVIDER
    Adodc2.CommandType = adCmdText
    Adodc2.RecordSource = "select * from 项目编码 where 编码 like 'FL%' order by 名称"
    Adodc2.Refresh
    While Not Adodc2.Recordset.EOF
        Me.Combo1.AddItem Adodc2.Recordset.Fields("名称")
        If Adodc2.Recordset.Fields("首选项") = "是" Then
            Me.Combo1.Text = Adodc2.Recordset.Fields("名称")
        End If
        Adodc2.Recordset.MoveNext
    Wend
    Exit Sub
    
err21:
    MsgBox "操作错误,错误代码1021", 48, "提示"
End Sub

Private Sub Option4_Click()
   On Error GoTo err22

    Dim List_item As ListItem
    Me.Frame4.Visible = False
    Me.Frame3.Visible = False
     Adodc1.ConnectionString = My_PROVIDER
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from 客房 order by 房号"
    Adodc1.Refresh
 
    For i = 0 To 5
        Room(i) = 0
    Next
    While Not Adodc1.Recordset.EOF
        Select Case Adodc1.Recordset.Fields("当前状态")
        Case "空房"
           
            Room(0) = Room(0) + 1
        Case "脏房"
          
            Room(1) = Room(1) + 1
        Case "维修房"
          
            Room(2) = Room(2) + 1
        Case "售出"
          
            Room(3) = Room(3) + 1
        Case "预订"
         
            Room(4) = Room(4) + 1
        Case Else
        End Select
        Adodc1.Recordset.MoveNext
        
    Wend
    Me.Label7.Caption = "空房：" & CStr(Room(0))
    Me.Label8.Caption = "脏房：" & CStr(Room(1))
    Me.Label9.Caption = "维修房：" & CStr(Room(2))
    Me.Label10.Caption = "售出：" & CStr(Room(3))
    Me.Label11.Caption = "预订：" & CStr(Room(4))
    Me.Label12.Caption = "合计：" & CStr(Room(0) + Room(1) + Room(2) + Room(3) + Room(4))
    roomcolor
    Exit Sub
    
err22:
    MsgBox "操作错误,错误代码1022", 48, "提示"

End Sub