50248 (Программирование в Бейсике), страница 2

2016-07-30СтудИзба

Описание файла

Документ из архива "Программирование в Бейсике", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.

Онлайн просмотр документа "50248"

Текст 2 страницы из документа "50248"

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

1.Визуализация движения автобусов

For i = 0 To (AllBuses - 1)

Fuel(i) = Fuel(i) - 1 / (10000 * Me.Timer1.Interval)

If i = Misk Then Me.Label13.Caption = Str$(Fuel(Misk))

If Fuel(i) = 0 Then Fuel(i) = 100

Next i

For z = 0 To (Combo1.ListCount - 1)

For i = 0 To (arBusCount(z) - 1)

If z <> 0 Then

a = i

For j = 0 To (z - 1)

i = i + arBusCount(j)

Next j

End If

If arStayPast(z, i) = (arStayCount(z) - 1) Then arStayEdit(z, i)= -1

If arStayPast(z, i) = 0 Then arStayEdit(z, i) = 1

If Val(arStayAbsciss(z, arStayPast(z, i))) > Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arCoordEdit(z, i) = -1

If Val(arStayAbsciss(z, arStayPast(z, i))) < Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arCoordEdit(z, i) = 1

If Val(arStayAbsciss(z, arStayPast(z, i))) = Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arCoordEdit(z, i) = 0

k(z, i) = (Val(arStayOrdinata(z, arStayPast(z, i))) - Val(arStayOrdinata(z, arStayPast(z, i) + arStayEdit(z, i)))) / _

(Val(arStayAbsciss(z, arStayPast(z, i))) - Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))))

b(z, i) = Val(arStayOrdinata(z, arStayPast(z, i))) - k(z, i) * Val(arStayAbsciss(z, arStayPast(z, i)))

Dim c As Single

c = Cos(Atn(k(z, i)))

x0(z, i) = x0(z, i) + c * 2 * arCoordEdit(z, i)

y0(z, i) = k(z, i) * x0(z, i) + b(z, i)

Image1(i).Move x0(z, i) - Image1(i).Width / 2, y0(z, i) - Me.Image1(i).Height / 2

If arCoordEdit(z, i) = 1 Then

If x0(z, i) >= Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arStayPast(z, i) = arStayPast(z, i) + arStayEdit(z, i)

End If

If arCoordEdit(z, i) = -1 Then

If x0(z, i) <= Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i)))_

Then arStayPast(z, i) = arStayPast(z, i) + arStayEdit(z, i)

End If

If z <> 0 Then i = a

Next i

Next z

End Sub

где k(z, i) – угловой коэффициент уравнения движения автобуса " i " по маршруту " z "; b(z, i) – свободный член того же уравнения; arCoordEdit(z, i) – в какую сторону изменять координату автобуса; arStayPast(z, i), arStayEdit(z, i) – соответственно последняя остановка, которую прошел автобус, и величина, показывающая в какую сторону будут изменяться остановки; с – изменение координаты автобуса по X; x0(z, i), y0(z, i) – промежуточные координаты автобуса. В данной процедуре программа сама проверяет в какую сторону должен двигаться определенный автобус, как должна изменяться его координата и где следующий момент времени он будет находиться.

2.Работа с текстовыми файлами при считывании информации об определенном маршруте

Public Static Sub Work_With_Files()

arBusCount(Mis) = 0

arStayCount(Mis) = 0

Open "c:\Курсовая моя\" + Combo1.List(Mis) + ".txt" For Input As 2

Do While Not EOF(2)

Input #2, a$

Select Case a$

Case "автобус": Input #2, arBusNumber(Mis, arBusCount(Mis))

Case "водитель": Input #2, arDriveName(Mis, arBusCount(Mis))

Case "кондуктор": Input #2, arConductorName(Mis, arBusCount(Mis))

arBusCount(Mis) = arBusCount(Mis) + 1

Case "остановка": Input #2, arStayName(Mis, arStayCount(Mis))

Input #2, arStayAbsciss(Mis, arStayCount(Mis))

Input #2, arStayOrdinata(Mis, arStayCount(Mis))

arStayCount(Mis) = arStayCount(Mis) + 1

End Select

Loop

Close 2

End Sub

где Mis – номер текущего маршрута, файл которого читается.

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

Вывод

В данной программе удалось полностью реализовать поставленную задачу.

С помощью Visual Basic получили:

Программу - модель работы оператора по управлению автобусами

Обеспечили возможность управления движением автобусов по каждому из предложенных, созданных или уже существующих маршрутов.

Предоставили возможность изменения данных по маршруту: непосредственно имени самого маршрута, возможность добавить или удалить автобус, а также изменить данные по автобусам: имена водителя и кондуктора; удалить, добавить, переместить, переименовать остановки или вообще изменить направление движения по маршруту, поменять порядок прохождения остановок автобусами данного маршрута, плюс удаление самого маршрута при необходимости.

Обеспечили возможности создания своего маршрута, а также корректировки данных (бортовой номер) по свободным автобусам (которые могут быть задействованы, если это необходимо).

Плюс ко всему, смоделировали (визуализировать) наглядное движение автобусов с учетом зависимости скорости автобусов от времени суток.

Список использованной литературы

1.Visual Basic 6.0 – Мастер – Разработка приложений. Санкт – Петербург, " БХВ - Петербург", 2000

2.Самоучитель по Visual Basic 6.0

Приложение

Form1

Public EditBus As Boolean

Public EditLine As Boolean

Dim DooM As Boolean, Doomy As Boolean, Do_Do As Boolean

Dim Mis As Integer, Mi As Integer

Dim Misk As Integer, disk As Integer

Dim w As Single

Dim arLinesName(0 To 30) As String, LinesCount As Integer '30 - max маршрутов

Dim arBusNumber(0 To 30, 0 To 25) As String, arBusCount(0 To 30) As Integer

Dim AllBuses As Integer '25 - max автобусов

Dim arDriveName(0 To 30, 0 To 25) As String

Dim arConductorName(0 To 30, 0 To 25) As String

Dim arStayName(0 To 30, 0 To 35) As String ' 35 max остановок на одном маршруте

Dim arStayAbsciss(0 To 30, 0 To 35) As String

Dim arStayOrdinata(0 To 30, 0 To 35) As String

Dim arStayCount(0 To 30) As Integer

Dim arName(0 To 30, 0 To 35) As String ' 35 - max остановок на одном маршруте

Dim arAbsciss(0 To 30, 0 To 35) As String

Dim arOrdinata(0 To 30, 0 To 35) As String

Dim arFreeBuses(0 To 100) As String

Dim q As Integer, food As Boolean, Boom As Boolean

Dim e As Integer, mx As Single, my As Single

Dim zzz As Integer, zxz As Integer

Dim aa As Integer, x0 As Single, y0 As Single, nama(0 To 30, 0 To 35) As String

Private Sub Combo1_Click()

Mi = 0

Misk = 0

Boom = True

disk = 999

Do_Do = False

Doomy = False

Command4.Enabled = False

Command5.Enabled = False

Command6.Enabled = False

Combo2.Clear

Combo3.Clear

Combo4.Clear

Text1.Text = "": Text2.Text = "": Text3.Text = "": Text4.Text = ""

Me.Picture1.Visible = True

Combo2.Enabled = True: Combo4.Enabled = True

Command1.Enabled = True: Command2.Enabled = True: Command3.Enabled = True: Command7.Enabled = True

Command5.Enabled = True

Mis = Combo1.ListIndex

If Len(Dir("c:\Курсовая моя\" + Combo1.List(Mis) + ".txt")) = 0 Then

MsgBox "Файл маршрута не найден" + vbCrLf + _

"Проверьте его наличие: 'c:\Курсовая моя\" + Combo1.List(Mis) + ".txt'"

Exit Sub

Else

Files

End If

For i = 0 To arBusCount(Mis) - 1

Combo2.AddItem arBusNumber(Mis, i)

Next i

For i = 0 To 35

Image1(i).Picture = LoadPicture("c:\Курсовая моя\Иконки\Icon2.ico")

Next i

Picture1.Cls

For i = 1 To 35

Me.Image1(i).Visible = False

Me.Label14(i).Visible = False

Next i

Me.Picture1.PSet (arStayAbsciss(Mis, 0), arStayOrdinata(Mis, 0))

w = Me.Image1(0).Width / 2

Me.Image1(0).Move arStayAbsciss(Mis, 0) - w, arStayOrdinata(Mis, 0) - w

Me.Label14(0).Move Image1(0).Left + 2 * w, Image1(0).Top

Me.Label14(0).Caption = arStayName(Mis, 0)

For i = 0 To (arStayCount(Mis) - 1)

Me.Picture1.Line -(arStayAbsciss(Mis, i), arStayOrdinata(Mis, i))

Me.Image1(i).Move arStayAbsciss(Mis, i) - w, arStayOrdinata(Mis, i) - w

Me.Image1(i).Visible = True

Me.Label14(i).Visible = True

Me.Label14(i).Move Image1(i).Left + 2 * w, Image1(i).Top

Me.Label14(i).Caption = arStayName(Mis, i)

Me.Combo4.AddItem arStayName(Mis, i)

Next i

End Sub

Private Sub Combo2_Click()

DooM = False

Text2.Enabled = True: Text3.Enabled = True

Me.Command8.Enabled = True

Misk = Combo2.ListIndex

Text1.Text = arBusNumber(Mis, Misk)

Text2.Text = arDriveName(Mis, Misk)

Text3.Text = arConductorName(Mis, Misk)

End Sub

Private Sub Combo3_Click()

DooM = True

Text2.Enabled = True: Text3.Enabled = True

Mi = Combo3.ListIndex

Text1.Text = Combo3.List(Mi)

Text2.Text = ""

Text3.Text = ""

End Sub

Private Sub Combo4_Click()

disk = Combo4.ListIndex

Text4.Enabled = True

Text4.Text = Combo4.List(disk)

For i = 0 To 35

If Label14(i).Caption = Combo4.List(disk) Then

Image1(i).Picture = LoadPicture("c:\Курсовая моя\Иконки\!conMania.cur")

Else

Image1(i).Picture = LoadPicture("c:\ Курсовая моя\Иконки \Icon2.ico")

End If

Next i

End Sub

Private Sub Combo5_Click()

zxz = Combo5.ListIndex

Text7.Text = Combo5.List(zxz)

Text6.Text = ""

Text5.Text = ""

Command11.Enabled = True

Text5.Enabled = True

Text6.Enabled = True

End Sub

Private Sub Combo7_Click()

Text9.Enabled = True

Text9.Text = nama(LinesCount - 1, Combo7.ListIndex)

End Sub

Private Sub Command1_Click()

If Len(Dir("c:\Курсовая моя\Свободные автобусы.txt")) = 0 Then

MsgBox "Файл свободных автобусов не найден!!!" + vbCrLf + _

"Проверьте его наличие : 'c:\ Курсовая моя\Свободные автобусы.txt'"

Exit Sub

End If

Combo3.Enabled = True

i = 0

Open "c:\ Курсовая моя\Свободные автобусы.txt" For Input As 3

Do While Not EOF(3)

Input #3, arFreeBuses(i)

Combo3.AddItem arFreeBuses(i)

i = i + 1

Loop

Close 3

End Sub

Private Sub Command10_Click()

If Command10.Caption = "Начать последовательность остановок" Then

Command7.Enabled = False

food = True

q = 0

Else

Command7.Enabled = True

food = False

Combo4.Enabled = False

Text4.Enabled = False

Command3.Enabled = False

Command4.Enabled = False

Command5.Enabled = False

Command6.Enabled = False

End If

End Sub

Private Sub Command11_Click()

Combo6.Enabled = True

If Text7.Text = "" Or Text6.Text = "" Or Text5.Text = "" Then

MsgBox "Все поля должны быть заполнены!!!"

Exit Sub

End If

arBusNumber(LinesCount - 1, zzz) = LTrim(Str$(LinesCount - 1 + 1) + Combo5.List(zxz))

arDriveName(LinesCount - 1, zzz) = Text6.Text

arConductorName(LinesCount - 1, zzz) = Text5.Text

Combo6.AddItem arBusNumber(LinesCount - 1, zzz)

Combo5.RemoveItem Mi

zzz = zzz + 1

End Sub

Private Sub Command12_Click()

If Len(Dir("c:\ Курсовая моя\Свободные автобусы.txt")) = 0 Then

MsgBox "Файл свободных автобусов не найден!!!" + vbCrLf + _

"Проверьте его наличие : 'c:\ Курсовая моя\Свободные автобусы.txt'"

Exit Sub

End If

Combo3.Enabled = True

Combo5.Enabled = True

End Sub

Private Sub Command13_Click()

If Text8.Text = "" Then MsgBox "Напишите название маршруту!!!": Exit Sub

If Len(Dir("c:\ Курсовая моя\Маршруты.txt")) = 0 Then

MsgBox "Файл маршрутов не найден!!!" + vbCrLf + _

"Проверьте его наличие : 'c:\ Курсовая моя\Маршруты.txt'"

Combo1.Enabled = False

Label11.Visible = False

Exit Sub

End If

Open "c:\ Курсовая моя\Маршруты.txt" For Append As 1

Print #1, Text8.Text

Close 1

Open "c:\курсовая моя\" + Text8.Text + ".txt" For Output As 3

For zzz = 0 To (Combo6.ListCount - 1)

Print #3, "автобус,", arBusNumber(LinesCount - 1, zzz)

Print #3, "водитель,", arDriveName(LinesCount - 1, zzz)

Print #3, "кондуктор,", arConductorName(LinesCount - 1, zzz)

Next zzz

For i = 0 To (Combo7.ListCount - 1)

Print #3, "остановка,", nama(LinesCount - 1, i), ",", Combo7.List(i)

Next i

Close 3

Open "c:\ Курсовая моя\Свободные автобусы.txt" For Output As 6

For i = 0 To (Combo5.ListCount - 1)

Print #6, Combo5.List(i)

Next i

Close 6

mnuNewLine_Click

End Sub

Private Sub Command14_Click()

Frame2.Visible = False

End Sub

Private Sub Command15_Click()

Frame1.Visible = False

End Sub

Private Sub Command16_Click()

If Text9.Text = "" Then MsgBox "Напишите название остановки!!!" Else _

nama(LinesCount - 1, Combo7.ListIndex) = Text9.Text

End Sub

Private Sub Command17_Click()

Picture2.Cls

Combo6.Clear: Combo6.Enabled = False

Combo5.Enabled = False

Text6.Text = "": Text6.Enabled = False

Text5.Text = "": Text5.Enabled = False

Command11.Enabled = False

Combo7.Enabled = False: Combo7.Clear

Text9.Text = "": Text9.Enabled = False

Command16.Enabled = False: Command13.Enabled = False

End Sub

Private Sub Command2_Click()

If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then

MsgBox "Все поля должны быть заполнены!!!"

Exit Sub

End If

Select Case DooM

Case False: arDriveName(Mis, Misk) = Text2.Text

arConductorName(Mis, Misk) = Text3.Text

Case True: arBusNumber(Mis, Combo2.ListCount) = LTrim(Str$(Mis + 1) + Combo3.List(Mi))

arDriveName(Mis, Combo2.ListCount) = Text2.Text

arConductorName(Mis, Combo2.ListCount) = Text3.Text

Combo2.AddItem arBusNumber(Mis, Combo2.ListCount), Combo2.ListCount

Combo3.RemoveItem Mi

End Select

End Sub

Private Sub Command3_Click()

Doomy = True

Picture1.Cls

Command4.Enabled = True

Command5.Enabled = True

Command6.Enabled = True

End Sub

Private Sub Command4_Click()

If Doomy = True Then

If disk <> 999 Then

Image1(disk).Visible = False

Label14(disk).Visible = False

Combo4.List(disk) = " - "

End If

disk = 999

End If

End Sub

Private Sub Command5_Click()

Text4.Enabled = True

If Doomy = True Then Exit Sub

If disk <> 999 Then

If Do_Do = True Then

If Text4.Text = "" Then

MsgBox "напишите название остановки!!!"

Else

arStayName(Mis, disk) = Text4.Text

For i = 0 To 35

If Label14(i).Caption = Combo4.List(disk) Then Label14(i).Caption = Text4.Text

Next i

Me.Combo4.List(disk) = Text4.Text

Do_Do = False

End If

End If

End If

End Sub

Private Sub Command6_Click()

If Boom = True Then

If disk <> 999 Then Image1(disk).DragMode = 1

Else

If disk <> 999 Then Image1(disk).DragMode = 0

Boom = True

End If

End Sub

Private Sub Command7_Click()

Open "c:\Курсовая моя\" + Combo1.List(Mis) + ".txt" For Output As 5

For i = 0 To (Combo2.ListCount - 1)

If Combo2.List(i) <> " - " Then

Print #5, "автобус,", Combo2.List(i)

Print #5, "водитель,", arDriveName(Mis, i)

Print #5, "кондуктор,", arConductorName(Mis, i)

End If

Next i

If Command10.Caption = "Сохранить все сделанные изменения" Then

For i = 0 To (Combo4.ListCount - 1)

If Combo4.List(i) <> " - " Then _

Print #5, "остановка,", arStayName(Mis, i), ",", arStayAbsciss(Mis, i), ",", arStayOrdinata(Mis, i)

Next i

Else

For i = 0 To (Combo4.ListCount - 1)

If Combo4.List(i) <> " - " Then _

Print #5, "остановка,", arName(Mis, i), ",", arAbsciss(Mis, i), ",", arOrdinata(Mis, i)

Next i

End If

Close 5

Open "c:\ Курсовая моя\Свободные автобусы.txt" For Output As 6

For i = 0 To (Combo3.ListCount - 1)

Print #6, Combo3.List(i)

Next i

Close 6

End Sub

Private Sub Command8_Click()

If DooM = True Then MsgBox "Нечего удалять!!!"

If DooM = False Then

Combo2.List(Misk) = " - "

If Len(Dir("c:\ Курсовая моя\Свободные автобусы.txt")) = 0 Then

MsgBox "Файл маршрутов не найден!!!" + vbCrLf + _

"Проверьте его наличие : 'c:\ Курсовая моя\Свободные автобусы.txt'"

Exit Sub

End If

Open "c:\ Курсовая моя\Свободные автобусы.txt" For Append As 7

Print #7, arBusNumber(Mis, Misk)

Close 7

End If

End Sub

Private Sub Command9_Click()

If Len(Dir("c:\ Курсовая моя\маршруты.txt")) = 0 Then

MsgBox " Файл маршрутов не найден!!!" + vbCrLf + _

" Проверьте его наличие: 'c:\ Курсовая моя\маршруты.txt'"

Combo1.Enabled = False

Label11.Visible = False

Exit Sub

End If

Open "c:\ Курсовая моя\маршруты.txt" For Output As 4

For i = 0 To (Combo1.ListCount - 1)

If i <> Mis Then Print #4, Combo1.List(i)

Next i

Close 4

Open "c:\Êóðñîâàÿ ìîÿ\" + Combo1.List(Mis) + ".txt" For Output As 4

Close 4

End Sub

Private Sub Form_Load()

aa = 0

q = 999

For i = 1 To 35

Load Image1(i)

Load Label14(i)

Me.Image1(i).Visible = False

Me.Label14(i).Visible = False

Next i

disk = 999

End Sub

Private Sub Image1_Click(Index As Integer)

w = Image1(0).Width / 2

If q = 0 Then

Picture1.PSet (Image1(Index).Left, Image1(Index).Top)

Combo4.Clear

End If

If food = True Then

Command10.Caption = "Çàïîìíèòü"

arName(Mis, q) = arStayName(Mis, Index)

arAbsciss(miss, q) = arStayAbsciss(Mis, Index)

arOrdinata(miss, q) = arStayOrdinata(Mis, Index)

Combo4.AddItem arName(Mis, q)

Picture1.Line -(arStayAbsciss(Mis, Index), arStayOrdinata(Mis, Index))

q = q + 1

Else

disk = Index

Combo4.ListIndex = disk

End If

End Sub

Private Sub mnuEditLine_Click()

Combo1.Clear

Me.Frame1.Visible = True

If Len(Dir("c:\ Курсовая моя\маршруты.txt")) = 0 Then

MsgBox " Файл маршрутов не найден!!!" + vbCrLf + _

"Ïðîâåðüòå åãî íàëè÷èå : 'c:\ Курсовая моя\маршруты.txt'"

Combo1.Enabled = False

Label11.Visible = False

Exit Sub

End If

Open "c:\ Курсовая моя\маршруты.txt" For Input As 1

LinesCount = 0

Do While Not EOF(1)

Input #1, arLinesName(LinesCount)

Combo1.AddItem arLinesName(LinesCount)

LinesCount = LinesCount + 1

Loop

Close 1

End Sub

Private Sub mnuFree_Click()

If Len(Dir("c:\ Курсовая моя\Свободные автобусы.txt")) = 0 Then

MsgBox " Файл маршрутов не найден!!!" + vbCrLf + _

" Проверьте его наличие: 'c:\ Курсовая моя\Свободные автобусы.txt"

Exit Sub

End If

Retval = Shell("NotePad.exe c:\ Курсовая моя\Свободные автобусы.txt", 1)

End Sub

Private Sub mnuLines_Click()

Form2.Show

End Sub

Public Static Sub Files()

arBusCount(Mis) = 0

arStayCount(Mis) = 0

Open "c:\Êóðñîâàÿ ìîÿ\" + Combo1.List(Mis) + ".txt" For Input As 2

Do While Not EOF(2)

Input #2, a$

Select Case a$

Case "автобус": Input #2, arBusNumber(Mis, arBusCount(Mis))

Case "водитель": Input #2, arDriveName(Mis, arBusCount(Mis))

Case "кондуктор": Input #2, arConductorName(Mis, arBusCount(Mis))

arBusCount(Mis) = arBusCount(Mis) + 1

Case "остановка": Input #2, arStayName(Mis, arStayCount(Mis))

Input #2, arStayAbsciss(Mis, arStayCount(Mis))

Input #2, arStayOrdinata(Mis, arStayCount(Mis))

arStayCount(Mis) = arStayCount(Mis) + 1

End Select

Loop

Close 2

End Sub

Private Sub Image1_DragOver(Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)

If e = 0 Then

mx = X

my = Y

e = 1

End If

End Sub

Private Sub mnuNewLine_Click()

zzz = 0

Frame1.Visible = False

Frame2.Visible = True

If Len(Dir("c:\ Курсовая моя\маршруты.txt")) = 0 Then

MsgBox " Файл маршрутов не найден í!!!" + vbCrLf + _

"Ïðîâåðüòå åãî íàëè÷èå : 'c:\ Курсовая моя\маршруты.txt'"

Combo1.Enabled = False

Label11.Visible = False

Exit Sub

End If

Open "c:\ Курсовая моя\маршруты.txt" For Input As 1

LinesCount = 0

Do While Not EOF(1)

Input #1, arLinesName(LinesCount)

Combo1.AddItem arLinesName(LinesCount)

LinesCount = LinesCount + 1

Loop

Close 1

i = 0

Open "c:\ Курсовая моя\Свободные автобусы.txt" For Input As 3

Do While Not EOF(3)

Input #3, arFreeBuses(i)

Combo5.AddItem arFreeBuses(i)

i = i + 1

Loop

Close 3

End Sub

Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)

Source.Move X - mx, Y - my: Label14(disk).Move X - mx + w * 2, Y - my

arStayAbsciss(Mis, disk) = Str$(X - mx)

arStayOrdinata(Mis, disk) = Str$(Y - my)

e = 0

Boom = False

Command6_Click

End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Doomy Then

If Text4.Text = "" Then MsgBox "Напишите название остановки!!!": Exit Sub

If Do_Do = False Then

Exit Sub

Else

If Text4.Text = "" Then MsgBox " Напишите название остановки!!!": Exit Sub

Image1(Combo4.ListCount).Visible = True

Image1(Combo4.ListCount).Move X - w, Y - w

Me.Label14(Combo4.ListCount).Visible = True

Me.Label14(Combo4.ListCount).Move Image1(Combo4.ListCount).Left + 2 * w, Image1(Combo4.ListCount).Top

Me.Label14(Combo4.ListCount).Caption = Text4.Text

arStayAbsciss(Mis, Combo4.ListCount) = Str$(X - w): arStayOrdinata(Mis, Combo4.ListCount) = (Y - w)

arStayName(Mis, Combo4.ListCount) = Text4.Text

Me.Combo4.AddItem arStayName(Mis, Combo4.ListCount)

Me.Text4.Text = ""

End If

Else

Exit Sub

End If

End Sub

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Combo7.Enabled = True

aa = aa + 1

Combo7.AddItem Str$(X) + "," + Str$(Y)

nama(LinesCount - 1, aa - 1) = Str$(aa - 1)

If aa <> 1 Then

Me.Picture2.Line -(X, Y)

Command13.Enabled = True

Else

Me.Picture2.PSet (X, Y)

End If

x0 = X: y0 = Y

End Sub

Private Sub Text4_Change()

Do_Do = True

End Sub

Private Sub Text9_Change()

Command16.Enabled = True

End Sub

Form2

Dim Boom As Boolean

Dim MovePossible As Boolean

Dim arLinesName(0 To 30) As String, LinesCount As Integer '30 max маршрутов

Dim arBusNumber(0 To 30, 0 To 25) As String, arBusCount(0 To 30) As Integer

Dim AllBuses As Integer '25 - max автлбусов

Dim arDriveName(0 To 30, 0 To 25) As String

Dim arConductorName(0 To 30, 0 To 25) As String

Dim arStayName(0 To 30, 0 To 35) As String ' 35 - max остановок на одном маршруте

Dim arStayAbsciss(0 To 30, 0 To 35) As String

Dim arStayOrdinata(0 To 30, 0 To 35) As String

Dim arStayCount(0 To 30) As Integer

Dim arStayPast(0 To 30, 0 To 25) As Integer последняя остановка автобуса

Dim arStayEdit(0 To 30, 0 To 25) As Integer в какую сторону изменять остановки

Dim arCoordEdit(0 To30,Dim k(0 To 30, 0 To 25) As Single в какую сторону изменять координаты

Dim b(0 To 30, 0 To 25) As Single угловой коэффициент при движении

Dim x0(0 To 30, 0 To 25) As Single

Dim y0(0 To 30, 0 To 25) As Single

Dim mx As Single '

Dim my As Single, p As Integer, Pisk As Integer

Public Mis As Integer определенный маршрут

Public Misk As Integer определенный автобус

Dim i As Integer

Dim w As Single

Const t0 = 4: Const t1 = 7: Const t2 = 10: Const t3 = 13

Const t4 = 15: Const t5 = 17: Const t6 = 20: Const t7 = 23

Dim Fuel(0 To 750) As Single

Private Sub Combo1_Click()

Me.mnuEditBuses.Enabled = True

Me.mnuMove.Enabled = True

Me.Command1.Enabled = True

For i = 0 To (AllBuses - 1)

Image1(i).Picture = LoadPicture("c:\ Курсовая моя\Иконки \Blue Bus.ico")

Next i

Me.Frame1.Visible = True

Me.Label2.Visible = True

Mi = Mis

Mis = Combo1.ListIndex

Me.Picture1.Visible = True

Me.Label9.Visible = True

arBusCount(Combo1.ListIndex) = 0

arStayCount(Combo1.ListIndex) = 0

If Len(Dir("c:\Êóðñîâàÿ ìîÿ\" + Combo1.List(Mis) + ".txt")) = 0 Then

MsgBox " Файл маршрутов не найден!!!" + vbCrLf + _

"Ïðîâåðüòå åãî íàëè÷èå : 'c:\Êóðñîâàÿ ìîÿ\" + Combo1.List(Mis) + ".txt'"

Combo1.ListIndex = Mi

Exit Sub

Else

Work_With_Files

End If

Picture1.Cls

For i = 1 To 35

Me.Image2(i).Visible = False

Me.Label14(i).Visible = False

Next i

Me.Picture1.PSet (arStayAbsciss(Mis, 0), arStayOrdinata(Mis, 0))

w = Me.Image2(0).Width / 2

Me.Image2(0).Move arStayAbsciss(Mis, 0) - w, arStayOrdinata(Mis, 0) - w

Me.Label14(0).Move Image2(0).Left + 2 * w, Image2(0).Top

Me.Label14(0).Caption = arStayName(Mis, 0)

For i = 0 To (arStayCount(Mis) - 1)

Me.Picture1.Line -(arStayAbsciss(Mis, i), arStayOrdinata(Mis, i))

Me.Image2(i).Move arStayAbsciss(Mis, i) - w, arStayOrdinata(Mis, i) - w

Me.Image2(i).Visible = True

Me.Label14(i).Visible = True

Me.Label14(i).Move Image2(i).Left + 2 * w, Image2(i).Top

Me.Label14(i).Caption = arStayName(Mis, i)

Next i

For i = 0 To (AllBuses - 1)

Image1(i).Visible = False

Next i

If Boom = True Then Boom = False: First_Stay_of_Buses

For i = 0 To (arBusCount(Combo1.ListIndex) - 1)

If Mis <> 0 Then

a = i

For j = 0 To (Mis - 1)

i = i + arBusCount(j)

Next j

Me.Image1(i).Visible = True

i = a

GoTo 1

Else

Me.Image1(i).Visible = True

End If

1: Next i

Me.Timer1 = True

If Misk <> 999 Then If Image1(Misk).Visible = True Then Image1_Click (Misk)

t = Time

tnow = Val(Mid$(Str$(t), 1, 2))

If tnow > t0 And tnow t2 And tnow t4 And tnow < t5 Or _

tnow > t6 And tnow <= t7 Then Label8.Caption = "60 êì/÷": Timer1.Interval = 5

If tnow >= t1 And tnow = t3 And tnow = t5 And tnow <= t6 Then _

Label8.Caption = "30 êì/÷": Timer1.Interval = 10

If tnow = 24 Or tnow >= 0 And tnow <= 4 Then Label8.Caption = " - ": 'Timer1.Enabled = False

Label13.Caption = "100"

End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

For z = 0 To (Combo1.ListCount - 1)

Me.Picture1.PSet (arStayAbsciss(z, 0), arStayOrdinata(z, 0))

For i = 0 To (arStayCount(z) - 1)

Me.Picture1.Line -(arStayAbsciss(z, i), arStayOrdinata(z, i)), QBColor(z + 3)

Next i

For i = 0 To (arBusCount(z) - 1)

If z <> 0 Then

a = i

For j = 0 To (z - 1)

i = i + arBusCount(j)

Next j

Me.Image1(i).Visible = True

i = a

GoTo 1

Else

Me.Image1(i).Visible = True

End If

1: Next i

Next z

End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Combo1_Click

End Sub

Private Sub Command2_Click()

Misk = 999

Unload Me

End Sub

Private Sub Form_Load()

Misk = 999

Boom = True

MovePossible = False

If Len(Dir("c:\ Курсовая моя\маршруты.txt")) = 0 Then

MsgBox " Файл маршрутов не найден!!!" + vbCrLf + _

" Проверьте его наличие: 'c:\ Курсовая моя\маршруты.txt'"

Combo1.Enabled = False

Label11.Visible = False

Exit Sub

End If

Open "c:\ Курсовая моя\маршруты.txt" For Input As 1

LinesCount = 0

Do While Not EOF(1)

Input #1, arLinesName(LinesCount)

Combo1.AddItem arLinesName(LinesCount)

LinesCount = LinesCount + 1

Loop

Close 1

AllBuses = 0

For Mis = 0 To (Combo1.ListCount - 1)

If Len(Dir("c:\Курсовая моя\" + Combo1.List(Mis) + ".txt")) = 0 Then

MsgBox " Файл маршрутов не найден!!!" + vbCrLf + _

" Проверьте его наличие: 'c:\Курсовая\" + Combo1.List(Mis) + ".txt'"

Else

Work_With_Files

AllBuses = AllBuses + arBusCount(Mis)

End If

Next Mis

Fuel(0) = 100

For i = 1 To (AllBuses - 1)

Load Image1(i)

Fuel(i) = 100

Next i

For i = 1 To 35

Load Image2(i)

Load Label14(i)

Next i

End Sub

Public Static Sub Work_With_Files()

arBusCount(Mis) = 0

arStayCount(Mis) = 0

Open "c:\Курсовая моя\" + Combo1.List(Mis) + ".txt" For Input As 2

Do While Not EOF(2)

Input #2, a$

Select Case a$

Case "автобус": Input #2, arBusNumber(Mis, arBusCount(Mis))

Case "водитель": Input #2, arDriveName(Mis, arBusCount(Mis))

Case "кондуктор": Input #2, arConductorName(Mis, arBusCount(Mis))

arBusCount(Mis) = arBusCount(Mis) + 1

Case "остановка": Input #2, arStayName(Mis, arStayCount(Mis))

Input #2, arStayAbsciss(Mis, arStayCount(Mis))

Input #2, arStayOrdinata(Mis, arStayCount(Mis))

arStayCount(Mis) = arStayCount(Mis) + 1

End Select

Loop

Close 2

End Sub

Private Sub Image1_Click(Index As Integer)

Misk = Index

For i = 0 To (AllBuses - 1)

Image1(i).Picture = LoadPicture("c:\ Курсовая моя\Иконки \Blue Bus.ico")

Next i

For i = 0 To (arBusCount(Mis) - 1)

If Mis <> 0 Then

a = i

For j = 0 To (Mis - 1)

i = i + arBusCount(j)

Next j

If i = Index Then

Frame1.Visible = False

Label4.Caption = arBusNumber(Mis, a)

Text1.Text = arDriveName(zmis, a)

Text2.Text = arConductorName(Mis, a)

Me.Label13.Caption = Str$(Fuel(Index))

Me.Image1(i).Picture = LoadPicture("c:\ Курсовая моя\Иконки \Purple Bus.ico")

End If

i = a

GoTo 1

Else

If i = Index Then

Frame1.Visible = False

Label4.Caption = arBusNumber(Mis, i)

Text1.Text = arDriveName(Mis, i)

Text2.Text = arConductorName(Mis, i)

Me.Label13.Caption = Str$(Fuel(Index))

Me.Image1(i).Picture = LoadPicture("c:\ Курсовая моя\Иконки \Purple Bus.ico")

End If

End If

1: Next i

End Sub

Private Sub Image1_DragOver(Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)

Pisk = Index

End Sub

Private Sub Image2_Click(Index As Integer)

If Misk <> 999 Then

If Image1(Misk).Visible = True Then

x0(Mis, Misk) = Val(arStayAbsciss(Mis, Index))

y0(Mis, Misk) = Val(arStayOrdinata(Mis, Index))

If x0(Mis, Misk) = Val(arStayAbsciss(Mis, Index)) _

Then arStayPast(Mis, Misk) = Index

If arStayPast(Mis, Misk) = (arStayCount(Mis) - 1) Then arStayEdit(Mis, Misk) = -1

If arStayPast(Mis, Misk) = 0 Then arStayEdit(Mis, Misk) = 1

End If

End If

End Sub

Private Sub Image3_Click()

If Misk <> 999 Then If Image1(Misk).Visible = True Then Fuel(Misk) = 100

End Sub

Private Sub mnuEditNext_Click()

If Misk <> 999 Then

If Image1(Misk).Visible = True Then

x0(Mis, Misk) = Val(arStayAbsciss(Mis, arStayPast(Mis, Misk) + arStayEdit(Mis, Misk)))

If x0(Mis, Misk) = Val(arStayAbsciss(Mis, arStayPast(Mis, Misk) + arStayEdit(Mis, Misk))) _

Then arStayPast(Mis, Misk) = arStayPast(Mis, Misk) + arStayEdit(Mis, Misk)

End If

End If

End Sub

Private Sub mnuEditPast_Click()

If Misk <> 999 Then

If Image1(Misk).Visible = True Then

x0(Mis, Misk) = Val(arStayAbsciss(Mis, arStayPast(Mis, Misk)))

End If

End If

End Sub

Private Sub mnuMove_Click()

If MovePossible = True Then

Me.mnuMove.Caption = "Включить режим: передвижение автобусов"

For i = 0 To (AllBuses - 1)

Image1(i).DragMode = 0

Next i

MovePossible = False

Exit Sub

End If

If MovePossible = False Then

Me.mnuMove.Caption = "Включить: режим выбора автобуса"

MovePossible = True

For i = 0 To (AllBuses - 1)

Image1(i).DragMode = 1

Next i

End If

End Sub

Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)

If Val(arStayAbsciss(Mis, arStayPast(Mis, Pisk))) > Val(arStayAbsciss(Mis, arStayPast(Mis, Pisk) + arStayEdit(Mis, Pisk))) _

Then

For i = Val(arStayAbsciss(Mis, arStayPast(Mis, Pisk))) To Val(arStayAbsciss(Mis, arStayPast(Mis, Pisk) + arStayEdit(Mis, Pisk))) Step -1

If i = Fix(X) Then x0(Mis, Pisk) = X

Next i

Else

For i = Val(arStayAbsciss(Mis, arStayPast(Mis, Pisk))) To Val(arStayAbsciss(Mis, arStayPast(Mis, Pisk) + arStayEdit(Mis, Pisk))) Step 1

If i = Fix(X) Then x0(Mis, Pisk) = X

Next i

End If

End Sub

Private Sub Timer1_Timer()

For i = 0 To (AllBuses - 1)

Fuel(i) = Fuel(i) - 1 / (1000 * Me.Timer1.Interval)

If i = Misk Then Me.Label13.Caption = Str$(Fuel(Misk))

If Fuel(i) = 0 Then Fuel(i) = 100

Next i

For z = 0 To (Combo1.ListCount - 1)

For i = 0 To (arBusCount(z) - 1)

If z <> 0 Then

a = i

For j = 0 To (z - 1)

i = i + arBusCount(j)

Next j

End If

If arStayPast(z, i) = (arStayCount(z) - 1) Then arStayEdit(z, i) = -1

If arStayPast(z, i) = 0 Then arStayEdit(z, i) = 1

If Val(arStayAbsciss(z, arStayPast(z, i))) > Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arCoordEdit(z, i) = -1

If Val(arStayAbsciss(z, arStayPast(z, i))) < Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arCoordEdit(z, i) = 1

If Val(arStayAbsciss(z, arStayPast(z, i))) = Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arCoordEdit(z, i) = 0

k(z, i) = (Val(arStayOrdinata(z, arStayPast(z, i))) - Val(arStayOrdinata(z, arStayPast(z, i) + arStayEdit(z, i)))) / _

(Val(arStayAbsciss(z, arStayPast(z, i))) - Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))))

b(z, i) = Val(arStayOrdinata(z, arStayPast(z, i))) - k(z, i) * Val(arStayAbsciss(z, arStayPast(z, i)))

Dim c As Single

c = Cos(Atn(k(z, i)))

x0(z, i) = x0(z, i) + c * 2 * arCoordEdit(z, i)

y0(z, i) = k(z, i) * x0(z, i) + b(z, i)

Image1(i).Move x0(z, i) - Image1(i).Width / 2, y0(z, i) - Me.Image1(i).Height / 2

If arCoordEdit(z, i) = 1 Then

If x0(z, i) >= Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arStayPast(z, i) = arStayPast(z, i) + arStayEdit(z, i)

End If

If arCoordEdit(z, i) = -1 Then

If x0(z, i) <= Val(arStayAbsciss(z, arStayPast(z, i) + arStayEdit(z, i))) _

Then arStayPast(z, i) = arStayPast(z, i) + arStayEdit(z, i)

End If

If z <> 0 Then i = a

Next i

Next z

End Sub

Public Static Sub First_Stay_of_Buses()

For z = 0 To (Combo1.ListCount - 1)

For i = 0 To (arBusCount(z) - 1)

a = i

If z <> 0 Then

a = i

For j = 0 To (z - 1)

i = i + arBusCount(j)

Next j

End If

If a = 0 Then

arStayEdit(z, i) = 1

arStayPast(z, i) = 0

Me.Image1(i).Move arStayAbsciss(z, 0) - Image1(i).Width / 2, _

arStayOrdinata(z, 0) - Image1(i).Height / 2

x0(z, i) = Val(arStayAbsciss(z, 0)): y0(z, i) = Val(arStayOrdinata(z, 0))

'MsgBox Str$(z) + " - " + Str$(i) + " - " + Str$(X0(z, i)) + " " + Str$(Y0(z, i))

Else

arStayEdit(z, i) = 1

arStayPast(z, i) = arStayPast(z, i - 1) + 1

Me.Image1(i).Move arStayAbsciss(z, arStayPast(z, i)) _

- Image1(i).Width / 2, _

arStayOrdinata(z, arStayPast(z, i)) _

- Image1(i).Height / 2

x0(z, i) = Val(arStayAbsciss(z, arStayPast(z, i)))

y0(z, i) = Val(arStayOrdinata(z, arStayPast(z, i)))

'MsgBox Str$(z) + " - " + Str$(i) + " - " + Str$(X0(z, i)) + " " + Str$(Y0(z, i))

End If

i = a

1: Next i

Next z

End Sub

Свежие статьи
Популярно сейчас
Зачем заказывать выполнение своего задания, если оно уже было выполнено много много раз? Его можно просто купить или даже скачать бесплатно на СтудИзбе. Найдите нужный учебный материал у нас!
Ответы на популярные вопросы
Да! Наши авторы собирают и выкладывают те работы, которые сдаются в Вашем учебном заведении ежегодно и уже проверены преподавателями.
Да! У нас любой человек может выложить любую учебную работу и зарабатывать на её продажах! Но каждый учебный материал публикуется только после тщательной проверки администрацией.
Вернём деньги! А если быть более точными, то автору даётся немного времени на исправление, а если не исправит или выйдет время, то вернём деньги в полном объёме!
Да! На равне с готовыми студенческими работами у нас продаются услуги. Цены на услуги видны сразу, то есть Вам нужно только указать параметры и сразу можно оплачивать.
Отзывы студентов
Ставлю 10/10
Все нравится, очень удобный сайт, помогает в учебе. Кроме этого, можно заработать самому, выставляя готовые учебные материалы на продажу здесь. Рейтинги и отзывы на преподавателей очень помогают сориентироваться в начале нового семестра. Спасибо за такую функцию. Ставлю максимальную оценку.
Лучшая платформа для успешной сдачи сессии
Познакомился со СтудИзбой благодаря своему другу, очень нравится интерфейс, количество доступных файлов, цена, в общем, все прекрасно. Даже сам продаю какие-то свои работы.
Студизба ван лав ❤
Очень офигенный сайт для студентов. Много полезных учебных материалов. Пользуюсь студизбой с октября 2021 года. Серьёзных нареканий нет. Хотелось бы, что бы ввели подписочную модель и сделали материалы дешевле 300 рублей в рамках подписки бесплатными.
Отличный сайт
Лично меня всё устраивает - и покупка, и продажа; и цены, и возможность предпросмотра куска файла, и обилие бесплатных файлов (в подборках по авторам, читай, ВУЗам и факультетам). Есть определённые баги, но всё решаемо, да и администраторы реагируют в течение суток.
Маленький отзыв о большом помощнике!
Студизба спасает в те моменты, когда сроки горят, а работ накопилось достаточно. Довольно удобный сайт с простой навигацией и огромным количеством материалов.
Студ. Изба как крупнейший сборник работ для студентов
Тут дофига бывает всего полезного. Печально, что бывают предметы по которым даже одного бесплатного решения нет, но это скорее вопрос к студентам. В остальном всё здорово.
Спасательный островок
Если уже не успеваешь разобраться или застрял на каком-то задание поможет тебе быстро и недорого решить твою проблему.
Всё и так отлично
Всё очень удобно. Особенно круто, что есть система бонусов и можно выводить остатки денег. Очень много качественных бесплатных файлов.
Отзыв о системе "Студизба"
Отличная платформа для распространения работ, востребованных студентами. Хорошо налаженная и качественная работа сайта, огромная база заданий и аудитория.
Отличный помощник
Отличный сайт с кучей полезных файлов, позволяющий найти много методичек / учебников / отзывов о вузах и преподователях.
Отлично помогает студентам в любой момент для решения трудных и незамедлительных задач
Хотелось бы больше конкретной информации о преподавателях. А так в принципе хороший сайт, всегда им пользуюсь и ни разу не было желания прекратить. Хороший сайт для помощи студентам, удобный и приятный интерфейс. Из недостатков можно выделить только отсутствия небольшого количества файлов.
Спасибо за шикарный сайт
Великолепный сайт на котором студент за не большие деньги может найти помощь с дз, проектами курсовыми, лабораторными, а также узнать отзывы на преподавателей и бесплатно скачать пособия.
Популярные преподаватели
Нашёл ошибку?
Или хочешь предложить что-то улучшить на этой странице? Напиши об этом и получи бонус!
Бонус рассчитывается индивидуально в каждом случае и может быть в виде баллов или бесплатной услуги от студизбы.
Предложить исправление
Добавляйте материалы
и зарабатывайте!
Продажи идут автоматически
5076
Авторов
на СтудИзбе
455
Средний доход
с одного платного файла
Обучение Подробнее