Помощь в описании кода VBA - вопрос №2868799

Нужно описать каждую строку в коде 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 ResumeNext
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
Setshp(i, j) = Навигатор.shpCell(ind)
Nextj, 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
EndSub
PublicSubSetColorLabel()
Навигатор.lblColor(2).BackColor = CellColor(2): Навигатор.lblColor(3).BackColor = CellColor(3): Навигатор.lblColor(4).BackColor = CellColor(4): Навигатор.lblColor(5).BackColor = CellColor(5):
EndSub
PublicSubSetCell(ByValsAsString)
DimcAsLong, kAsLong, iterAsLong, rnAsLong, fAsBoolean
SelectCases
Case «start»: c = CellColor(2)
Case «stop»: c = CellColor(3)
EndSelect
Do
iter = iter + 1
rn = Int(Rnd * POLEWidth * POLEHeight + 1)
IfНавигатор.shpCell(rn).FillColor = CellColor(1) ThenНавигатор.shpCell(rn).FillColor = c: f = True: ExitDo
LoopUntiliter > 1000
SelectCases
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
10.05.18
0 ответов
Ответов пока нет

Глеб Черняк

от 55 p.
Сейчас на сайте
Читать ответы

Олег Николаевич

от 50 p.
Читать ответы

Георгий

от 300 p.
Читать ответы
Посмотреть всех экспертов из раздела Технологии
Пользуйтесь нашим приложением Доступно на Google Play Загрузите в App Store