Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Курсач, Вариант 3, часть вторая

.doc
Скачиваний:
14
Добавлен:
16.12.2013
Размер:
718.85 Кб
Скачать

ЗАДАНИЕ № 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

17