VB课程设计报告 酒店管理系统

《VB课程设计》报告

  题目:酒店管理系统

班    级:       建环1241        

学    号:         35            

姓    名:               

指导老师:               

实习日期: 20##-6-24至20##-6-28           

目    录

课程设计目的和意义…………………………2

所需环境………………………………………2

总体设计思路…………………………………3

各部分设计功能介绍…………………………4

程序清单………………………………………7

课程设计总结………………………………18

教师评语……………………………………19

一、课程设计目的和意义

 通过VB课程设计,巩固加深VB理论知识,使理论和实践相结合。培养学生对VB应用系统开发设计能力;提高学生对VB知识的综合运用能力;增强学生程序设计能力,提高学生实际上机调试程序的动手能力。使学生对VB软件开发有一个总体认识,使学生得到很好的锻炼,为以后的学习、工作打下坚实的基础。

二、所需环境

   硬件环境:校内机房微机

   软件环境:Windows xp, VB6.0

三、总体设计思路(功能模块图)

组织结构图

四、各部分设计功能介绍、设计界面(抓图)1 登录界面

2主界面

3客人查询界面

4值班管理

5输入客人资料

6新增用户

五、程序清单

新增用户代码:

Private Sub Command1_Click()

Dim sql As String

Dim rs_add As New ADODB.Recordset

If Trim(Text1.Text) = "" Then

   MsgBox "用户名不能为空", vbOKOnly + vbExclamation, ""

   Exit Sub

   Text1.SetFocus

Else

   sql = "select * from 系统管理"

   rs_add.Open sql, conn, adOpenKeyset, adLockPessimistic

   While (rs_add.EOF = False)

        If Trim(rs_add.Fields(0)) = Trim(Text1.Text) Then

           MsgBox "已有这个用户", vbOKOnly + vbExclamation, ""

           Text1.SetFocus

           Text1.Text = ""

           Text2.Text = ""

           Text3.Text = ""

           Combo1.Text = ""

           Exit Sub

         Else

           rs_add.MoveNext

         End If

    Wend

     If Trim(Text2.Text) = "" Then

         MsgBox "密码不能为空,请重新输入!", vbOKOnly + vbExclamation, "警告"

         Text2.Text = ""

         Text2.SetFocus

         Exit Sub

    End If

    If Trim(Text2.Text) <> Trim(Text3.Text) Then

       MsgBox "两次密码不一致", vbOKOnly + vbExclamation, ""

       Text2.SetFocus

       Text2.Text = ""

       Text3.Text = ""

       Exit Sub

    ElseIf Trim(Combo1.Text) <> "system" And Trim(Combo1.Text) <> "guest" Then

       MsgBox "请选择正确的用户权限", vbOKOnly + vbExclamation, ""

       Combo1.SetFocus

       Combo1.Text = ""

       Exit Sub

    Else

       rs_add.AddNew

       rs_add.Fields(0) = Text1.Text

       rs_add.Fields(1) = Text2.Text

       rs_add.Fields(2) = Combo1.Text

       rs_add.Update

       rs_add.Close

       MsgBox "添加用户成功", vbOKOnly + vbExclamation, ""

       Unload Me

    End If

End If

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Load()

Combo1.AddItem "system"

Combo1.AddItem "guest"

End Sub

密码修改代码

Private Sub Command1_Click()

Dim rs_chang As New ADODB.Recordset

Dim sql As String

If Trim(Text1.Text) <> Trim(Text2.Text) Then

   MsgBox "密码不一致!", vbOKOnly + vbExclamation, ""

   Text1.SetFocus

   Text1.Text = ""

   Text2.Text = ""

Else

   sql = "select * from 系统管理 where 用户名='" & userID & "'"

   rs_chang.Open sql, conn, adOpenKeyset, adLockPessimistic

   rs_chang.Fields(1) = Text1.Text

   rs_chang.Update

   rs_chang.Close

   MsgBox "密码修改成功", vbOKOnly + vbExclamation, ""

   Unload Me

End If

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

主界面

Private Sub add_user_Click()

frmadduser.Show

End Sub

Private Sub double_check_Click()

frmfind_double.Show

End Sub

Private Sub check_Click()

frmfind.Show

End Sub

Private Sub double_client_Click()

frmdouble_client.Show

End Sub

Private Sub exit_Click()

Unload Me

End Sub

Private Sub khts_Click()

frmkhts.Show

End Sub

Private Sub MDIForm_Load()

frmdata = False

find = False

End Sub

Private Sub modify_pw_Click()

frmchangepwd.Show

End Sub

Private Sub only_check_Click()

frmfind.Show

End Sub

Private Sub only_client_Click()

frmonly_client.Show

End Sub

Private Sub zbgl_Click()

frmzhiban.Show

End Sub

客人信息代码

Option Explicit

Dim rs_data2 As New ADODB.Recordset

Dim select_row As String

Dim showgrid2 As Boolean

Dim rs_custom As New ADODB.Recordset

Private Sub Command1_Click()

Unload Me

End Sub

Private Sub Form_Load()

On Error GoTo loaderror

Dim sql As String

displaygrid1

loaderror:

If Err.Number <> 0 Then

   MsgBox Err.Description

End If

End Sub

Public Sub displaygrid1()

Dim i As Integer

On Error GoTo displayerror

setgrid

setgridhead

MSFlexGrid1.Row = 0

If Not rs_data1.EOF Then

   rs_data1.MoveFirst

   Do While Not rs_data1.EOF

            MSFlexGrid1.Row = MSFlexGrid1.Row + 1

            MSFlexGrid1.Col = 0

            If Not IsNull(rs_data1.Fields(0)) Then MSFlexGrid1.Text = rs_data1.Fields(0) Else MSFlexGrid1.Text = ""

            MSFlexGrid1.Col = 1

            If Not IsNull(rs_data1.Fields(1)) Then MSFlexGrid1.Text = rs_data1.Fields(1) Else MSFlexGrid1.Text = ""

            MSFlexGrid1.Col = 2

            If Not IsNull(rs_data1.Fields(2)) Then MSFlexGrid1.Text = rs_data1.Fields(2) Else MSFlexGrid1.Text = ""

            MSFlexGrid1.Col = 3

            If Not IsNull(rs_data1.Fields(3)) Then MSFlexGrid1.Text = rs_data1.Fields(3) Else MSFlexGrid1.Text = ""

            MSFlexGrid1.Col = 4

            If Not IsNull(rs_data1.Fields(4)) Then MSFlexGrid1.Text = rs_data1.Fields(4) Else MSFlexGrid1.Text = ""

            MSFlexGrid1.Col = 5

            If Not IsNull(rs_data1.Fields(5)) Then MSFlexGrid1.Text = rs_data1.Fields(5) Else MSFlexGrid1.Text = ""

            MSFlexGrid1.Col = 6

            If Not IsNull(rs_data1.Fields(6)) Then MSFlexGrid1.Text = rs_data1.Fields(6) Else MSFlexGrid1.Text = ""

            rs_data1.MoveNext

   Loop

End If

displayerror:

If Err.Number <> 0 Then

   MsgBox Err.Description

End If

End Sub

Public Sub setgrid()

Dim i As Integer

On Error GoTo seterror

With MSFlexGrid1

    .ScrollBars = flexScrollBarBoth

    .FixedCols = 0

    .Rows = rs_data1.RecordCount + 1

    .Cols = 7

    .SelectionMode = flexSelectionByRow

For i = 0 To .Rows - 1

    .RowHeight(i) = 315

Next

For i = 0 To .Cols - 1

    .ColWidth(i) = 1300

Next i

End With

Exit Sub

seterror:

     MsgBox Err.Description

End Sub

Public Sub setgridhead()

On Error GoTo setheaderror

MSFlexGrid1.Row = 0

MSFlexGrid1.Col = 0

MSFlexGrid1.Text = "房号"

MSFlexGrid1.Col = 1

MSFlexGrid1.Text = "房价"

MSFlexGrid1.Col = 2

MSFlexGrid1.Text = "姓名"

MSFlexGrid1.Col = 3

MSFlexGrid1.Text = "性别"

MSFlexGrid1.Col = 4

MSFlexGrid1.Text = " 证件号码"

MSFlexGrid1.Col = 5

MSFlexGrid1.Text = "抵达日"

MSFlexGrid1.Col = 6

MSFlexGrid1.Text = "离店日"

Exit Sub

setheaderror:

   MsgBox Err.Description

End Sub

Private Sub Form_Unload(Cancel As Integer)

findok = False

rs_data1.Close

'rs_custom.Close

If showgrid2 = True Then

rs_data2.Close

End If

End Sub

输入客人资料代码

Option Explicit

Dim rs_dclient As New ADODB.Recordset

Private Sub Command1_Click()

On Error GoTo adderror

If Command1.Caption = "新增记录" Then

   Command1.Caption = "确定"

   Command2.Enabled = False

   Command3.Enabled = False

   Command4.Enabled = True

   DataGrid1.AllowAddNew = True

   DataGrid1.AllowUpdate = True

Else

If Not IsNull(DataGrid1.Bookmark) Then

  If Trim(DataGrid1.Columns("团队名称").CellText(DataGrid1.Bookmark)) = "" Then

          MsgBox "团队名称不能为空!", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

   If Trim(DataGrid1.Columns("负责人姓名").CellText(DataGrid1.Bookmark)) = "" Then

          MsgBox "负责人姓名不能为空!", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

  If Trim(DataGrid1.Columns("证件号码").CellText(DataGrid1.Bookmark)) = "" Then

          MsgBox "证件号码不能为空!", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

  If Trim(DataGrid1.Columns("房间号码").CellText(DataGrid1.Bookmark)) = "" Then

          MsgBox "房间号码!", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

   rs_dclient.Update

   MsgBox "添加信息成功!", vbOKOnly + vbExclamation, ""

   DataGrid1.AllowAddNew = False

   DataGrid1.AllowUpdate = False

Else

   MsgBox "没有添加信息!", vbOKOnly + vbExclamation, ""

End If

   Command1.Caption = "新增记录"

   Command2.Enabled = True

   Command3.Enabled = True

   Command4.Enabled = False

End If

adderror:

If Err.Number <> 0 Then

   MsgBox Err.Description

End If

End Sub

Private Sub Command2_Click()

Dim answer As String

On Error GoTo cmdmodify

If Command2.Caption = "修改记录" Then

   answer = MsgBox("确定要修改吗?", vbYesNo, "")

   If answer = vbYes Then

      Command2.Caption = "确定"

      Command1.Enabled = False

      Command3.Enabled = False

      Command4.Enabled = True

      DataGrid1.AllowUpdate = True

   Else

      Exit Sub

   End If

Else

   If Not IsNull(DataGrid1.Bookmark) Then

      rs_dclient.Update

   End If

   Command2.Caption = "修改记录"

   Command1.Enabled = True

   Command3.Enabled = True

   Command4.Enabled = False

   DataGrid1.AllowUpdate = False

   MsgBox "修改成功!", vbOKOnly + vbExclamation, ""

End If

cmdmodify:

If Err.Number <> 0 Then

   MsgBox Err.Description

End If

End Sub

Private Sub Command3_Click()

Dim answer As String

On Error GoTo delerror

answer = MsgBox("确定要删除吗?", vbYesNo, "")

If answer = vbYes Then

   DataGrid1.AllowDelete = True

   rs_dclient.Delete

   rs_dclient.Update

   DataGrid1.Refresh

   MsgBox "成功删除!", vbOKOnly + vbExclamation, ""

   DataGrid1.AllowDelete = False

Else

   Exit Sub

End If

delerror:

If Err.Number <> 0 Then

   MsgBox Err.Description

End If

End Sub

Private Sub Command4_Click()

If Command4.Caption = "确定" Then

   rs_dclient.Cancel

   DataGrid1.ReBind

   DataGrid1.AllowAddNew = False

   DataGrid1.AllowUpdate = False

   Command1.Caption = "新增记录"

   Command2.Enabled = True

   Command3.Enabled = True

   Command4.Enabled = False

ElseIf Command2.Caption = "确定" Then

   rs_dclient.Cancel

   DataGrid1.ReBind

  DataGrid1.Refresh

   DataGrid1.AllowUpdate = False

   Command2.Caption = "修改记录"

   Command1.Enabled = True

   Command3.Enabled = True

   Command4.Enabled = False

End If

Frame2.Enabled = True

End Sub

Private Sub Command5_Click()

Unload Me

End Sub

Private Sub Form_Load()

Dim sql As String

On Error GoTo loaderror

sql = "select * from 团队资料"

rs_dclient.CursorLocation = adUseClient

rs_dclient.Open sql, conn, adOpenKeyset, adLockPessimistic   

'设定datagrid控件属性

DataGrid1.AllowAddNew = False                              

DataGrid1.AllowDelete = False                                

DataGrid1.AllowUpdate = False

Set DataGrid1.DataSource = rs_dclient

Command4.Enabled = False

Exit Sub

loaderror:

   MsgBox Err.Description

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set DataGrid1.DataSource = Nothing

rs_dclient.Close

End Sub

查询输出代码

Option Explicit

Dim rs_find As New ADODB.Recordset

Private Sub Command1_Click()

On Error GoTo cmderror

Dim find_date1 As String

Dim find_date2 As String

If Option1.Value = True Then

   sqlfind = "select * from 散客资料 where 房号 between '" & _

   Combo1(0).Text & "'" & " and " & "'" & Combo1(1).Text & "'"

End If

If Option2.Value = True Then

   find_date1 = Format(CDate(Comboy(0).Text & "-" & _

   Combom(0).Text & "-" & Combod(0).Text), "yyyy-mm-dd")

   find_date2 = Format(CDate(Comboy(1).Text & "-" & _

   Combom(1).Text & "-" & Combod(1).Text), "yyyy-mm-dd")

   sqlfind = "select * from 散客资料 where 抵达日 between #" & _

   find_date1 & "#" & " and" & " #" & find_date2 & "#"

End If

rs_data1.Open sqlfind, conn, adOpenKeyset, adLockPessimistic

frmdatamanage.displaygrid1

Unload Me

cmderror:

If Err.Number <> 0 Then

   MsgBox "请输入正确的查询条件!", vbOKOnly + vbExclamation, "警告"

End If

End Sub

Private Sub Command2_Click()

Unload Me

MDIForm1.Show

End Sub

Private Sub Form_Load()

Dim i As Integer

Dim sql As String

'If findok = True Then

  ' rs_data1.Close

'End If

sql = "select * from 散客资料 order by 房号 desc"

rs_find.CursorLocation = adUseClient

rs_find.Open sql, conn, adOpenKeyset, adLockPessimistic

If rs_find.EOF = False Then              

   With rs_find

        Do While Not .EOF

           Combo1(0).AddItem .Fields(0)

           Combo1(1).AddItem .Fields(0)

           .MoveNext

        Loop

   End With

End If

For i = 20## To 2005                     

    Comboy(0).AddItem i

    Comboy(1).AddItem i

Next i

For i = 1 To 12                         

    Combom(0).AddItem i

    Combom(1).AddItem i

Next i

For i = 1 To 31                         

    Combod(0).AddItem i

    Combod(1).AddItem i

Next i

End Sub

Private Sub Form_Unload(Cancel As Integer)

rs_find.Close

End Sub

用户登录界面代码

Option Explicit

Dim cnt As Integer                   

Private Sub Command1_Click()

Dim sql As String

Dim rs_login As New ADODB.Recordset

If Trim(text1.Text) = "" Then           

   MsgBox "没有这个用户", vbOKOnly + vbExclamation, ""

   text1.SetFocus

Else

   sql = "select * from 系统管理 where 用户名='" & text1.Text & "'"

   rs_login.Open sql, conn, adOpenKeyset, adLockPessimistic

   If rs_login.EOF = True Then

      MsgBox "没有这个用户", vbOKOnly + vbExclamation, ""

      text1.SetFocus

   Else                                 

      If Trim(rs_login.Fields(1)) = Trim(text2.Text) Then

          userID = text1.Text

          userpow = rs_login.Fields(2)

          rs_login.Close

          Unload Me

          MDIForm1.Show

      Else

         MsgBox "密码不正确", vbOKOnly + vbExclamation, ""

         text2.SetFocus

      End If

   End If

End If

cnt = cnt + 1

If cnt = 3 Then

   Unload Me

End If

Exit Sub

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Load()

Dim connectionstring As String

connectionstring = "provider=Microsoft.Jet.oledb.4.0;" & _

                   "data source=jiudian.mdb"

conn.Open connectionstring

cnt = 0

End Sub

Option Explicit

Dim rs_zhiban As New ADODB.Recordset

Private Sub cmdadd_Click()

On Error GoTo adderror

If cmdadd.Caption = "确定增加记录" Then

   cmdadd.Caption = "确定"                    

   cmddel.Enabled = False

   cmdcancel.Enabled = True

   DataGrid1.AllowAddNew = True

   DataGrid1.AllowUpdate = True              

Else

If Not IsNull(DataGrid1.Bookmark) Then

   If Not IsDate(Trim(DataGrid1.Columns("值班开始日期").CellText(DataGrid1.Bookmark))) Then

          MsgBox "请按照格式yyyy-mm-dd输入值班开始日期", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

   If Not IsDate(Trim(DataGrid1.Columns("值班开始时间").CellText(DataGrid1.Bookmark))) Then

          MsgBox "请按照格式hh-mm输入值班开始时间", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

   If Not IsDate(Trim(DataGrid1.Columns("值班截止日期").CellText(DataGrid1.Bookmark))) Then

          MsgBox "请按照格式yyyy-mm-dd输入值班截止日期", vbOKOnly + vbExclamation, "

          Exit Sub

   End If

   If Not IsDate(Trim(DataGrid1.Columns("值班截止时间").CellText(DataGrid1.Bookmark))) Then

          MsgBox "请按照格式hh-mm输入值班截止时间", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

   If Trim(DataGrid1.Columns("值班人").CellText(DataGrid1.Bookmark)) = "" Then

          MsgBox "值班人不能为空!", vbOKOnly + vbExclamation, ""

          Exit Sub

   End If

   rs_zhiban.Update

   'MsgBox "添加信息成功!", vbOKOnly + vbExclamation, ""

   DataGrid1.AllowAddNew = False

   DataGrid1.AllowUpdate = False

Else

   MsgBox "没有添加信息!", vbOKOnly + vbExclamation, ""

End If

   cmdadd.Caption = "确定增加记录"

   cmddel.Enabled = True

End If

adderror:

If Err.Number <> 0 Then

   MsgBox Err.Description

End If

End Sub

值班管理代码

Private Sub cmdcancel_Click()

Unload Me

MDIForm1.Show

End Sub

Private Sub cmddel_Click()

Dim answer As String

On Error GoTo delerror

answer = MsgBox("确定要删除吗?", vbYesNo, "")

If answer = vbYes Then

   DataGrid1.AllowDelete = True

   rs_zhiban.Delete

   rs_zhiban.Update

   DataGrid1.Refresh

   MsgBox "成功删除!", vbOKOnly + vbExclamation, ""

   DataGrid1.AllowDelete = False

Else

   Exit Sub

End If

delerror:

If Err.Number <> 0 Then

   MsgBox Err.Description

End If

End Sub

Private Sub Form_Load()

Dim sql As String

On Error GoTo loaderror

sql = "select * from 值班管理"

rs_zhiban.CursorLocation = adUseClient

rs_zhiban.Open sql, conn, adOpenKeyset, adLockPessimistic   

DataGrid1.AllowAddNew = False                                

DataGrid1.AllowDelete = False                                

DataGrid1.AllowUpdate = False

Set DataGrid1.DataSource = rs_zhiban

Exit Sub

loaderror:

   MsgBox Err.Description

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set DataGrid1.DataSource = Nothing

rs_zhiban.Close

End Sub

六、课程设计总结

七、教师评语

相关推荐