Автор работы: Пользователь скрыл имя, 11 Сентября 2014 в 20:22, курсовая работа
В данной работе разрабатывается программа работы с базой данных, в соответствии с поставленным заданием. Помимо основного задания рассматривается возможность рисования любого графа и нахождение минимального пути по заданию пользователя программы. Программа предусматривает также различные случаи работы с программой, такие как вывод матрицы смежности графа.
Введение 4
1.Теоретические сведения 5
1.1 Понятие базы данных 5
1.2 Этапы создания баз данных 5
1.3 Алгоритм Дейкстры 7
1.4 Метод Дейкстры поиска кратчайшего маршрута между
двумя заданными вершинами взвешенного графа 9
1.5 Пример решения задачи 11
2.Описания программы 13
2.1 Общие сведения 13
2.2 Функциональное назначение 13
2.3 Описание алгоритма функционирования программы 13
2.4 Используемые технические и программные средства 14
Заключение 15
Список литературы 16
Приложение С - Листинг программы
Option Explicit
Dim NSh As Integer 'Счетчик вершин
Dim NLn As Integer 'Счетчик линий
Dim werder As Integer
Dim mas() As Integer 'Массив для матрицы смежности
Dim masD() As Variant
'-----------------------------
Dim massiv() As Variant 'Массив для матрицы длин
Dim masp() As Variant 'Массив для матрицы ребер
Dim masiv11() As Variant '2-й массив для матрицы длин
Dim masiv1() As Variant '2-й массив для матрицы ребер
Dim strImy As String 'Переменная для имени файла
Dim nFreeFile As Integer 'Переменная для идентификатора файла'наибольшая длина ребра
'программа
Dim Lasttime As Single
Dim T As Single
Dim s As Single
Dim V As Single
Dim V1 As Single
Dim www() As Variant
Dim V2 As Single
Dim max As Single
Dim max1 As Single
Dim max2 As Single
Dim Mok() As Integer
Dim Wok() As Integer
Dim Way() As Integer
Dim schet As Integer
Function comm1()
Dim i As Integer, j As Integer
Dim a() As Double
ReDim Preserve a(1 To Shape1.UBound, 1 To Shape1.UBound)
ReDim Preserve massiv(1 To Shape1.UBound, 1 To Shape1.UBound)
For i = 1 To Shape1.UBound
For j = 1 To Shape1.UBound
If (i <> 1) Or (j <> 1) Then
Load Form2.text2(i * 10 + j)
Form2.text2(i * 10 + j).Visible = True
Form2.text2(i * 10 + j).Left = Form2.text2(11).Left + Form2.text2(11).Width * (j - 1)
Form2.text2(i * 10 + j).Top = Form2.text2(11).Top + Form2.text2(11).Height * (i - 1)
Form2.text2(i * 10 + j).Caption = massiv(i, j) + massiv(j, i)
End If
If i = j Then
Form2.text2(i * 10 + j).Caption = "0"
End If
Next j
Next i
End Function
Private Sub Command2_KeyDown(KeyCode As Integer, Shift As Integer)
Form_KeyDown KeyCode, 0
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Delete_Click()
Dim i As Integer, j As Integer, d As Integer, o As Integer, u As Integer
For i = Shape1.LBound To Shape1.UBound - 1
Unload Shape1(i + 1)
Next i
For j = Line1.LBound To Line1.UBound - 1
Unload Line1(j + 1)
Next j
For d = Label1.LBound To Label1.UBound - 1
Unload Label1(d + 1)
Next d
For o = Label2.LBound To Label2.UBound - 1
Unload Label2(o + 1)
Next o
For u = Label3.LBound To Label3.UBound - 1
Unload Label3(u + 1)
Next u
End Sub
Private Sub mnuExit_Click()
End
End Sub
Private Sub Deykstra_Click()
Load Form2
Form2.Visible = True
End Sub
Private Sub Matrix_Click()
Dim k As Integer
Dim n As Integer
ReDim Preserve mas(1 To (Shape1.UBound), 1 To (Shape1.UBound))
For k = 1 To Shape1.UBound
For n = 1 To Shape1.UBound
Print mas(k, n);
Next n
Next k
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If (KeyCode = 46) And (Shape1.UBound > 0) Then
Dim w As Integer, u As Integer, p As Integer
For w = 1 To Shape1.UBound
If Shape1(w).FillColor = &HFFFF00 Then
u = w
Exit For
End If
Next w
For p = 1 To Line1.UBound
On Error Resume Next
If (((Shape1(u).Left + Shape1(u).Height / 2.5) = Line1(p).X1) And ((Shape1(u).Top + Shape1(u).Width / 2.5) = Line1(p).Y1)) Or (((Shape1(u).Left + Shape1(u).Width / 2.5) = Line1(p).X2) And ((Shape1(u).Top + Shape1(u).Width / 2.5) = Line1(p).Y2)) Then
Line1(p).X1 = Line1(Line1.UBound).X1
Line1(p).Y1 = Line1(Line1.UBound).Y1
Line1(p).X2 = Line1(Line1.UBound).X2
Line1(p).Y2 = Line1(Line1.UBound).Y2
Unload Label2(p)
Unload Label3(p)
Unload Line1(p)
End If
Next p
Shape1(u).Top = Shape1(Shape1.UBound).Top
Shape1(u).Left = Shape1(Shape1.UBound).Left
Shape1(u).FillColor = vbBlue
Label1(u).Top = Label1(Shape1.UBound).Top
Label1(u).Left = Label1(Shape1.UBound).Left
Unload Shape1(Shape1.UBound)
Unload Label1(Label1.UBound)
End If
End Sub
Private Sub Form_Load()
Line1(0).Visible = False
Shape1(0).Visible = False
Line2(0).Visible = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
werder = 0
If Button = vbLeftButton Then
For i = 1 To (Shape1.UBound)
ReDim Preserve mas(1 To (Shape1.UBound), 1 To (Shape1.UBound))
ReDim Preserve www(1 To (Shape1.UBound), 1 To (Shape1.UBound))
ReDim Preserve massiv(1 To (Shape1.UBound), 1 To (Shape1.UBound))
ReDim Preserve masD(1 To (Shape1.UBound), 1 To (Shape1.UBound))
If Shape1(i).FillColor = &HFF00FF Then
werder = i
Load Line1(Line1.UBound + 1)
NLn = Line1.UBound
With Line1(Line1.UBound)
.Visible = True
.X1 = X
.Y1 = Y
.X2 = X
.Y2 = Y
End With
End If
Next i
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim r As Integer
Dim i As Integer
For i = 1 To (Shape1.UBound)
If X - Shape1(i).Left >= 0 And X - Shape1(i).Left < Shape1(i).Width And _
Y - Shape1(i).Top >= 0 And Y - Shape1(i).Top < Shape1(i).Height Then
Shape1(i).FillColor = &HFF00FF
Else
Shape1(i).FillColor = &HFFFF00
End If
Next i
If Button = vbLeftButton Then
Line1(Line1.UBound).X2 = X
Line1(Line1.UBound).Y2 = Y
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim alf As Variant
Dim r As Integer, i As Integer, ii As Integer, L As Integer, q As Integer
Dim bet As Variant
r = Shape1(0).Width / 2.5
If werder <> 0 Then
Dim kr As Boolean
kr = False
For ii = 1 To (Shape1.UBound)
If Shape1(ii).FillColor = &HFF00FF Then
kr = True
If ii <> werder Then
With Line1(Line1.UBound)
.X1 = Shape1(werder).Left + r
.Y1 = Shape1(werder).Top + r
.X2 = Shape1(ii).Left + r
.Y2 = Shape1(ii).Top + r
End With
End If
Dim xx As Double, yy As Double, ugol As Double, ugol1 As Double
xx = Line1(Line1.UBound).X1 - Line1(Line1.UBound).X2
yy = Line1(Line1.UBound).Y1 - Line1(Line1.UBound).Y2
yy = -yy
ugol = Atn(yy / xx)
If xx < 0 And yy < 0 Then ugol = ugol + 3.14
If xx < 0 And yy > 0 Then ugol = ugol + 3.14
If xx < 0 And yy = 0 Then ugol = ugol + 3.14
Dim Xr As Double, Yr As Double
Load Label2(Label2.UBound + 1)
Load Label3(Label3.UBound + 1)
Label2(Label2.UBound).Visible = True
Label3(Label3.UBound).Visible = True
With Line1(Line1.UBound)
If .Y2 < .Y1 Then
If .X1 <= .X2 Then
Label2(Label2.UBound).Top = (.Y1 + .Y2) / 2 - Label2(Label2.UBound).Height
Label2(Label2.UBound).Left = (.X2 + .X1) / 2 - Label2(Label2.UBound).Width
Label3(Label3.UBound).Left = (.X1 + .X2) / 2 + 270 * Cos(ugol) - Label3(Label3.UBound).Height
Label3(Label3.UBound).Top = (.Y1 + .Y2) / 2 + 270 * Sin(-ugol) - Label3(Label3.UBound).Width
ElseIf .X1 > .X2 Then
Label2(Label2.UBound).Top = (.Y1 + .Y2) / 2 - Label2(Label2.UBound).Height
Label2(Label2.UBound).Left = (.X1 + .X2) / 2
Label3(Label3.UBound).Left = (.X1 + .X2) / 2 + 270 * Cos(ugol)
Label3(Label3.UBound).Top = (.Y1 + .Y2) / 2 + 270 * Sin(-ugol) - Label3(Label3.UBound).Height
End If
End If
If .Y2 >= .Y1 Then
If .X1 <= .X2 Then
Label2(Label2.UBound).Top = (.Y2 + .Y1) / 2
Label2(Label2.UBound).Left = (.X2 + .X1) / 2 - Label2(Label2.UBound).Width
Label3(Label3.UBound).Left = (.X1 + .X2) / 2 + 270 * Cos(ugol) - Label3(Label3.UBound).Width
Label3(Label3.UBound).Top = (.Y1 + .Y2) / 2 + 270 * Sin(-ugol)
ElseIf .X1 > .X2 Then
Label2(Label2.UBound).Top = (.Y2 + .Y1) / 2
Label2(Label2.UBound).Left = (.X1 + .X2) / 2
Label3(Label3.UBound).Left = (.X1 + .X2) / 2 + 270 * Cos(ugol)
Label3(Label3.UBound).Top = (.Y1 + .Y2) / 2 + 270 * Sin(-ugol)
End If
End If
End With
If Shape1(ii).FillColor = &HFF00FF And (Line1(Line1.UBound).X1 = Shape1(werder).Left + r) Then
mas(werder, ii) = 1
mas(ii, werder) = 1
massiv(werder, ii) = InputBox("Введите длину ребра")
masD(ii, werder) = massiv(werder, ii)
www(werder, ii) = massiv(werder, ii)
masD(werder, ii) = massiv(werder, ii)
Label2(Label2.UBound).Caption = massiv(werder, ii)
If massiv(werder, ii) > max2 Then
max2 = massiv(werder, ii)
End If
ReDim Preserve www(1 To (Shape1.UBound), 1 To (Shape1.UBound))
ReDim Preserve mas(1 To (Shape1.UBound), 1 To (Shape1.UBound))
ReDim Preserve massiv(1 To (Shape1.UBound), 1 To (Shape1.UBound))
ReDim Preserve masD(1 To (Shape1.UBound), 1 To (Shape1.UBound))
End If
End If
Next ii
If (kr = False) Then
Unload Line1(Line1.UBound)
End If
End If
If Button = vbRightButton Then
Load Shape1(Shape1.UBound + 1)
NSh = NSh + 1
With Shape1(Shape1.UBound)
.FillStyle = vbSolid
.Visible = True
.Left = X
.Top = Y
End With
Load Label1(Label1.UBound + 1)
With Label1(Label1.UBound)
.Left = X + 150
.Top = Y + 80
.Caption = Shape1.UBound
.ZOrder 0
.Visible = True
End With
End If
werder = 0
End Sub
Function comm2()
Dim i As Integer, j As Integer, m As Integer, p As String
Dim c As Integer, d As Integer, max As Integer
ReDim Preserve massiv(1 To NSh, 1 To NSh)
ReDim Preserve masp(1 To NSh, 1 To NSh)
ves_Click
max = 0
For i = 1 To NSh
For j = 1 To NSh
If (massiv(i, j) > max) And (massiv(i, j) <> "0") Then
max = massiv(i, j)
End If
Next j
Next i
For i = 1 To NSh
For j = 1 To NSh
If (massiv(i, j) = "0") Then
massiv(i, j) = max + 100
End If
Next j
Next i
Private Sub ves_Click()
Dim i As Integer, j As Integer
For i = 1 To NSh
For j = 1 To NSh
If massiv(i, j) <> "0" Then
masp(i, j) = j
Else
masp(i, j) = 0
End If
Next j
Next i
End Sub
' Метод Дейкстры
Function Resh()
Dim j As Integer
Dim ves As Integer
Dim r As Integer
Dim tt As Byte
Dim w() As Byte, m() As Byte
Dim zz As Byte, kk As Byte, cc As Byte, dd As Byte, vv As Byte, ff As Byte
tt = 0
r = Shape1(0).Width / 2.5
If Form2.Label1 <> "" Then
Form2.Label1 = ""
End If
ves = 0
Cls
If Form2.Label4.Caption <> "Вершины" Then
Form2.Label4.Caption = "Вершины"
End If
If max2 <> max1 Then
max = max2 ^ 2
'max1 = max2
End If
For i = 1 To NSh ' во всех символах ищем 0 и заменяем на Max^2
For j = 1 To NSh 'L -кол-во вершин
If masD(i, j) = Lasttime Or masD(i, j) = 0 Then
masD(i, j) = max
End If
Next
Next i
'заполнение матриц: Mok(),Way(); начальные данные
ReDim Mok(1 To NSh)
ReDim Way(1 To NSh)
ReDim Wok(1 To NSh)
For i = 1 To NSh
Mok(i) = 0
Way(i) = max
Next
s = CSng(Form2.Text3.Text)
V = CSng(Form2.Text1.Text)
Mok(V) = 1
Wok(V) = 0
Way(V) = 0
Do
'нахождение минимальных путей к точке V
For i = 1 To NSh
If masD(V, i) = "0" Then
masD(V, i) = 0
End If
If masD(V, i) < max And Mok(i) = 0 And Way(i) > Way(V) + masD(V, i) Then
ves = ves + masD(V, i)
Way(i) = Way(V) + masD(V, i)
Wok(i) = V
End If
Next i
'нахождение минимального пути
T = max
V = 0
For i = 1 To NSh
If Mok(i) = 0 And Way(i) < T Then
V = i
T = Way(i)
End If
Next i
If V = 0 Then
Form2.Label4.Caption = "Вершины"
Exit Function
End If
Mok(V) = 1
Loop Until V = s
'вывод короткого пути
Form2.Label4.Caption = ""
V1 = s
Do Until V1 = 0
tt = tt + 1
ReDim Preserve w(1 To tt)
If V1 <> s Then
Load Line2(Line2.UBound + 1)
schet = schet + 1
Line2(Line2.UBound).X1 = Shape1(V1).Left + r
Line2(Line2.UBound).Y1 = Shape1(V1).Top + r
Line2(Line2.UBound).X2 = Shape1(V2).Left + r
Line2(Line2.UBound).Y2 = Shape1(V2).Top + r
Line2(Line2.UBound).Visible = True
Shape1(V1).FillColor = vbRed
Shape1(V2).FillColor = vbRed
Form2.Label4.Caption = "V" & V1 & "-> " & Form2.Label4.Caption
Else
Form2.Label4.Caption = "V" & V1
End If
w(tt) = V1
V2 = V1
V1 = Wok(V1)
Loop
vv = 0
For zz = 1 To UBound(w) - 1
cc = w(zz)
ff = zz + 1
dd = w(ff)
kk = www(dd, cc)
vv = kk + vv
Next zz
Lasttime = max
Form2.Label1.Caption = "Его длина = " & vv
End Function
Function unloud1()
Dim i As Integer
For i = 1 To schet
Line2(i).Visible = False
Next i
For i = 1 To Shape1.UBound
If Shape1(i).FillColor = vbRed Then
Shape1(i).FillColor = &HFFFF00
End If
Next i
End Function