Курсач, Вариант 3, часть вторая
.docЗАДАНИЕ № 6
Исходные данные о продукции предприятия. Для каждой продукции задано: шифр, название, расход каждого из 3-х материалов на единицу продукции, цена единицы продукции, выпуск за каждый квартал года. Число наименований продукции не определено. Используя данные в файле, найти самую дорогую продукцию. При этом необходимо обеспечить возможность:
-
создание файла;
-
добавление новых записей в файл;
-
удаление записи с заданным номером из файла;
-
корректировка записи с заданным номером в файле;
-
исправление названия продукции;
-
сортировка записей в файле по суммарному выпуску продукции за год (по убыванию), затем по суммарному расходу 3-х материалов (по убыванию), а внутри по алфавиту названия;
-
просмотра содержимого файла после выполнения любой из перечисленных операций с файлом.
Рис. 17
Рис. 18
Рис. 19
Рис. 20
Рис. 21
Рис. 22
Рис. 23
Рис. 24
Рис. 25
Рис. 26
ПРОГРАММНЫЙ КОД:
Option Explicit
Private Type Product
code As String * 11
name As String * 11
mat(1 To 3) As Single
mats As Single
cost As Single
count As Integer
End Type
Dim st As Product
'Окончание работы программы
Private Sub mnu12_Click()
End
End Sub
'Создание файла
Private Sub mnu21_Click()
Dim otv As String * 1
Dim i As Byte
Dim j As Byte
Open "fl.dat" For Random As #1 Len = Len(st)
i = 0
Do
st.mats = 0
i = i + 1
st.code = InputBox("Введите шифр " & i & "-ой продукции", "Ввод данных", _
, 500, 500)
st.name = InputBox("Введите наименование " & i & "-ой продукции", "Ввод данных", _
, 500, 500)
For j = 1 To 3
st.mat(j) = CSng(InputBox("Введите расход " & j & "-го материала на единицу " & i & _
"-ой продукции", "Ввод данных", , 500, 500))
st.mats = st.mats + st.mat(j)
Next
st.cost = CSng(InputBox("Введите цену на единицу " & i & "-ой продукции", "Ввод данных", _
, 500, 500))
st.count = CInt(InputBox("Введите выпуск " & i & "-ой продукции на каждый квартал года", "Ввод данных", _
, 500, 500))
Put #1, , st
otv = InputBox("Введите Y, y, Д или д если хотите закончить ввод", "Ввод данных", _
, 500, 500)
Loop Until otv = "Y" Or otv = "y" Or otv = "Д" Or otv = "д"
Close #1
End Sub
'Добавление записей в файл
Private Sub mnu22_Click()
Dim otv As String * 1
Dim i As Byte
Dim j As Byte
Open "fl.dat" For Random As #1 Len = Len(st)
i = LOF(1) \ Len(st)
Seek #1, i + 1
Do
st.mats = 0
i = i + 1
st.code = InputBox("Введите шифр " & i & "-ой продукции", "Ввод данных", _
, 2000, 500)
st.name = InputBox("Введите наименование " & i & "-ой продукции", "Ввод данных", _
, 2000, 500)
For j = 1 To 3
st.mat(j) = CSng(InputBox("Введите расход " & j & "-го материала на единицу " & i & _
"-ой продукции", "Ввод данных", , 2000, 500))
st.mats = st.mats + st.mat(j)
Next
st.cost = CSng(InputBox("Введите цену на единицу " & i & "-ой продукции", "Ввод данных", _
, 2000, 500))
st.count = CInt(InputBox("Введите выпуск " & i & "-ой продукции на каждый квартал года", "Ввод данных", _
, 2000, 500))
Put #1, , st
otv = InputBox("Введите Y, y, Д или д если хотите закончить ввод", "Ввод данных", _
, 2000, 500)
Loop Until otv = "Y" Or otv = "y" Or otv = "Д" Or otv = "д"
Close #1
End Sub
'Удаление записи с заданным номером
Private Sub mnu23_Click()
Dim num As Integer, i As Integer
Open "fl.dat" For Random As #1 Len = Len(st)
Open "New_fl.dat" For Random As #2 Len = Len(st)
num = CInt(InputBox("Введите номер удаляемой записи ", "Ввод данных", _
, 2000, 500))
For i = 1 To num - 1
Get #1, , st
Put #2, , st
Next i
Seek #1, num + 1
For i = num + 1 To LOF(1) \ Len(st)
Get #1, , st
Put #2, , st
Next i
Close #1, #2
Kill "fl.dat"
Name "New_fl.dat" As "fl.dat"
End Sub
'Корректировка записи
Private Sub mnu24_Click()
Dim num As Integer, j As Integer
Open "fl.dat" For Random As #1 Len = Len(st)
Text1.Text = ""
Text1.Text = "Шифр Название Мат-л1 Мат-л2 Мат-л3 Цена Выпуск/кварт." & vbCrLf
num = CInt(InputBox("Введите номер корректируемой записи ", "Ввод данных", _
, 2000, 500))
Seek #1, num
Get #1, , st
Text1.Text = Text1.Text & " " & st.code & " " & st.name
For j = 1 To 3
Text1.Text = Text1.Text & " " & Format(st.mat(j), "#0.0#")
Next j
Text1.Text = Text1.Text & " " & Format(st.cost, "#0.0#") & " " & Format(st.count, "#0.0#") & vbCrLf
st.mats = 0
st.code = InputBox("Введите шифр " & num & "-ой продукции", "Ввод данных", _
, 2000, 500)
Text1.Text = Text1.Text & " " & st.code
st.name = InputBox("Введите наименование " & num & "-ой продукции", "Ввод данных", _
, 2000, 500)
Text1.Text = Text1.Text & " " & st.name
st.mats = 0
For j = 1 To 3
st.mat(j) = CSng(InputBox("Введите расход " & j & "-го материала на единицу " & num & _
"-ой продукции", "Ввод данных", , 2000, 500))
st.mats = st.mats + st.mat(j)
Text1.Text = Text1.Text & " " & Format(st.mat(j), "#0.0#")
Next
st.cost = CSng(InputBox("Введите цену на единицу " & num & "-ой продукции", "Ввод данных", _
, 2000, 500))
Text1.Text = Text1.Text & " " & Format(st.cost, "#0.0#")
st.count = CInt(InputBox("Введите выпуск на каждый квартал года " & num & "-ой продукции", "Ввод данных", _
, 2000, 500))
Text1.Text = Text1.Text & " " & st.count & vbCrLf
Seek #1, num
Put #1, , st
Close #1
End Sub
'Исправление названия продукции
Private Sub mnu25_Click()
Dim oldname As String * 11, f As Boolean, j As Integer
Open "fl.dat" For Random As #1 Len = Len(st)
oldname = InputBox("Введите старое название продукции", "Ввод данных", _
, 2000, 500)
Text1.Text = ""
Text1.Text = "Шифр Название Мат-л1 Мат-л2 Мат-л3 Цена Выпуск/кварт." & vbCrLf
f = True
Do While Not EOF(1)
Get 1, , st
If st.name = oldname Then
Text1.Text = Text1.Text & " " & st.code & " " & st.name
For j = 1 To 3
Text1.Text = Text1.Text & " " & Format(st.mat(j), "#0.0#")
Next j
Text1.Text = Text1.Text & " " & Format(st.cost, "#0.0#") & " " & st.count & vbCrLf
f = False
Exit Do
End If
Loop
If f Then
MsgBox "Продукции с таким названием нет в файле", 16, "Остановка"
Else
st.name = InputBox("Введите новое название " & Seek(1) - 1 & "-ой продукции", "Ввод данных", _
, 2000, 500)
Text1.Text = Text1.Text & " " & st.name & " ххххххххххххххххххх " & vbCrLf
Seek #1, Seek(1) - 1
Put #1, , st
End If
Close #1
End Sub
'Сортировка записей
Private Sub mnu26_Click()
Dim st1 As Product, f As Boolean, i As Byte, j As Byte
Open "fl.dat" For Random As #1 Len = Len(st)
f = True
Do While f
f = False
For i = 1 To LOF(1) \ Len(st) - 1
For j = i + 1 To LOF(1) \ Len(st)
Get #1, i, st
Get #1, j, st1
If st.count < st1.count Then
Put #1, i, st1
Put #1, j, st
f = True
ElseIf st.count = st1.count And st.mats < st1.mats Then
Put #1, i, st1
Put #1, j, st
f = True
ElseIf st.mats = st1.mats And st.count = st1.count And st.name > st1.name Then
Put #1, i, st1
Put #1, j, st
f = True
End If
Next j
Next i
Loop
Close #1
End Sub
'Просмотр файла
Private Sub mnu27_Click()
Dim i As Byte, j As Byte
Open "fl.dat" For Random As #1 Len = Len(st)
Text1.Text = Space(26) & "Продукции предприятия" & vbCrLf
Text1.Text = "Шифр Название Мат-л1 Мат-л2 Мат-л3 Цена Выпуск/кварт." & vbCrLf
For i = 1 To LOF(1) \ Len(st)
Get #1, , st
Text1.Text = Text1.Text & st.code & st.name
For j = 1 To 3
Text1.Text = Text1.Text & Format(st.mat(j), "#0.0#") & " "
Next j
Text1.Text = Text1.Text & Format(st.cost, "#0.0#") & " " & st.count & vbCrLf
Next i
Close #1
End Sub
'Самая дорогая продукция
Private Sub mnu28_Click()
Dim i As Byte, max As Single, num As Byte, sr As Single
Open "fl.dat" For Random As #1 Len = Len(st)
Text1.Text = " Самая дорогая продукция" & vbCrLf
Text1.Text = Text1.Text & "Шифр Название Мат-л1 Мат-л2 Мат-л3 Цена Выпуск/кварт." & vbCrLf
max = -1
For i = 1 To LOF(1) \ Len(st)
Get #1, , st
If max < st.cost Then
max = st.cost
num = Seek(1) - 1
End If
Next i
Get #1, num, st
Text1.Text = Text1.Text & " " & st.code & " " & st.name
For i = 1 To 3
Text1.Text = Text1.Text & " " & Format(st.mat(i), "#0.0#")
Next
Text1.Text = Text1.Text & " " & Format(st.cost, "#0.0#") & " " & st.count & vbCrLf
Text1.Text = Text1.Text & "Наибольшая цена = " & Format(max, "#0.0#")
Close #1
End Sub
ЗАДАНИЕ № 7
Задание состоит в объединении предыдущих заданий в один пакет, объединенных одним общим меню.
Рис. 27
Рис. 28
ПРОГРАММНЫЙ КОД:
Option Explicit
Dim a As Double
Dim WindowStyle As VbAppWinStyle
Private Sub mnu1_1_Click()
a = Shell("A:\Лабы\Lab1\Project.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_2_Click()
a = Shell("A:\Лабы\Lab2\Project.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_3_Click()
a = Shell("A:\Лабы\Lab3\Project.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_4_Click()
a = Shell("A:\Лабы\Lab4\Project.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_5_Click()
a = Shell("A:\Лабы\Lab5\Project.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu1_6_Click()
a = Shell("A:\Лабы\Lab6\Project.exe", WindowStyle = vbNormalFocus)
End Sub
Private Sub mnu2_Click()
End
End Sub