Программная часть

4. Программная часть

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

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 < t1 Or tnow > t2 And tnow < t3 Or tnow > t4 And tnow < t5 Or _

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

If tnow >= t1 And tnow <= t2 Or tnow >= t3 And tnow <= t4 Or 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