Добавил:

Sergo Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Государственный университет управления

Предмет:

Компьютерная подготовка

Файл:

Курсач по Visual Basic Проектирование прилож / 5Term paper

.doc

Скачиваний:

Добавлен:

16.12.2013

Размер:

1.2 Mб

Скачать

☆

Задание №1

Составить программу расчета формулы А+В*4.

Готовая форма будет иметь вид:

Программный код:

Private Sub Command1_Click()

Dim A As Single

Dim B As Single

A = Val(Text1.Text)

B = Val(Text2.Text)

Label4.Caption = A + B * 4

End Sub

Private Sub Command2_Click()

End

End Sub

Результат работы программы выглядит следующим образом:

Задание №2

Составить программу вычисления функции Y:

Y = Exp(x-1)^1.45 + 5 при |x| >5,

Y = Exp(x+1)^(-2.69) – 3 при |x|<=1.

Напечатать:

При x = ... функция вычисляется по формуле... Результат = ...

Форма будет иметь вид:

Программный код будет иметь вид:

Private Sub Command1_Click()

Dim x As Single, y As Single

x = Val(Text1.Text)

Label2.Visible = False

Label2.Caption = ""

Label4.Visible = False

Label4.Caption = ""

Label7.Visible = False

Label7.Caption = ""

Label8.Visible = False

Label8.Caption = ""

If (Abs(x) > 5) Then

y = Exp(x - 1) ^ 1.45 + 5

Label2.Visible = True

Label2.Caption = "Функция вычисляется по формуле:"

Label4.Visible = True

Label4.Caption = "Результат = "

Label7.Visible = True

Label7.Caption = "exp(x-1)^1.45 + 5 "

Label8.Visible = True

Label8.Caption = Format(y, "#0.0000")

ElseIf (Abs(x) <= 1) Then

y = Exp(x + 1) ^ (-2.69) - 3

Label2.Visible = True

Label2.Caption = "Функция вычисляется по формуле:"

Label4.Visible = True

Label4.Caption = "Результат = "

Label7.Visible = True

Label7.Caption = "exp(x+1)^(-2.69) - 3 "

Label8.Visible = True

Label8.Caption = Format(y, "#0.0000")

Else

Label2.Visible = True

Label2.Caption = "Функция не определена."

Label4.Visible = True

Label4.Caption = "Результата нет."

Label7.Visible = False

Label7.Caption = ""

Label8.Visible = False

Label8.Caption = ""

End If

End Sub

Private Sub Command2_Click()

End

End Sub

Результат работы программы представлен на рисунках 1, 2, 3:

Рисунок 1

Рисунок 2

Рисунок 3

Задание №3

Исходные данные: шифр детали, количество деталей, цена детали. Выдать справку: шифр детали, стоимость всех деталей.

Формы проекта выглядят следующим образом:

Программный код формы1 выглядит так:

Private Sub Command1_Click()

Dim sh$

Dim numb!, price!

sh = Text1.Text

numb = Val(Text2.Text)

price = Val(Text3.Text)

Load Form2

Form2.Show

Form2.Text1.Text = sh

Form2.Label4.Caption = Format(numb * price, "#0.0#")

End Sub

Программный код формы2:

Private Sub Command1_Click()

End

End Sub

Результат работы программы – на рисунке 4:

Рисунок 4

Задание №4

Исходные данные: расход нефти, газа, стали и т.п. (всего К наименований ресурсов) на каждом из М заводов. Исходные данные определяются путем обращения к датчику случайных чисел. Задание:

А. Для любого наименования ресурса определить завод с наибольшим расходом.

Б. Для любого завода определить суммарное значение расхода всех ресурсов.

Форма в данном случае будет выглядеть следующим образом:

Программный код представлен далее:

(General) (Declarations)

Option Explicit

Dim mas() As Single

Dim xz As Byte, yr As Byte 'количество строк, столбцов

Dim nxz As Byte, nyr As Byte 'номер строки, столбца

Dim mx As Single, sum As Single

Private Sub Form_Load()

Randomize

End Sub

Private Sub VScroll1_Change()

Text1.Text = VScroll1.Value

HScroll1.Max = VScroll1.Value

End Sub

Private Sub VScroll2_Change()

Text3.Text = VScroll2.Value

HScroll2.Max = VScroll2.Value

End Sub

Private Sub Image3_Click() 'ввод данных

xz = CByte(Text1.Text) 'кол-во заводов вводится в строку

yr = CByte(Text3.Text) 'кол-во р-сов вводится в столбец

ReDim mas(1 To xz, 1 To yr) As Single

Dim i As Byte, j As Byte

Form1.Picture1.Cls

For i = 1 To xz

For j = 1 To yr

mas(i, j) = CSng(Rnd * 199 + 200) 'ввод данных через rnd

Form1.Picture1.Print " "; Format(mas(i, j), "000.00"); Tab(10 * j); 'распечатка по строкам

Next j

Form1.Picture1.Print

Next i

End Sub

Private Sub Image4_Click() 'задача1

Dim i As Byte

nyr = CByte(Text4.Text): nxz = 1: mx = mas(1, nyr)

'номер столбца - в число, берем 1-й завод за мах

For i = 2 To xz 'по строке

If mas(i, nyr) > mx Then mx = mas(i, nyr): nxz = i

Form1.Picture2.Cls

Form1.Picture2.Print "Ресурс"; nyr; " более всего расходуется на заводе №"; nxz; _

" (стоимость = "; Format(mx, "000.00"); " руб."; " )"

End Sub

Private Sub Image5_Click() 'задача2

Dim i As Byte

sum = 0

nxz = CByte(Text2.Text)

For i = 1 To yr

sum = sum + mas(nxz, i)

Form1.Picture3.Cls

Form1.Picture3.Print "Для завода № "; nxz; " суммарное значение расхода всех ресурсов ="; _

Format(sum, "000.00"); " руб."

End Sub

Private Sub Image6_Click()

End

End Sub

Private Sub Option1_Click()

Image3.Picture = Image1.Picture

Image4.Picture = Image2.Picture

Image5.Picture = Image2.Picture

Image6.Picture = Image2.Picture

Image3.ToolTipText = "Выбери меня!"

Image4.ToolTipText = ""

Image5.ToolTipText = ""

Image6.ToolTipText = ""

End Sub

Private Sub Option2_Click()

Image3.Picture = Image2.Picture

Image4.Picture = Image1.Picture

Image5.Picture = Image2.Picture

Image6.Picture = Image2.Picture

Image4.ToolTipText = "Выбери меня!"

Image3.ToolTipText = ""

Image5.ToolTipText = ""

Image6.ToolTipText = ""

End Sub

Private Sub Option3_Click()

Image3.Picture = Image2.Picture

Image4.Picture = Image2.Picture

Image5.Picture = Image1.Picture

Image6.Picture = Image2.Picture

Image5.ToolTipText = "Выбери меня!"

Image4.ToolTipText = ""

Image3.ToolTipText = ""

Image6.ToolTipText = ""

End Sub

Private Sub Option4_Click()

Image3.Picture = Image2.Picture

Image4.Picture = Image2.Picture

Image5.Picture = Image2.Picture

Image6.Picture = Image1.Picture

Image6.ToolTipText = "Выбери меня!"

Image4.ToolTipText = ""

Image5.ToolTipText = ""

Image3.ToolTipText = ""

End Sub

Private Sub HScroll1_Change()

Text2.Text = HScroll1.Value

End Sub

Private Sub HScroll2_Change()

Text4.Text = HScroll2.Value

End Sub

Результат работы программы:

Задание №5

Составить функцию для вычисления:

Y = 1 + 1/(2*x) + 2/(4*x^2) + 4/(5*x^3) + 5/(7*x^4) + …, принимая, что модуль "х" больше 1. Вычисления продолжать, пока модуль разности между слагаемым и его предыдущим значением больше малой заданной величины (точности вычислений). Напечатать таблицу значений функции "Y" для всех значений аргумента "х" от заданного начального до заданного конечного с заданным шагом изменения.

Формы проекта будут выглядеть так:

Программный код для модуля выглядит следующим образом:

(General) (Declarations)

Option Explicit

Public toch As Single

(General) Y

Function Y(ByVal x As Single, ByRef t As Single) As Single

Dim pr!, sl!, sum!

Dim chis!, znam!, ch As Byte, zn As Byte, k!, p!, n!

sum = 0: pr = 0: sl = 1: chis = 1: znam = 2: ch = 1: zn = 2: k = 1: p = -1: n = 1

Do While Abs(sl - pr) > t

sum = sum + sl

pr = sl: sl = chis / (znam * x ^ n)

chis = chis + ch: znam = znam + zn

n = n + 1

ch = ch + k: zn = zn + p

k = -k: p = -p

Loop

Y = sum

End Function

Программный код для формы1 представлен далее:

(General) (Declarations)

Option Explicit

Private Sub Command1_Click()

Dim x As Single

x = CSng(Val(Text1.Text))

If Abs(x) <= 1 Then MsgBox "Ошибка ввода: | X | > 1", _

vbCritical, "Ошибка!": Text1.SetFocus: Exit Sub

toch = CSng(Val(Text2.Text))

Label3.Caption = Format(Y(x, toch), "#0.00")

End Sub

Private Sub Command2_Click()

Load Form2

Form2.Show

End Sub

Private Sub Command3_Click()

End

End Sub

Программный код для формы2 выглядит так:

(General) (Declarations)

Option Explicit

Private Sub Command1_Click()

Dim nach!, kon!, x!, sh!, i%

nach = CSng(Val(Text1.Text))

If Abs(nach) <= 1 Then MsgBox "Ошибка ввода: | X | > 1", _

vbCritical, "Ошибка!": Text1.SetFocus: Exit Sub

kon = CSng(Val(Text2.Text))

If Abs(kon) <= 1 Then MsgBox "Ошибка ввода: | X | > 1", _

vbCritical, "Ошибка!": Text2.SetFocus: Exit Sub

sh = CSng(Val(Text3.Text))

x = nach: i = 0

Form2.Picture1.Cls

Form2.Picture1.Print " Таблица"

Form2.Picture1.Print "-------------------------------"

Form2.Picture1.Print " Х Y"

Form2.Picture1.Print "-------------------------------"

Form2.Picture1.Print " "; Format(x, "#0.00"), Format(Y(x, toch), "#0.00")

i = i + 1

If i Mod 6 = 0 Then

Form2.Picture1.Print "-----------------------------"

MsgBox "Нажмите ОК", 64, "Продолжение таблицы"

Form2.Picture1.Cls

Form2.Picture1.Print " Таблица"

Form2.Picture1.Print "-------------------------------"

Form2.Picture1.Print " Х Y"

Form2.Picture1.Print "-------------------------------"

End If

x = x + sh

Loop Until x > kon

Form2.Picture1.Print "-------------------------------"

End Sub

Окончательный результат работы программы – на рисунках 5, 6 и 7:

Рисунок 5

Рисунок 6

Рисунок 7

Задание №6

Исходные данные о предприятиях. Для каждого предприятия задано: код, название, год начала реконструкции (не ранее 2010 года), планируемые затраты на каждый из трех лет реконструкции. Число предприятий не определено. Используя данные в файле, найти предприятие с наименьшими суммарными затратами на реконструкцию. При этом обеспечить возможность:

создания файла;
добавления новых записей в файл;
удаления записи с заданным номером из файла;
корректировки записи с заданным номером в файле;
исправления кода предприятия;
сортировки записей в файле по суммарным затратам на реконструкцию (по возрастанию), затем по году начала реконструкции (по убыванию), а внутри – по алфавиту кода предприятия;
просмотра содержимого файла после выполнения любой из перечисленных операций с файлом.

Форма с меню, созданном в Редакторе меню, будет выглядеть так:

Программный код представлен далее:

(General) (Declarations)

Option Explicit

Private Type factory

kod As String * 4

name As String * 12

god As Integer

costs(1 To 3) As Single

End Type

Dim f As factory

Private Sub mnuExit_Click()

End

End Sub

Private Sub mnuFileNew_Click() 'создание

Dim yn As String * 1

Dim i As Byte, j As Byte, k As Byte

Open "new.dat" For Random As #1 Len = Len(f)

i = 0

i = i + 1

With f

.kod = InputBox("Введите код " & i & "-го предприятия", _

"Ввод данных", , 2000, 500)

.name = InputBox("Введите название " & i & "-го предприятия", _

"Ввод данных", , 2000, 500)

m2: .god = CInt(InputBox("Введите год начала реконструкции (не ранее 2010 г.) " _

& i & "-го предприятия", "Ввод данных", , 2000, 500))

If .god < 2010 Then GoTo m1 Else GoTo m3

m1: k = MsgBox("Не ранее 2010 года!", vbCritical, "Ошибка ввода!")

GoTo m2

m3: For j = 1 To 3

.costs(j) = CSng(InputBox("Введите планируемые затраты на " _

& j & "-й год реконструкции " & i & "-го предприятия", _

"Ввод данных", , 2000, 500))

Next j

GoTo m4

m4: End With

Put #1, , f

yn = InputBox("Введите Y, y, Д или д если хотите закончить ввод", _

"Ввод данных", , 2000, 500)

Loop Until yn = "Y" Or yn = "y" Or yn = "Д" Or yn = "д"

Close #1

End Sub

Private Sub mnuFileList_Click() 'просмотр

Dim i As Byte, j As Byte

Open "new.dat" For Random As #1 Len = Len(f)

Text1.Text = Space(30) & "Затраты на годы реконстр." & vbCrLf

Text1.Text = Text1.Text + _

"Код Название Начало на 1-й на 2-й на 3-й" & vbCrLf

Text1.Text = Text1.Text + " реконстр." & vbCrLf

For i = 1 To LOF(1) \ Len(f)

Get #1, , f

Text1.Text = Text1.Text & f.kod & " " & f.name & " " & f.god & " г."

For j = 1 To 3

Text1.Text = Text1.Text & " " & f.costs(j) & "$"

Next j

Text1.Text = Text1.Text & vbCrLf

Next i

Close #1

End Sub

Private Sub mnuFileAdd_Click() 'добавление

Dim yn As String * 1

Dim i As Byte, k As Byte

Dim j As Byte

Open "new.dat" For Random As #1 Len = Len(f)

i = LOF(1) \ Len(f)

Seek #1, i + 1

i = i + 1

With f

.kod = InputBox("Введите код " & i & "-го предприятия", _

"Ввод данных", , 2000, 500)

.name = InputBox("Введите название " & i & "-го предприятия", _

"Ввод данных", , 2000, 500)

m2: .god = CInt(InputBox("Введите год начала реконструкции (не ранее 2010 г.) " _

& i & "-го предприятия", "Ввод данных", , 2000, 500))

If .god < 2010 Then GoTo m1 Else GoTo m3

m1: k = MsgBox("Не ранее 2010 года!", vbCritical, "Ошибка ввода!")

GoTo m2

m3: For j = 1 To 3

.costs(j) = CSng(InputBox("Введите планируемые затраты на " _

& j & "-й год реконструкции " & i & "-го предприятия", _

"Ввод данных", , 2000, 500))

Next j

GoTo m4

m4: End With

Put #1, , f

yn = InputBox("Введите Y, y, Д или д если хотите закончить ввод", _

"Ввод данных", , 2000, 500)

Loop Until yn = "Y" Or yn = "y" Or yn = "Д" Or yn = "д"

Close #1

End Sub

Private Sub mnuFileDel_Click() 'удаление

Dim N As Byte, i As Byte, p As Byte

Open "new.dat" For Random As #1 Len = Len(f)

Open "new1.dat" For Random As #2 Len = Len(f)

m1: N = CByte(InputBox("Введите номер удаляемой записи", _

"Ввод данных", , 2000, 500))

If N > (LOF(1) \ Len(f)) Then

p = MsgBox("В файле всего " & (LOF(1) \ Len(f)) & " записей!", vbCritical, _

"Ошибка ввода!")

GoTo m1

Else: GoTo m2

m2: For i = 1 To N - 1

Get #1, , f

Put #2, , f

Next i

Seek #1, N + 1

For i = N + 1 To LOF(1) \ Len(f)

Get #1, , f

Put #2, , f

Next i

End If

Close #1, #2

Kill "new.dat"

Name "new1.dat" As "new.dat"

End Sub

Private Sub mnuFileChange_Click() 'изменить запись

Dim N As Byte, j As Byte, k As Byte, p As Byte

Open "new.dat" For Random As #1 Len = Len(f)

Text1.Text = Space(30) & "Затраты на годы реконстр." & vbCrLf

Text1.Text = Text1.Text + _

"Код Название Начало на 1-й на 2-й на 3-й" & vbCrLf

Text1.Text = Text1.Text + " реконстр." & vbCrLf

m5: N = CByte(InputBox("Введите номер исправляемой записи ", _

"Ввод данных", , 2000, 500))

If N > (LOF(1) \ Len(f)) Then

p = MsgBox("В файле всего " & (LOF(1) \ Len(f)) & " записей!", vbCritical, _

"Ошибка ввода!")

GoTo m5

Else: GoTo m6

m6: Seek #1, N

Get #1, , f

Text1.Text = Text1.Text & f.kod & " " & f.name & " " & f.god & " г. "

For j = 1 To 3

Text1.Text = Text1.Text & " " & f.costs(j) & "$"

Next j

Text1.Text = Text1.Text & vbCrLf

With f

.kod = InputBox("Введите код " & N & "-го предприятия", _

"Ввод данных", .kod, 2000, 500)

Text1.Text = Text1.Text & .kod

.name = InputBox("Введите название " & N & "-го предприятия", _

"Ввод данных", .name, 2000, 500)

Text1.Text = Text1.Text & " " & .name

m2: .god = CInt(InputBox("Введите год начала реконструкции (не ранее 2010 г.) " _

& N & "-го предприятия", "Ввод данных", .god, 2000, 500))

If .god < 2010 Then GoTo m1 Else GoTo m3

m1: k = MsgBox("Не ранее 2010 года!", vbCritical, "Ошибка ввода!")

GoTo m2

m3: Text1.Text = Text1.Text & " " & .god & " г. "

For j = 1 To 3

.costs(j) = CSng(InputBox("Введите планируемые затраты на " _

& j & "-й год реконструкции " & N & "-го предприятия", _

"Ввод данных", .costs(j), 2000, 500))

Text1.Text = Text1.Text & " " & .costs(j) & "$"

GoTo m4

m4: End With

Text1.Text = Text1.Text & vbCrLf

Seek #1, N

Put #1, , f

End If

Close #1

End Sub

Private Sub mnuFileChKOD_Click() 'изменение кода

Dim nazv As String * 12, izkod As String * 4, k As Boolean, j As Byte

Open "new.dat" For Random As #1 Len = Len(f)

nazv = InputBox("Введите название предприятия", "Изменение кода предприятия", _

, 2000, 500)

Text1.Text = Space(30) & "Затраты на годы реконстр." & vbCrLf

Text1.Text = Text1.Text + _

"Код Название Начало на 1-й на 2-й на 3-й" & vbCrLf

Text1.Text = Text1.Text + " реконстр." & vbCrLf

k = True

Do While Not EOF(1)

Get #1, , f

If f.name = nazv Then

Text1.Text = Text1.Text & f.kod & " " & f.name & " " & f.god & " г."

For j = 1 To 3

Text1.Text = Text1.Text & " " & f.costs(j) & "$"

Next j

Text1.Text = Text1.Text & vbCrLf

k = False

Exit Do

End If

Loop

If k Then

MsgBox "Предприятия " & nazv & " нет в списке", 16, "Остановка"

Else

izkod = InputBox("Введите новый код предприятия " & nazv, "Ввод данных", _

f.kod, 2000, 500)

f.kod = izkod

Text1.Text = Text1.Text & f.kod & " " & f.name & " " & f.god & " г."

For j = 1 To 3

Text1.Text = Text1.Text & " " & f.costs(j) & "$"

Next j

Text1.Text = Text1.Text & vbCrLf

Seek #1, Seek(1) - 1

Put #1, , f

End If

Close #1

End Sub

Private Sub mnuMin_Click() 'предпр. с наим.сумм.затр.на реконстр.

Dim i As Byte, j As Byte, min!, N As Byte, sum!

Open "new.dat" For Random As #1 Len = Len(f)

Text1.Text = _

"Предприятие с наим. суммарными затратами на реконструкцию" _

& vbCrLf & vbCrLf

Text1.Text = Text1.Text + Space(30) & "Затраты на годы реконстр." _

& vbCrLf

Text1.Text = Text1.Text + _

"Код Название Начало на 1-й на 2-й на 3-й" & vbCrLf

Text1.Text = Text1.Text + " реконстр." & vbCrLf

min = 100000000

For i = 1 To LOF(1) \ Len(f)

Get #1, , f

sum = 0

For j = 1 To 3

sum = sum + f.costs(j)

Next j

If min > sum Then

min = sum

N = Seek(1) - 1

End If

Next i

Get #1, N, f

Text1.Text = Text1.Text & f.kod & " " & f.name & " " & f.god & " г."

For j = 1 To 3

Text1.Text = Text1.Text & " " & f.costs(j) & "$"

Next j

Text1.Text = Text1.Text & vbCrLf & vbCrLf

Text1.Text = Text1.Text & "Cуммарные затраты = " & min & "$"

Close #1

End Sub

Private Sub mnuFileSort_Click() 'сортировка

Dim f1 As factory, k As Boolean, i As Byte, j As Byte, c As Byte, sum1!, sum!

Open "new.dat" For Random As #1 Len = Len(f)

sum = 0: sum1 = 0

For j = 1 To 3

sum = sum + f.costs(j)

sum1 = sum1 + f1.costs(j)

Next j

k = True

Do While k

k = False

For i = 1 To LOF(1) \ Len(f) - 1

For c = i + 1 To LOF(1) \ Len(f)

Get #1, i, f

Get #1, c, f1

If sum > sum1 Then

Put #1, i, f1

Put #1, c, f

k = True

ElseIf sum = sum1 And f.god < f1.god Then

Put #1, i, f1

Put #1, c, f

k = True

ElseIf sum1 = sum And f.god = f1.god And f.kod > f1.kod Then

Put #1, i, f1

Put #1, c, f

k = True

End If

Next c

Next i

Loop

Close #1

Text1.Text = " Сортировка произведена" & vbCrLf

End Sub

Private Sub Timer1_Timer()

Label1.Caption = Date & Space(7) & Time

End Sub

Результаты работы программы – на рисунках 8, 9; 10, 11 и 12:

Рисунок 8

Рисунок 9

Рисунок 10

Рисунок 11

Рисунок 12

Задание №7

Объединение предыдущих заданий в один комплекс.

Форма с созданным в Редакторе меню меню будет иметь вид:

Программный код в данном случае выглядит так:

(General) (Declarations)

Option Explicit

Dim a As Double

Dim WindowStyle As VbAppWinStyle

Private Sub Form_Load()

FileCopy "..\Zad6\new.dat", "..\Zad7\new.dat"

End Sub

Private Sub Form_Unload(Cancel As Integer)

FileCopy "new.dat", "..\Zad6\new.dat"

End Sub

Private Sub mnuSum_Click()

a = Shell("..\Zad1\Project1.exe", WindowStyle = vbNormalFocus)

End Sub

Private Sub mnuCalc_Click()

a = Shell("..\Zad2\Project1.exe", WindowStyle = vbNormalFocus)

End Sub

Private Sub mnuInfo_Click()

a = Shell("..\Zad3\Project1.exe", WindowStyle = vbNormalFocus)

End Sub

Private Sub mnuFact_Click()

a = Shell("..\Zad4\Project1.exe", WindowStyle = vbNormalFocus)

End Sub

Private Sub mnuSeries_Click()

a = Shell("..\Zad5\Project1.exe", WindowStyle = vbNormalFocus)

End Sub

Private Sub mnuBase_Click()

a = Shell("..\Zad6\Project1.exe", WindowStyle = vbNormalFocus)

End Sub

Private Sub mnuExit_Click()

End

End Sub

Результаты работы формы представлены на рисунках 13, 14; 15 и 16:

Рисунок 13

Рисунок 14

Рисунок 15

Рисунок 16

Соседние файлы в папке Курсач по Visual Basic Проектирование прилож

#
16.12.201322.02 Кб111Title-page.doc
#
16.12.201323.55 Кб142Contents.doc
#
16.12.201328.67 Кб123Task.doc
#
16.12.201332.26 Кб124Intro.doc
#
16.12.20131.2 Mб125Term paper.doc
#
16.12.201323.04 Кб116Conclusion.doc