Visual Basic

Содержание
Задание 0 Создание базы данных в среде ACCESS
Задание 1 Проектирование приложений для решения линейных задач
Задание 2 Проектирование приложений для решения задач с условиями
Задание 3 Циклические вычислительные процессы
Задание 4 Использование управляющих структур для работы с двумерными массивами
Задание 5 Процедуры и функции
Задание 6 Разработка приложений для работы с базами данных
Задание 7 Создание и обработка файлов данных
Задание 8 Разработка пользовательского меню. Управление проектом
Список литературы

Checked Then
Open "flat.txt" For Output As #1
Else
Open "repair.txt" For Output As #1
End If
Close #1
Call mnuMain1ViewFile_Click
End If
End Sub
Private Sub mnuMain1InsRec_Click()
If mnuFileFlat.Checked Then
Open "flat.txt" For Append As #1
Form2.Text1(0).Text = ""
Form2.Text1(1).Text = ""
Form2.Text1(2).Text = "0"
Form2.Text1(3).Text = "1"
Form2.Text1(4).Text = "0"
Form2.Text1(5).Text = "1"
Form2.Text1(6).Text = "0"
Form2.Text1(7).Text = "0"
Form2.Show (1)
If save Then
code = Form2.Text1(0).Text
region = Form2.Text1(1).Text
htype = Val(Form2.Text1(2).Text)
floor = Val(Form2.Text1(3).Text)
S = Val(Form2.Text1(4).Text)
rooms = Val(Form2.Text1(5).Text)
Sk = Val(Form2.Text1(6).Text)
price = Val(Form2.Text1(7).Text)
End If
Write #1, code, region, htype, floor, S, rooms, Sk, price
Close #1
Else
Open "repair.txt" For Append As #1
Form3.Text1(0).Text = ""
Form3.Text1(1).Text = ""
Form3.Text1(2).Text = ""
Form3.Text1(3).Text = "0"
Form3.Show (1)
If save Then
code = Form3.Text1(0).Text
phone = Form3.Text1(1).Text
rep = Form3.Text1(2).Text
rprice = Val(Form3.Text1(3).Text)
End If
Write #1, code, phone, rep, rprice
Close #1
End If
Call mnuMain1ViewFile_Click
End Sub
Private Sub mnuMain1DelRec_Click()
Dim num As Byte, i As Byte
num = CByte(InputBox("Введите номер удаляемой записи ", _
"Ввод данных", , 2000, 500))
If num >= 1 Then
If mnuFileFlat.Checked Then
Open "flat.txt" For Input As #1
Open "new_flat.txt" For Output As #2
i = 1
Do While Not EOF(1)
If i <= num - 1 Then
Input #1, code, region, htype, floor, S, rooms, Sk, price
Write #2, code, region, htype, floor, S, rooms, Sk, price
i = i + 1
Else
Exit Do
End If
Loop
If Not EOF(1) Then
Input #1, code, region, htype, floor, S, rooms, Sk, price
End If
Do While Not EOF(1)
Input #1, code, region, htype, floor, S, rooms, Sk, price
Write #2, code, region, htype, floor, S, rooms, Sk, price
Loop
Close #1, #2
Kill "flat.txt"
Name "new_flat.txt" As "flat.txt"
MsgBox "Запись с номером " & num & " успешно удалена." & vbCrLf & _
"Для продолжения нажми OK.", 64, "Результат удаления"
Else
Open "repair.txt" For Input As #1
Open "new_repair.txt" For Output As #2
i = 1
Do While Not EOF(1)
If i <= num - 1 Then
Input #1, code, phone, rep, rprice
Write #2, code, phone, rep, rprice
i = i + 1
Else
Exit Do
End If
Loop
If Not EOF(1) Then
Input #1, code, phone, rep, rprice
End If
Do While Not EOF(1)
Input #1, code, phone, rep, rprice
Write #2, code, phone, rep, rprice
Loop
Close #1, #2
Kill "repair.txt"
Name "new_repair.txt" As "repair.txt"
MsgBox "Запись с номером " & num & " успешно удалена." & vbCrLf & _
"Для продолжения нажми OK.", 64, "Результат удаления"
End If
Else
MsgBox "Недопустимый номер записи" & vbCrLf & _
num, 64, "Результат удаления"
End If
Call mnuMain1ViewFile_Click
End Sub
Private Sub mnuMain1EdtRec_Click()
Dim num As Byte, i As Byte
num = CByte(InputBox("Введите номер записи для редактирования", _
"Ввод данных", , 2000, 500))
If num >= 1 Then
If mnuFileFlat.Checked Then
Open "flat.txt" For Input As #1
Open "new_flat.txt" For Output As #2
i = 1
Do While Not EOF(1) And i <> num
If i <= num - 1 Then
Input #1, code, region, htype, floor, S, rooms, Sk, price
Write #2, code, region, htype, floor, S, rooms, Sk, price
i = i + 1
Else
Exit Do
End If
Loop
If Not EOF(1) Then
Input #1, code, region, htype, floor, S, rooms, Sk, price
Form2.Text1(0).Text = code
Form2.Text1(1).Text = region
Form2.Text1(2).Text = Str(htype)
Form2.Text1(3).Text = Str(floor)
Form2.Text1(4).Text = Str(S)
Form2.Text1(5).Text = Str(rooms)
Form2.Text1(6).Text = Str(Sk)
Form2.Text1(7).Text = Str(price)
Form2.Show (1)
If save Then
code = Form2.Text1(0).Text
region = Form2.Text1(1).Text
htype = Val(Form2.Text1(2).Text)
floor = Val(Form2.Text1(3).Text)
S = Val(Form2.Text1(4).Text)
rooms = Val(Form2.Text1(5).Text)
Sk = Val(Form2.Text1(6).Text)
price = Val(Form2.Text1(7).Text)
End If
Write #2, code, region, htype, floor, S, rooms, Sk, price
End If
Do While Not EOF(1)
Input #1, code, region, htype, floor, S, rooms, Sk, price
Write #2, code, region, htype, floor, S, rooms, Sk, price
Loop
Close #1, #2
Kill "flat.txt"
Name "new_flat.txt" As "flat.txt"
MsgBox "Запись с номером " & num & " успешно сохранена." & vbCrLf & _
"Для продолжения нажми OK.", 64, "Результат корректировки"
Else
Open "repair.txt" For Input As #1
Open "new_repair.txt" For Output As #2
i = 1
Do While Not EOF(1)
If i <= num - 1 Then
Input #1, code, phone, rep, rprice
Write #2, code, phone, rep, rprice
i = i + 1
Else
Exit Do
End If
Loop
If Not EOF(1) Then
Input #1, code, phone, rep, rprice
Form3.Text1(0).Text = code
Form3.Text1(1).Text = phone
Form3.Text1(2).Text = rep
Form3.Text1(3).Text = Str(rprice)
Form3.Show (1)
If save Then
code = Form3.Text1(0).Text
phone = Form3.Text1(1).Text
rep = Form3.Text1(2).Text
rprice = Val(Form3.Text1(3).Text)
End If
Write #2, code, phone, rep, rprice
End If
Do While Not EOF(1)
Input #1, code, phone, rep, rprice
Write #2, code, phone, rep, rprice
Loop
Close #1, #2
Kill "repair.txt"
Name "new_repair.txt" As "repair.txt"
MsgBox "Запись с номером " & num & " успешно сохранена." & vbCrLf & _
"Для продолжения нажми OK.", 64, "Результат корректировки"
End If
Else
MsgBox "Недопустимый номер записи" & vbCrLf & _
num, 64, "Результат корректировки"
End If
Call mnuMain1ViewFile_Click
End Sub
Private Sub mnuMain1ViewFile_Click()
Dim cell As String * 6, cell1 As String * 8
If mnuFileFlat.Checked Then
Open "flat.txt" For Input As #1
Text1.Text = ""
Text1.Text = Space(25) & "Список проданных квартир" & vbCrLf
Text1.Text = Text1.Text + _
"-------------------------------------------------------------------------" & vbCrLf + _
"| Шифр | Район или ст.метро | Тип | Этаж | S | К-во | S | Цена |" & vbCrLf + _
"| | | дома | | кв. | комн.| кух. | 1 м^2 |" & vbCrLf + _
"|-----------------------------------------------------------------------|" & vbCrLf
Do While Not EOF(1)
Input #1, code, region, htype, floor, S, rooms, Sk, price
Text1.Text = Text1.Text & "|" & code & "|" & region & "|"
cell = Str(htype)
Text1.Text = Text1.Text & cell & "|"
cell = Str(floor)
Text1.Text = Text1.Text & cell & "|"
cell = Str(S)
Text1.Text = Text1.Text & cell & "|"
cell = Str(rooms)
Text1.Text = Text1.Text & cell & "|"
cell = Str(Sk)
Text1.Text = Text1.Text & cell & "|"
cell1 = Format(price, "0.00")
Text1.Text = Text1.Text & cell1 & "|" & vbCrLf
Loop
Text1.Text = Text1.Text + _
"-------------------------------------------------------------------------" & vbCrLf
Close #1
Else
Open "repair.txt" For Input As #1
Text1.Text = ""
Text1.Text = Space(28) & "Список ремонтов квартир" & vbCrLf
Text1.Text = Text1.Text + _
"-------------------------------------------------------------------------------" & vbCrLf + _
"| Шифр | Телефон | Вид | Стоим. |" & vbCrLf + _
"| | | ремонта | 1 м^2 |" & vbCrLf + _
"|-----------------------------------------------------------------------------|" & vbCrLf
Do While Not EOF(1)
Input #1, code, phone, rep, rprice
Text1.Text = Text1.Text & "|" & code & "|" & phone & "|" & rep & "|"
cell1 = Format(rprice, "0.00")
Text1.Text = Text1.Text & cell1 & "|" & vbCrLf
Loop
Text1.Text = Text1.Text + _
"-------------------------------------------------------------------------------" & vbCrLf
Close #1
End If
End Sub
Private Sub mnuMain2_Click()
End
End Sub
Private Sub Timer1_Timer()
Label1.Caption = Date & Space(5) & Time()
End Sub
Для формы 2:
Option Explicit
Private Sub Command3_Click()
save = True
Form2.Hide
End Sub
Private Sub Command4_Click()
save = False
Form2.Hide
End Sub
Для формы 3:
Option Explicit
Private Sub Command3_Click()
save = True
Form2.Hide
End Sub
Private Sub Command4_Click()
save = False
Form2.Hide
End Sub


Рис. 27.Результат работы .exe файла
Рис. 28.Результат работы .exe файла
Задание 8 Разработка пользовательского меню. Управление проектом
Используя редактор меню создать меню, с помощью которого можно управлять всем курсовым проектом. При выполнении этого задания студент должен освоить методы запуска проектов из других проектов, освоить работу с функцией Shell из меню, созданного при помощи мастера меню и использующее быстрые клавиши. Освоить работу с такими элементами как: списки дисковых накопителей, директорий и файлов.
Форма после определения свойств объектов на ней имеет вид, показанный на рис.29.
Рис. 29.Форма к заданию 8

Программный код имеет вид:
Option Explicit
Dim a As Double
Dim WindowStyle As VbAppWinStyle
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
a = Shell(File1.Path & "\" & File1.FileName, WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_1_1_Click()
a = Shell("..\task1\task1.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_2_1_Click()
a = Shell("..\task2\1\task21.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_2_2_Click()
a = Shell("..\task2\2\task22.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_2_3_Click()
a = Shell("..\task2\3\task23.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_3_1_Click()
a = Shell("..\task3\task3.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_4_1_Click()
a = Shell("..\task4\task4.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_5_1_Click()
a = Shell("..\task5\1\task51.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_5_2_Click()
a = Shell("..\task5\2\task52.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_6_1_Click()
a = Shell("..\task6\task6.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_7_1_Click()
a = Shell("..\task7\task7.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu2_Click()
End
End Sub
Рис. 30.Результат работы .exe файла
Список литературы
1. Visual Basic 6 Black Book (Publisher: The Coriolis Group) Author(s): Steven Holzner ISBN: 1576102831 Publication Date: 08/01/98
17