Сделай Сам Свою Работу на 5

Скриншот уведомления, созданного программой в 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 Все материалы защищены законодательством РФ.