Помощь в VBA
Нужна помощь в написании комментариев к коду в VBA
Option Explicit ‘ Оператор, используемый чтобы обеспечить обязательное объявление всех используемых переменных
Public shp() As Shape, i As Long, j As Long, POLEWidth As Long, POLEHeight As Long, CellColor(1 To 5) As Long, numColor As Long ‘ оператор, используемый чтобы делать переменную доступной во всех процедурах всех модулей VBA в проекте
Private Const INF As Double = 1E+100 'значение бесконечности
Private Const maxEdge As Long = 8 'максимальное кол-во ребер для каждой вершины
Private Type Vertex 'тип для описания вершин
name As String 'наименование вершины
d As Double 'дистанция до текущей вершины
p As Long '"предок" до текущей вершины
u As Boolean 'метка о прохождении вершины, используется в алгоритме Дейкстры
edgeCount As Long 'количество ребер
nGraph(1 To maxEdge) As Long 'массив смежных вершин
dGraph(1 To maxEdge) As Double 'массив дистанций до смежных вершин
End Type
Public Sub Initialize ColorArray()
CellColor(1) = Навигатор.BackColor
CellColor(2) = vbGreen
CellColor(3) = vbRed
CellColor(4) = vbBlue
CellColor(5) = vbMagenta
SetColorLabel
End Sub
Public Sub SetPole()
POLEWidth = Val(Навигатор.txtPOLEWidth.Text): POLEHeight = Val(Навигатор.txtPOLEHeight.Text)
If POLEWidth < 10 Then POLEWidth = 10: Навигатор.txtPOLEWidth.Text = POLEWidth
If POLEHeight < 10 Then POLEHeight = 10: Навигатор.txtPOLEHeight.Text = POLEHeight
If POLEWidth > 100 Then POLEWidth = 100: Навигатор.txtPOLEWidth.Text = POLEWidth
If POLEHeight > 100 Then POLEHeight = 100: Навигатор.txtPOLEHeight.Text = POLEHeight
Dim ind As Long
ReDim shp(1 To POLEHeight, 1 To POLEWidth)
SetColorLabel
For i = 1 To POLEHeight
For j = 1 To POLEWidth
ind = ind + 1
On Local Error Resume Next
Load Навигатор.shpCell(ind)
Навигатор.shpCell(ind).Visible = True
Навигатор.shpCell(ind).Left = Навигатор.shpCell(ind).Width * (j - 1)
Навигатор.shpCell(ind).Top = Навигатор.shpCell(ind).Height * (i - 1)
Навигатор.shpCell(ind).FillColor = CellColor(1) ' CellColor(1)
Навигатор.shpCell(ind).FillStyle = 0
Set shp(i, j) = Навигатор.shpCell(ind)
Next j, i
Навигатор.frPOLE.Visible = True: Навигатор.frPOLE.Width = POLEWidth * Навигатор.shpCell(0).Width: Навигатор.frPOLE.Height = POLEHeight * Навигатор.shpCell(0).Height: 'Command2.Enabled = False
Навигатор.btnSTART.Enabled = True: Навигатор.btnSTOP.Enabled = True: Навигатор.btnFindPath.Enabled = True
End Sub
Public Sub SetColorLabel()
Навигатор.lblColor(2).BackColor = CellColor(2): Навигатор.lblColor(3).BackColor = CellColor(3): Навигатор.lblColor(4).BackColor = CellColor(4): Навигатор.lblColor(5).BackColor = CellColor(5):
End Sub
Public Sub SetCell(ByVal s As String)
Dim c As Long, k As Long, iter As Long, rn As Long, f As Boolean
Select Case s
Case "start": c = CellColor(2)
Case "stop": c = CellColor(3)
End Select
Do
iter = iter + 1
rn = Int(Rnd * POLEWidth * POLEHeight + 1)
If Навигатор.shpCell(rn).FillColor = CellColor(1) Then Навигатор.shpCell(rn).FillColor = c: f = True: Exit Do
Loop Until iter > 1000
Select Case s
Case "start": INFO "Старт" & IIf(f, " ", " не ") & "установлен ", IIf(f, vbBlue, vbRed)
Case "stop": INFO "Финиш" & IIf(f, " ", " не ") & "установлен ", IIf(f, vbBlue, vbRed)
End Select
End Sub
Public Sub ClearCell(ByVal s As String)
Select Case s
Case "start"
For i = 1 To POLEHeight
For j = 1 To POLEWidth
If shp(i, j).FillColor = CellColor(2) Then shp(i, j).FillColor = CellColor(1): Exit Sub
Next: Next
Case "stop"
For i = 1 To POLEHeight
For j = 1 To POLEWidth
If shp(i, j).FillColor = CellColor(3) Then shp(i, j).FillColor = CellColor(1): Exit Sub
Next: Next
Case "path"
For i = 1 To POLEHeight
For j = 1 To POLEWidth
If shp(i, j).FillColor = CellColor(5) Then shp(i, j).FillColor = CellColor(1)
Next: Next
Case "wall"
For i = 1 To POLEHeight
For j = 1 To POLEWidth
If shp(i, j).FillColor = CellColor(4) Then shp(i, j).FillColor = CellColor(1)
Next: Next
End Select
Call INFO
End Sub
Public Sub SetWall()
Навигатор.btnSTOP.Enabled = True: Навигатор.btnSTART.Enabled = True: Навигатор.btnFindPath.Enabled = True
If POLEHeight < 10 Then Exit Sub
ClearCell "path"
Dim k As Long, iter As Long, X As Long, rn As Long: k = Val(Навигатор.txtCountWalls.Text)
If (k <=
0 Or k > POLEHeight * POLEWidth - 2) And Навигатор.OpSet(4).Value = True Then INFO "Задано слишком большое число препятствий.", vbRed: Exit Sub
If Навигатор.OpSet(5).Value = True Then
MsgBox "Кликайте по полю для установки преград."
Else
ClearCell "wall"
Do
iter = iter + 1
rn = Int(Rnd * POLEWidth * POLEHeight + 1)
If Навигатор.shpCell(rn).FillColor = CellColor(1) Then
X = X + 1
Навигатор.shpCell(rn).FillColor = CellColor(4)
End If
Loop Until X >= k Or iter > 100000
INFO "Установлено препятствий: " & X
End If
End Sub
Public Function GetCountWalls() As Long
Dim k As Long
For i = 1 To POLEHeight
For j = 1 To POLEWidth
If shp(i, j).FillColor = CellColor(4) Then k = k + 1
Next: Next
GetCountWalls = k
End Function
Public Function GetNumber(ByVal X As Single, Y As Single, Optional ByRef i As Long = 1, Optional ByRef j As Long = 1) As String
i = Int(1 + (Y / Навигатор.shpCell(0).Height)): j = Int((X / Навигатор.shpCell(0).Width) + 1)
GetNumber = i & " | " & j
End Function
Public Sub INFO(Optional ByVal s As String = "", Optional ByVal c As Long = vbBlue)
Навигатор.lblINFO.Caption = s: Навигатор.lblINFO.ForeColor = c
End Sub
Public Sub SoftIceFind()
'Dim nP As Long, kP As Long, a() As Long
'a = GetArray(nP, kP)
'Call MyDijkstra(a, nP, kP)
INFO "Путь не найден"
End Sub
