1.5 Требования к программной документации
Система должна содержать справочную информацию о работе и подсказки пользователю, а так же информацию о разработчиках проекта.
В состав сопровождающей документации должны входить:
Техническое задание.
Текст программы.
Пример работы программы.
Руководство пользователя.
1.6 Технико-экономические показатели
Предполагаемое число обращений в год порядка 1000.
1.7 Порядок контроля и приемки
Контроль и приемка разработки осуществляются на основе испытаний контрольно-отладочных примеров, на предоставляемой заказчиком технике (либо на технике исполнителя). При этом проверяется выполнение всех функций программы.
2 Текст программы
2.1 Текст HotelRes.vbp
Текст программы
Option Explicit
Private WithEvents Res As CReservation
Private Function EmptyBase() As Boolean
EmptyBase = (Res.rsReservation.BOF And Res.rsReservation.EOF)
End Function
Private Sub Clear()
Dim ctl As Control
For Each ctl In frmReservation.Controls
If TypeOf ctl Is TextBox Then
ctl.Text = ""
ElseIf TypeOf ctl Is MaskEdBox Then
ctl.Text = "__-__-____"
ElseIf TypeOf ctl Is OptionButton Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub DisableNavigate()
cmdMoveFirst.Enabled = False
cmdMoveLast.Enabled = False
cmdMovePrevious.Enabled = False
cmdMoveNext.Enabled = False
mnuReportsReminder.Enabled = False
mnuReportsInvoice.Enabled = False
End Sub
Private Sub EnableNavigate()
cmdMoveFirst.Enabled = True
cmdMoveLast.Enabled = True
cmdMovePrevious.Enabled = True
cmdMoveNext.Enabled = True
mnuReportsReminder.Enabled = True
mnuReportsInvoice.Enabled = True
End Sub
Private Sub cmdDone_Click()
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
If ctl.Text = "" Then
MsgBox "Все поля должны быть заполнены"
Exit Sub
End If
ElseIf TypeOf ctl Is MaskEdBox Then
If ctl.ClipText = "" Then
 MsgBox "Все поля должны быть заполнены"
Exit Sub
End If
'ElseIf TypeOf ctl Is OptionButton Then
' If ctl.Value = "" Then
' MsgBox "Payment type is required."
' Exit Sub
'End If
End If
Next ctl
If Not (grpPmtType(0).Value) And Not (grpPmtType(1).Value) And Not (grpPmtType(2).Value) Then
'вот если Value всех трех радиокнопок равен False, тогда считаем,
что вид платежа не указан.
MsgBox "Необходимо указать вид платежа.", vbExclamation, "Ошибка"
Exit Sub
End If
DisableControls
If grpPmtType(0).Value Then
Res.rsReservation![PaymentType] = "CREDIT CARD"
ElseIf grpPmtType(1).Value Then
Res.rsReservation![PaymentType] = "CHECK"
ElseIf grpPmtType(2).Value Then
Res.rsReservation![PaymentType] = "CASH"
End If
Res.rsReservation![CheckInDate] = mskCheckIn.Text
Res.rsReservation.Update
If EmptyBase Then
DisableNavigate
Else
EnableNavigate
End If
End Sub
Private Sub cmdMoveFirst_Click()
Res.rsReservation.MoveFirst
FillControls
End Sub
Private Sub cmdMoveLast_Click()
Res.rsReservation.MoveLast
FillControls
End Sub
Private Sub cmdMoveNext_Click()
With Res.rsReservation
.MoveNext
If .EOF Then
.MoveFirst
End If
End With
FillControls
End Sub
Private Sub cmdMovePrevious_Click()
With Res.rsReservation
.MovePrevious
If .BOF Then
.MoveLast
End If
End With
FillControls
End Sub
Private Sub Form_Load()
Set Res = New CReservation
Set txtFirstName.DataSource = Res
txtFirstName.DataField = "FirstName"
Set txtLastName.DataSource = Res
txtLastName.DataField = "LastName"
Set txtAddress.DataSource = Res
txtAddress.DataField = "Address"
Set txtPhone.DataSource = Res
txtPhone.DataField = "Phone"
Set txtNumPeople.DataSource = Res
txtNumPeople.DataField = "NumberOfPeople"
Set txtNumDays.DataSource = Res
txtNumDays.DataField = "NumberOfDays"
Set txtRoomNumber.DataSource = Res
txtRoomNumber.DataField = "RoomNumber"
Set txtRate.DataSource = Res
txtRate.DataField = "Rate"
DisableControls
If EmptyBase Then
DisableNavigate
MsgBox ("База данных пуста")
Else
EnableNavigate
Res.rsReservation.MoveFirst
FillControls
End If
End Sub
Private Sub grpPmtType_Click(Index As Integer)
Select Case Index
Case 0
staAdditionalInfo.Panels("addinfo").Text = _
"Visa, Master Card или American Express допустимы."
Case 1
staAdditionalInfo.Panels("addinfo").Text = _
"Требуется удостоверение личности"
Case 2
staAdditionalInfo.Panels("addinfo").Text = _
"Отели не заботся о дополнительных изменениях."
End Select
End Sub
Private Sub mnuCustSearch_Click()
Dim strCriteria As String
frmSearch.Show vbModal
'Поиск по какому либо из 3-х полей
If Trim(frmSearch!txtLastName.Text) <> "" Then
strCriteria = "[LastName] LIKE '" & frmSearch!txtLastName.Text
& "%'"
ElseIf Trim(frmSearch!txtPhone.Text) <> "" Then
strCriteria = "[Phone] LIKE '" & frmSearch!txtPhone.Text & "%'"
ElseIf Trim(frmSearch!txtFirstName.Text) <> "" Then
strCriteria = "[FirstName] LIKE '" & frmSearch!txtFirstName.Text & "%'"
End If
With Res.rsReservation
'Фамилии
.Find strCriteria
'Не найдена
If .EOF Then
MsgBox "Фамилия " & frmSearch!txtLastName.Text & " не найдена."
End If
End With
Unload frmSearch
End Sub
Private Sub mnuGuestEdit_Click()
EnableControls
End Sub
Private Sub mnuGuestReservationAdd_Click()
Dim ctl As Control
Res.AddReservation
EnableControls
For Each ctl In frmReservation.Controls
If TypeOf ctl Is TextBox Then
ctl.Text = ""
ElseIf TypeOf ctl Is MaskEdBox Then
ctl.Text = "__-__-____"
ElseIf TypeOf ctl Is OptionButton Then
ctl.Value = False
End If
Next
txtFirstName.SetFocus
staAdditionalInfo.Panels("addinfo").Text = _
"Нажмите 'Готово' чтобы обновиь таблицу."
End Sub
Private Sub mnuGuestReservationCancel_Click()
Res.CancelReservation
End Sub
Private Sub mnuGuestReservationCheckIn_Click()
Dim blnCheckInResult As Boolean
blnCheckInResult = Res.CheckIn()
If blnCheckInResult Then
MsgBox "Гость успешно въехал."
Else
MsgBox "Не возможно вписать гостя. Статус: " & _
Res.rsReservation![Status]
End If
End Sub
Private Sub mnuGuestReservationCheckout_Click()
Res.CheckOut
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub FillControls()
mskCheckIn.Text = Format(Res.rsReservation![CheckInDate], "mm-dd-yyyy")
txtCheckOut.Text = Format(DateAdd("d", Val(txtNumDays.Text), mskCheckIn.Text), "mm-dd-yyyy")
Select Case Res.rsReservation![PaymentType]
Case "CREDIT CARD"
grpPmtType(0).Value = True
Case "CHECK"
grpPmtType(1).Value = True
Case "CASH"
grpPmtType(2).Value = True
End Select
staAdditionalInfo.Panels("addinfo").Text = ""
End Sub
Private Sub DisableControls()
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is Menu Or TypeOf ctl Is Label Then
ctl.Enabled = True
Else
ctl.Enabled = False
End If
If TypeOf ctl Is TextBox Or TypeOf ctl Is MaskEdBox _
Then ctl.BackColor = "&H8000000F"
Next ctl
mnuGuestReservationCheckIn.Enabled = False
mnuGuestReservationCheckout.Enabled = False
mnuGuestReservationCancel.Enabled = False
cmdMoveFirst.Enabled = True
cmdMovePrevious.Enabled = True
cmdMoveNext.Enabled = True
cmdMoveLast.Enabled = True
End Sub
Private Sub EnableControls()
Dim ctl As Control
For Each ctl In Controls
ctl.Enabled = True
If TypeOf ctl Is TextBox Or TypeOf ctl Is MaskEdBox _
Then ctl.BackColor = "&H80000005"
Next ctl
mnuGuestReservationCheckIn.Enabled = True
mnuGuestReservationCheckout.Enabled = True
mnuGuestReservationCancel.Enabled = True
cmdMoveFirst.Enabled = False
cmdMovePrevious.Enabled = False
cmdMoveNext.Enabled = False
cmdMoveLast.Enabled = False
End Sub
Private Sub mnuHelpAbout_Click()
MsgBox "Лабораторная работа выполнена студентами группы С-73 Безденежных Юлией, Березиной Кристиной, Ковтуненко Константином"
End Sub
Private Sub mnuHelpContents_Click()
Shell "cmd /X /C start help.doc"
End Sub
Private Sub mnuReportsInvoice_Click()
Static xl As Excel.Application
Set xl = New Excel.Application
With xl
.Visible = True
.Workbooks.Add
With .Range("A1")
.Value = "Счёт отеля Парус"
.Font.Bold = True
.Font.Name = "Times New Roman"
.Font.Size = 26
End With
.Range("A4").Value = "Имя:"
.Range("B4").Value = txtFirstName.Text & " " & txtLastName.Text
With .Range("A5")
.Value = "Адрес"
.VerticalAlignment = xlTop
End With
With .Range("B5")
.Value = txtAddress.Text
.ColumnWidth = 20
.WrapText = True
End With
.Range("A6").Value = "Число дней:"
.Range("B6").Value = txtNumDays.Text
.Range("A7").Value = "Цена:"
.Range("B7").Value = txtRate.Text
.Range("A8").Value = "Итого:"
.Range("B8").Value = Format(CSng(txtNumDays.Text) * CSng(txtRate.Text), "Currency")
'Остальное
End With
Columns("A:A").ColumnWidth = 25
xl.ActiveWorkbook.PrintPreview
End Sub
Private Sub mnuReportsReminder_Click()
Static wd As Word.Application
Static wdDoc As Word.Document
Dim strPmtType As String
Set wd = New Word.Application
wd.Visible = True
Set wdDoc = wd.Documents.Add(App.Path & "\Chateau.dot")
If grpPmtType(0).Value = True Then
strPmtType = "Credit Card"
ElseIf grpPmtType(1).Value Then
strPmtType = "Check"
Else
strPmtType = "Cash"
End If
With wdDoc
.FormFields("wdFirstName").Range = txtFirstName.Text
.FormFields("wdCheckIn").Range = mskCheckIn.Text
.FormFields("wdNumOfDays").Range = txtNumDays.Text
.FormFields("wdPmtType").Range = strPmtType
.FormFields("wdCalcTotal").Range = Format(CSng(txtNumDays.Text) * CSng(txtRate.Text), "Currency")
.FormFields("wdCheckOut").Range = txtCheckOut.Text
End With
wdDoc.PrintPreview
End Sub
Private Sub mskCheckIn_Validate(Cancel As Boolean)
If Not IsDate(mskCheckIn.Text) Then
staAdditionalInfo.Panels("addinfo").Text = "Некорректный формат даты (прим. '07-23-2000')"
Cancel = True
End If
End Sub
Private Sub txtAddress_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtFirstName_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtLastName_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtNumDays_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionalInfo.Panels("addinfo").Text = "Значение должно быть числовым"
End If
End Sub
Private Sub txtNumDays_LostFocus()
If mskCheckIn.ClipText <> "" And txtNumDays.Text <> "" Then
txtCheckOut.Text = Format(DateAdd("d", Val(txtNumDays.Text), Format(mskCheckIn.Text, "mm-dd-yyyy")), "mm-dd-yyyy")
End If
End Sub
Private Sub mskCheckIn_LostFocus()
staAdditionalInfo.Panels("addinfo").Text = ""
End Sub
Private Sub txtNumPeople_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionalInfo.Panels("addinfo").Text = "Значение должно быть числовым"
End If
End Sub
Private Sub txtPhone_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = vbBack _
Or Chr(KeyAscii) = "-" _
Or Chr(KeyAscii) = "(" _
Or Chr(KeyAscii) = ")" Then Exit Sub
I f Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionalInfo.Panels("addinfo").Text = "Телефон должен быть
числовым"
End If
End Sub
Private Sub txtRate_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionalInfo.Panels("addinfo").Text = "Значение должно быть числовым"
End If
End Sub
|
