Скриншот уведомления, созданного программой в Microsoft Word
Московский институт электроники и математики Национального исследовательского университета Высшая школа экономики (МИЭМ)
Пояснительная записка
по дисциплине «Технология программирования»
Тема проекта: «Система бронирования номеров в отеле ‘Chateau Св. Марка’»
Выполнили:
студенты группы С-72
Александрова Ольга
Казаков Александр
Кириллов Ярослав
Проверил:
профессор кафедры ВСиС
Восков Леонид Сергеевич
Москва 2012
Содержание
1. Постановка задачи..........................................................................................3
2. Цель работы....................................................................................................3
3. Ход выполнения работы.................................................................................3
3.1. Лабораторная работа №1........................................................3
3.2. Лабораторная работа №2........................................................9
3.3. Лабораторная работа №3........................................................11
3.4. Лабораторная работа №4........................................................14
3.5. Лабораторная работа №5.......................................................15
3.6. Лабораторная работа №6........................................................20
3.7. Лабораторная работа №7........................................................23
3.8. Лабораторная работа №8........................................................26
3.9. Лабораторная работа №9........................................................32
3.10. Лабораторная работа №10......................................................37
3.11. Лабораторная работа №11......................................................39
3.12. Лабораторная работа №12.......................................................46
Постановка задачи
Выполнить 12 лабораторных работ по курсу «Технология программирования». Выполнение лабораторных работ включает в себя следующее:
1. Изучить курс по VB 6.0.
2. Русифицировать элементы пользовательского интерфейса и комментарии в исходном коде предлагаемых образцов программ.
3. Исправить ошибки и недоработки в этих программах.
4. Отладить программы.
5. Внести в каждую программу сведения об авторах.
Цель работы
Освоить Visual Basic 6.0 по курсу 70-176, предлагаемому Microsoft в качестве подготовки к официальному квалификационному экзамену по VB 6.0 на сертификат.
Ход выполнения работы
Каждая лабораторная работа, начиная со второй, содержит часть конечного проекта (системы резервирования номеров в отеле). Первая работа содержит уже готовый проект. 12-я работа – итоговая, там необходимо скомпилировать программу в EXE-файл и создать дистрибутив для установки ее на клиентские машины.
Лабораторная работа №1
Данная работа призвана познакомить нас с IDE VB6.0, а также Microsoft Solutions Framework и Visual SourceSafe. Она содержит уже готовый проект системы бронирования.
Скриншот основного окна программы:
Код основной формы (frmReservation):
Option Explicit
Private WithEvents Res As CReservation
Private Sub cmdDone_Click()
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
If ctl.Text = "" Then
MsgBox "All fields must be entered."
Exit Sub
End If
ElseIf TypeOf ctl Is MaskEdBox Then
If ctl.ClipText = "" Then
MsgBox "All fields must be entered."
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
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
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
'avoid a run-time error in case of EOF status
If .EOF Then
.MoveFirst
End If
End With
FillControls
End Sub
Private Sub cmdMovePrevious_Click()
With Res.rsReservation
.MovePrevious
'Avoid a run-time error in case of BOF status
If .BOF Then
.MoveLast
End If
End With
FillControls
End Sub
Private Sub Form_Load()
Set Res = New CReservation
DisableControls
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"
FillControls
End Sub
Private Sub grpPmtType_Click(Index As Integer)
Select Case Index
Case 0 'Credit card
staAdditionalInfo.Panels("addinfo").Text = _
"Visa, Master Card or American Express accepted."
Case 1 'Check
staAdditionalInfo.Panels("addinfo").Text = _
"Picture ID and check guarantee card required."
Case 2 'Cash
staAdditionalInfo.Panels("addinfo").Text = _
"Hotels do not carry a lot of extra change."
End Select
End Sub
Private Sub mnuCustSearch_Click()
Dim strCriteria As String
frmSearch.Show vbModal
'Search based on any of the three fields
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
'Search for last name
.Find strCriteria
'If last name not found
If .EOF Then
MsgBox "Last name " & frmSearch!txtLastName.Text & " not found."
End If
End With
Unload frmSearch
End Sub
Private Sub mnuGuestEdit_Click()
'Enable controls for record editing
'and check-in, check-out, and cancel
EnableControls
End Sub
Private Sub mnuGuestReservationAdd_Click()
Dim ctl As Control
Res.AddReservation
EnableControls
'Clear field values
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 = _
"Click Done to update the Reservation table."
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 "Guest checked-in successfully."
Else
MsgBox "Could not check-in guest. Status is " & _
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()
'Use the Recordset object to fill the advanced fields with data
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
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
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 = "Chateau St. Mark Invoice"
.Font.Bold = True
.Font.Name = "Times New Roman"
.Font.Size = 26
End With
.Range("A4").Value = "Name:"
.Range("B4").Value = txtFirstName.Text & " " & txtLastName.Text
With .Range("A5")
.Value = "Address"
.VerticalAlignment = xlTop
End With
With .Range("B5")
.Value = txtAddress.Text
.ColumnWidth = 20
.WrapText = True
End With
.Range("A6").Value = "Number of Days:"
.Range("B6").Value = txtNumDays.Text
.Range("A7").Value = "Rate:"
.Range("B7").Value = txtRate.Text
.Range("A8").Value = "Total Due:"
.Range("B8").Value = Format(CSng(txtNumDays.Text) * CSng(txtRate.Text), "Currency")
'The rest
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
'Create a new instance of word
Set wd = New Word.Application
'Show the new instance of Word
wd.Visible = True
'Open the Chateau.dot Word template
Set wdDoc = wd.Documents.Add("C:\Labs\Chateau.dot")
'Determine the payment type
If grpPmtType(0).Value = True Then
strPmtType = "Credit Card"
ElseIf grpPmtType(1).Value Then
strPmtType = "Check"
Else
strPmtType = "Cash"
End If
'Fill the fields on the template with values from the form
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
'Send the new document to printprieview
wdDoc.PrintPreview
End Sub
Private Sub mskCheckIn_Validate(Cancel As Boolean)
If Not IsDate(mskCheckIn.Text) Then
staAdditionalInfo.Panels("addinfo").Text = "Not a valid date format (ex. '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 = "Value must be numeric."
End If
End Sub
Private Sub txtNumDays_LostFocus()
If mskCheckIn.ClipText <> "" And txtNumDays.Text <> "" Then
txtCheckOut.Text = Format(DateAdd("d", Val(txtNumDays.Text), mskCheckIn.Text), "mm-dd-yyyy")
End If
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 = "Value must be numeric."
End If
End Sub
Private Sub txtPhone_KeyPress(KeyAscii As Integer)
'exit sub for allowable characters
If Chr(KeyAscii) = vbBack _
Or Chr(KeyAscii) = "-" _
Or Chr(KeyAscii) = "(" _
Or Chr(KeyAscii) = ")" Then Exit Sub
'check for alpha characters
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionalInfo.Panels("addinfo").Text = "Phone number must be numeric."
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 = "Value must be numeric."
End If
End Sub
Код класса CReservation:
Option Explicit
Private cnReservation As ADODB.Connection
Public rsReservation As ADODB.Recordset
'To fire this event, use RaiseEvent with the following syntax:
'RaiseEvent ResError[(arg1, arg2, ... , argn)]
Public Event ResError(ByVal Number As Long, ByVal Description As String)
Private Function MoveToArchive() As Boolean
Dim rsArchive As ADODB.Recordset
Set rsArchive = New ADODB.Recordset
On Error GoTo HandleError
rsArchive.Open "ReservationArchive", cnReservation, adOpenDynamic, adLockPessimistic
rsArchive.AddNew
With rsArchive
![FirstName] = rsReservation![FirstName]
![Lastname] = rsReservation![Lastname]
![Address] = rsReservation![Address]
![Phone] = rsReservation![Phone]
![PaymentType] = rsReservation![PaymentType]
![NumberOfPeople] = rsReservation![NumberOfPeople]
![Status] = rsReservation![Status]
![RoomNumber] = rsReservation![RoomNumber]
![Rate] = rsReservation![Rate]
![NumberOfDays] = rsReservation![NumberOfDays]
![CheckInDate] = rsReservation![CheckInDate]
.Update
End With
rsReservation.Delete adAffectCurrent
MoveToArchive = True
Exit Function
HandleError:
MoveToArchive = False
End Function
Public Function CancelReservation() As Boolean
rsReservation![Status] = "CANCELED"
If MoveToArchive Then
CancelReservation = True
rsReservation.MoveFirst
Else
CancelReservation = False
End If
End Function
Public Function CheckOut() As Boolean
'Check the status to make sure the guest is checked in
If rsReservation![Status] = "ACTIVE" Then
rsReservation![Status] = "INACTIVE"
If MoveToArchive Then
CheckOut = True
rsReservation.MoveFirst
End If
Else
MsgBox "Could not check-out INACTIVE guest."
CheckOut = False
End If
End Function
Public Function CheckIn() As Boolean
'Check the status to make sure it is pending
If rsReservation![Status] = "PENDING" Then
rsReservation![Status] = "ACTIVE"
rsReservation![CheckInDate] = Format(Date, "mm-dd-yyyy")
rsReservation.Update
CheckIn = True
Else
CheckIn = False
End If
End Function
Public Function AddReservation() As Boolean
rsReservation.AddNew
rsReservation![Status] = "PENDING"
AddReservation = True
End Function
Private Sub Class_GetDataMember(DataMember As String, Data As Object)
Set Data = rsReservation
End Sub
Private Sub Class_Initialize()
Dim SQL As String
SQL = "SELECT * FROM Reservation;"
'create and open the connection
Set cnReservation = New ADODB.Connection
cnReservation.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=C:\Labs\Rsvn.mdb"
cnReservation.Open
Set rsReservation = New ADODB.Recordset
'create and open the recordset
rsReservation.Open SQL, cnReservation, adOpenDynamic, adLockPessimistic
End Sub
Лабораторная работа №2
Содержание данной работы:
· Создание пользовательского интерфейса (добавление на форму полей ввода (TextBox), кнопок (CommandButton), радиокнопок (OptionButton), фреймов (GroupBox) а также редактирование их свойств);
· Добавление на форму нестандартных элементов управления (панели статуса (StatusBar), поля форматного ввода (MaskEdBox));
· Добавление меню.
Выявленные ошибки:
Ошибок не выявлено.
Скриншот основного окна программы:
Код основной формы (frmReservation):
Private Sub grpPmtType_Click(Index As Integer)
Select Case Index
Case 0 'Credit card
staAdditionallnfo.Panels("addinfo").Text = _
"Принимаются Visa, Master Card или American Express."
Case 1 'Check
staAdditionallnfo.Panels("addinfo").Text = _
"Фотография идентификационной карты и проверка гарантийного талона необходимы."
Case 2 'Cash
staAdditionallnfo.Panels("addinfo").Text = _
"В отелях не всегда есть мелкая сдача."
End Select
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub Лабораторная работа №3
Содержание данной работы:
· Включение контроля навигации пользователя (отключение/скрытие элементов формы, которые пользователь не должен использовать в данный момент);
· Включение контроля на уровне полей (не позволить пользователю ввести в поле некорректные данные);
· Включение контроля данных на уровне формы (не позволить пользователю продолжить выполнение программы, пока все элементы формы не приобретут те свойства, которые необходимы для продолжения работы программы, например, пока не заполнены необходимые поля)
Выявленные ошибки:
1. Для проверки значения радиокнопки используется выражение If ctl.Value = "" Then. Данное условие всегда будет ложным, т.к. свойство Value у OptionButton имеет тип Boolean. Т.е. запись о постояльце будет внесена в БД даже в том случае, если вид платежа не указан.
2. Исправлен формат даты с ММ-ДД-ГГГГ на ДД-ММ-ГГГГ. К сожалению, функция проверки даты на правильность (IsDate) возвращает True для обоих форматов.
3. Каждый символ, вводимый в поле «Количество дней пребывания» проверяется функцией IsNumeric, т.е. в поле нельзя ввести ничего, кроме цифр. Но зато можно ввести 0, и это значение пройдет проверку.
4. Значение поля «Количество постояльцев» тоже не проверялось на нулевое значение.
Скриншот основного окна программы:
Код основной формы (frmReservation):
Option Explicit
Private Sub Form_Load()
DisableControls
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
DisableControls
End Sub
Private Sub grpPmtType_Click(Index As Integer)
Select Case Index
Case 0 'Credit card
staAdditionallnfo.Panels("addinfo").Text = _
"Принимаются Visa, Master Card или American Express."
Case 1 'Check
staAdditionallnfo.Panels("addinfo").Text = _
"Фотография идентификационной карты и проверка гарантийного талона необходимы."
Case 2 'Cash
staAdditionallnfo.Panels("addinfo").Text = _
"В отелях не всегда есть мелкая сдача."
End Select
End Sub
Private Sub mnuFileExit_Click()
Unload Me
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
mnuGuestReservationCheckln.Enabled = True
mnuGuestReservationCheckOut.Enabled = True
mnuGuestReservationCancel.Enabled = True
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
mnuGuestReservationCheckln.Enabled = False
mnuGuestReservationCheckOut.Enabled = False
mnuGuestReservationCancel.Enabled = False
End Sub
Private Sub mnuGuestReservationAdd_Click()
EnableControls
txtFirstName.SetFocus
End Sub
Private Sub txtFirstName__KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtAddress__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 mnuHelpAbout_Click()
MsgBox "Лабораторную работу выполнили студенты группы С-72" & _
Chr(13) & "Александрова Ольга" & Chr(13) & "Казаков Александр" & _
Chr(13) & "Кириллов Ярослав", vbOKOnly, "Авторы"
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
'проверка на буквенные символы
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Номер телефона должен быть числовым."
End If
End Sub
Private Sub txtNumPeople_KeyPress(KeyAscii As Integer)
'разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Значение должно быть числовым."
End If
End Sub
Private Sub txtNumDays_KeyPress(KeyAscii As Integer)
'разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Значение должно быть числовым."
End If
End Sub
Private Sub txtRate_KeyPress(KeyAscii As Integer)
'разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Значение должно быть числовым."
End If
End Sub
Private Sub mskCheckIn_Validate(Cancel As Boolean)
If Not IsDate(mskCheckln.Text) Then
staAdditionallnfo.Panels("addinfo").Text = _
"Not a valid date format (ex. '07-23-2000')"
Cancel = True
End If
End Sub
Private Sub txtNumDays_LostFocus()
If mskCheckln.ClipText <> "" And txtNumDays.Text <> "" Then
txtCheckOut.Text = Format(DateAdd("d", Val(txtNumDays.Text), mskCheckln.Text), "mm-dd-yyyy")
End If
End Sub
Лабораторная работа №4
Содержание данной работы:
· Изучение встроенного в VB6.0 отладчика приложения.
Выявленные ошибки:
Ошибок как таковых не выявлено, но небольшая недоработка есть: перед подстановкой значений текстовых полей в функцию Val следовало бы проверить их функцией IsNumeric и выдать сообщение об ошибке в случае, если хотя бы одно из значений полей не является числовым. В противном случае функция Val просто вернет 0, если строка не начинается с цифр.
Скриншот основного окна программы:
Скриншот сообщения о некорректности введенных данных:
Код основной формы (frmDebug):
Option Explicit
Private Sub cmdAddValues_Click()
Dim Result As Double
'Add the values in txtFirstValue and txtSecondValue
Result = Val(txtFirstValue.Text) + Val(txtSecondValue.Text)
'Display the resulting value in lblResult
lblResult.Caption = Result
Beep
End Sub
Private Sub cmdSubtract_Click()
Dim Result As Double
'Do not allow the number in the second textbox to be
'greater than the value in the first textbox
'Use the Val function to convert the string value to a numeric value
If Val(txtSecondValue.Text) > Val(txtFirstValue.Text) Then
MsgBox "Второе значение не должно быть больше первого."
Else
'Subtract the value of txtSecondValue from txtFirstValue
Result = Val(txtFirstValue.Text) - Val(txtSecondValue.Text)
'Display the resulting value in lblResult
lblResult.Caption = Result
Beep
End If
End Sub
Лабораторная работа №5
Содержание данной работы:
· Изучить реализацию процедурного обработчика ошибок (On Error GoTo Label);
· Изучить реализацию строчного обработчика ошибок (On Error Resume Next).
Выявленные ошибки:
1. Некорректная реакция на нажатие кнопки «Cancel» в диалоге ввода команды. Если пользователь нажал эту кнопку, ему выдается сообщение «Команда ‘’ не найдена». Эта недоработка была исправлена путем проверки возвращаемой диалогом строки на пустое значение: If strFile <> "" Then.
2. Такая же недоработка была исправлена для диалога открытия файла.
3. Перед вводом данных из текстового файла в поле прежнее содержимое поля не очищалось. Эта недоработка была исправлена.
Скриншот основного окна программы:
Скриншот загрузки текстового файла:
Скриншот успешно открытого открытого файла:
Скриншот открытия приложения:
Скриншот успешно открытого приложения:
Скриншот попытки открытия приложения с неверным именем:
Скриншот попытки открытия файла с неверным именем:
Код основной формы (frmEdit):
Option Explicit
Private Sub cmdImportFileText_Click()
Dim intFileNumber As Integer
Dim strFileName As String
Dim strRecord As String
On Error GoTo HandleError
'Display the open dialog using the common
'dialog control
CDlgTextImport.ShowOpen
strFileName = CDlgTextImport.FileName
'Use the FreeFile function to assign a file number
intFileNumber = FreeFile()
'Open the text file for input
Open strFileName For Input As #intFileNumber
'read in each line of text and display it in
'the txtEditText text box
Do While Not EOF(intFileNumber)
Input #intFileNumber, strRecord
txtEditText.Text = txtEditText.Text & _
strRecord & vbCrLf
Loop
'close the file
Close #intFileNumber
Exit Sub
HandleError:
If Err.Number = 7 Then
MsgBox "Неверный тип файла. Не удается загрузить " & _
strFileName & " для входа."
ElseIf Err.Number = 75 Then
MsgBox "Ошибка доступа к файлу."
Else
MsgBox "Произошла ошибка при загрузке " & _
strFileName & " для входа."
End If
End Sub
Private Sub cmdOpenApp_Click()
On Error Resume Next
Dim strFile As String
strFile = InputBox("Введите путь и имя файла.")
Shell strFile, vbNormalFocus
If Err.Number <> 0 Then
MsgBox strFile & " –неправильное имя файла."
Exit Sub
End If
End Sub
Лабораторная работа №6
Содержание данной работы:
· Создание модулей классов;
· Наполнение класса методами и полями;
· Создание собственных событий: объявление, вызов, обработка.
Выявленные ошибки:
1. Все ошибки, унаследованные от л/р №3.
Скриншот сообщения от метода Checkin:
Код основной формы (frmReservation):
Option Explicit
Private WithEvents Res As CReservation
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 "Требуется указать тип платежа."
Exit Sub
End If
End If
Next ctl
Res.AddReservation
DisableControls
End Sub
Private Sub Form_Load()
Set Res = New CReservation
DisableControls
End Sub
Private Sub grpPmtType_Click(Index As Integer)
Select Case Index
Case 0 'Credit card
staAdditionallnfo.Panels("addinfo").Text = _
"Принимаются Visa, Master Card èëè American Express."
Case 1 'Check
staAdditionallnfo.Panels("addinfo").Text = _
"Фотография идентификационной карты и проверка гарантийного талона необходимы."
Case 2 'Cash
staAdditionallnfo.Panels("addinfo").Text = _
"В отелях не всегда есть мелкая сдача."
End Select
End Sub
Private Sub mnuFileExit_Click()
Unload Me
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
mnuGuestReservationCheckln.Enabled = True
mnuGuestReservationCheckOut.Enabled = True
mnuGuestReservationCancel.Enabled = True
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
mnuGuestReservationCheckln.Enabled = False
mnuGuestReservationCheckOut.Enabled = False
mnuGuestReservationCancel.Enabled = False
End Sub
Private Sub mnuGuestReservationAdd_Click()
EnableControls
txtFirstName.SetFocus
End Sub
Private Sub mnuGuestReservationCancel_Click()
Res.CancelReservation
End Sub
Private Sub mnuGuestReservationCheckIn_Click()
Res.CheckIn
End Sub
Private Sub mnuGuestReservationCheckout_Click()
Res.CheckOut
End Sub
Private Sub txtFirstName__KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtAddress__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 mnuHelpAbout_Click()
MsgBox "Лабораторую работу выполнили студенты группы С-72" & _
Chr(13) & "Александрова Ольга" & Chr(13) & "Казаков Александр" & _
Chr(13) & "Кириллов Ярослав", vbOKOnly, "Авторы"
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
‘проверка на буквенные символы
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "номер телефона должен быть числовым."
End If
End Sub
Private Sub txtNumPeople_KeyPress(KeyAscii As Integer)
'ðàçðåøàåì èñïîëüçîâàíèå êëàâèøè Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Номер телефона должен быть числовым."
End If
End Sub
Private Sub txtNumDays_KeyPress(KeyAscii As Integer)
‘Разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Значение должно быть числовым."
End If
End Sub
Private Sub txtRate_KeyPress(KeyAscii As Integer)
‘Разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = " Значение должно быть числовым."
End If
End Sub
Private Sub mskCheckIn_Validate(Cancel As Boolean)
If Not IsDate(mskCheckln.Text) Then
staAdditionallnfo.Panels("addinfo").Text = _
"Not a valid date format (ex. '07-23-2000')"
Cancel = True
End If
End Sub
Private Sub txtNumDays_LostFocus()
If mskCheckln.ClipText <> "" And txtNumDays.Text <> "" Then
txtCheckOut.Text = Format(DateAdd("d", Val(txtNumDays.Text), mskCheckln.Text), "mm-dd-yyyy")
End If
End Sub
Код класса CReservation:
Option Explicit
' для генерации этого события используйте RaiseEvent с синтаксисом:
' RaiseEvent ResError[(arg1, arg2, ..., argn)]
Public Event ResError(ByVal Number As Long, ByVal Description As String)
Public Function CancelReservation() As Boolean
MsgBox "CancelReservation-здесь будет обрабатываться код."
End Function
Public Function CheckOut() As Boolean
MsgBox "Checkout- здесь будет обрабатываться код."
End Function
Public Function Checkln() As Boolean
MsgBox "Checkln- здесь будет обрабатываться код."
End Function
Public Function AddReservation() As Boolean
MsgBox "AddReservation- здесь будет обрабатываться код."
End Function
Лабораторная работа №7
Содержание данной работы:
· Добавление элемента ADO Data Recordset и подключение его к БД “rsvn.mdb” (в формате MS Access 97);
· Связывание элементов управления формы с источником данных;
· Получение данных из указанной БД с помощью Recordset.
Выявленные ошибки:
1. Все ошибки, унаследованные от л/р №6.
2. Неверный путь к файлу rsvn.mdb.
Скриншот основного окна программы:
Код основной формы (frmReservation):
Option Explicit
Private WithEvents Res As CReservation
Private Sub adcReservation_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
Dim strStatus As String
Dim dtCheckIn As Date
Dim intNumDays As Integer
On Error Resume Next
' проверяем способ оплаты(payment type)в бызе данных
'и устанавливаем соответствующий переключатель
strStatus = adcReservation.Recordset![PaymentType]
Select Case strStatus
Case "CREDIT CARD"
grpPmtType(0).Value = True
Case "CHECK"
grpPmtType(1).Value = True
Case "CASH"
grpPmtType(2).Value = True
End Select
' присваиваем переменным dtCheckln и intNumDays ,
' значения из набора записей элемента ADO Data
dtCheckIn = adcReservation.Recordset![CheckInDate]
intNumDays = adcReservation.Recordset![NumberOfDays]
' вычисляем дату выписки и выводим ее в txtCheckOut
txtCheckOut.Text = Format(DateAdd("d", intNumDays, dtCheckIn), "mm-dd-yyyy")
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 "Требуется указать тип платежа."
Exit Sub
End If
End If
Next ctl
Res.AddReservation
DisableControls
End Sub
Private Sub Form_Load()
Set Res = New CReservation
DisableControls
End Sub
Private Sub grpPmtType_Click(Index As Integer)
Select Case Index
Case 0 'Credit card
staAdditionallnfo.Panels("addinfo").Text = _
"Принимаются Visa, Master Card èëè American Express."
Case 1 'Check
staAdditionallnfo.Panels("addinfo").Text = _
"Фотография идентификационной карты и проверка гарантийного талона необходимы."
Case 2 'Cash
staAdditionallnfo.Panels("addinfo").Text = _
"В отелях не всегда есть мелкая сдача."
End Select
End Sub
Private Sub mnuFileExit_Click()
Unload Me
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
mnuGuestReservationCheckln.Enabled = True
mnuGuestReservationCheckOut.Enabled = True
mnuGuestReservationCancel.Enabled = True
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
mnuGuestReservationCheckln.Enabled = False
mnuGuestReservationCheckOut.Enabled = False
mnuGuestReservationCancel.Enabled = False
adcReservation.Enabled = True
End Sub
Private Sub mnuGuestReservationAdd_Click()
EnableControls
txtFirstName.SetFocus
End Sub
Private Sub mnuGuestReservationCancel_Click()
Res.CancelReservation
End Sub
Private Sub mnuGuestReservationCheckIn_Click()
Res.CheckIn
End Sub
Private Sub mnuGuestReservationCheckout_Click()
Res.CheckOut
End Sub
Private Sub txtFirstName__KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtAddress__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 mnuHelpAbout_Click()
MsgBox "Лабораторную работу выполнили студенты группы С-72" & _
Chr(13) & "Александрова Ольга" & Chr(13) & "Казаков Александр" & _
Chr(13) & "Кириллов Ярослав", vbOKOnly, "Авторы"
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
'проверка на буквенные символы
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Номер телефона должен быть числовым."
End If
End Sub
Private Sub txtNumPeople_KeyPress(KeyAscii As Integer)
'разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Значение должно быть числовым."
End If
End Sub
Private Sub txtNumDays_KeyPress(KeyAscii As Integer)
'разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = "Значение должно быть числовым."
End If
End Sub
Private Sub txtRate_KeyPress(KeyAscii As Integer)
'разрешаем использование клавиши Backspace
If Chr(KeyAscii) = vbBack Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then
Beep
KeyAscii = 0
staAdditionallnfo.Panels("addinfo").Text = ""Значение должно быть числовым."
End If
End Sub
Private Sub mskCheckIn_Validate(Cancel As Boolean)
If Not IsDate(mskCheckln.Text) Then
staAdditionallnfo.Panels("addinfo").Text = _
"Not a valid date format (ex. '07-23-2000')"
Cancel = True
End If
End Sub
Private Sub txtNumDays_LostFocus()
If mskCheckln.ClipText <> "" And txtNumDays.Text <> "" Then
txtCheckOut.Text = Format(DateAdd("d", Val(txtNumDays.Text), mskCheckln.Text), "mm-dd-yyyy")
End If
End Sub
Лабораторная работа №8
Содержание данной работы:
· Создание ADO-объектов (Recordset и Connection);
· Написание ADO-кода для подключения к БД и получения нужных данных оттуда.
Выявленные ошибки:
1. Все ошибки, унаследованные от л/р №7.
Скриншот окна программы для поиска данных из БД:
Скриншот основного окна программы после заполнения из БД:
Код основной формы (frmReservation):
Option Explicit
Private WithEvents Res As CReservation
Private cnReservation As ADODB.Connection
Private rsReservation As ADODB.Recordset
Private Sub adcReservation_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
Dim strStatus As String
Dim dtCheckIn As Date
Dim intNumDays As Integer
On Error Resume Next
' проверяем способ оплаты(payment type)в бызе данных
'и устанавливаем соответствующий переключатель
strStatus = adcReservation.Recordset![PaymentType]
Select Case strStatus
Case "CREDIT CARD"
grpPmtType(0).Value = True
Case "CHECK"
grpPmtType(1).Value = True
Case "CASH"
grpPmtType(2).Value = True
End Select
' присваиваем переменным dtCheckln и intNumDays ,
' значения из набора записей элемента ADO Data
dtCheckIn = adcReservation.Recordset![CheckInDate]
intNumDays = adcReservation.Recordset![NumberOfDays]
' вычисляем дату выписки и выводим ее в txtCheckOut
txtCheckOut.Text = Format(DateAdd("d", intNumDays, dtCheckIn), "mm-dd-yyyy")
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 "Необходимо указать тип платежа"
Exit Sub
End If
End If
Next ctl 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 "Необходимо указать способ оплаты"
Res.AddReservation
DisableControls
End Sub
Private Sub Form_Load()
Set Res = New CReservation
DisableControls
End Sub
Private Sub grpPmtType_Click(Index As Integer)
Select Case Index
Case 0 'Credit card
staAdditionallnfo.Panels("addinfo").Text = _
"Принимаются Visa, Master Card èëè American Express."
Case 1 'Check
staAdditionallnfo.Panels("addinfo").Text = _
Не нашли, что искали? Воспользуйтесь поиском по сайту:
©2015 - 2024 stydopedia.ru Все материалы защищены законодательством РФ.
|