Исследование структурной надежности методом статистического моделирования — страница 2
Обновлено
Последний критерий как раз и используется при оценке структурной надежности сети методом статистического моделирования.
2.2 Разработка алгоритма расчета структурной надежности
2.2.1 Алгоритм расчета структурной надежности сети
связи методом статистического моделирования
Опишем сначала принцип расчета структурной надежности сети методом статистического моделирования [4].
Сеть связи задают в виде вероятностной матрицы смежности , где - элемент матрицы, отражающий величину надежности линии связи между узлом и узлом , а - коэффициент готовности данной линии связи . В свою очередь коэффициент готовности может быть определен по следующей формуле:
(2.1)
где - время наработки на отказ, - среднее время восстановления.
Производится независимых испытаний, каждое из которых можно условно разделить на два этапа.
На первом этапе вырабатывают независимых случайных, равномерно распределенных в интервале чисел . Затем, значения последовательно сравниваются с величинами по следующему алгоритму:
если - элемент сети отказал, результат равен нулю;
если - элемент сети находится в исправном состоянии, результат равен единице.
Результаты сравнения записываются в матрицу , .
На втором этапе производится проверка структуры сети, которая описана матрицей , на связность. Если сеть связна, то исход испытания относится к числу благоприятных .
Результатом оценки структурной надежности сети является значение - отношение числа благоприятных исходов к общему числу испытаний.
Проверка сети на связность может осуществляться, например, на основе процедуры “соединения”. Ее суть заключается в следующем.
На анализируемой сети выбирается произвольный узел. Далее находят смежные ему узлы и соединяют с ним. Это происходит до тех пор, пока сеть не представится в виде одного узла - “точки” (в случае если, сеть связана) или множества узлов (если сеть не связана).
Разработанный на основе всего выше изложенного алгоритм программы, в общем виде, отобразим на рисунке 2.1. Опишем с начала переменные, используемые в этом алгоритме:
i, e и j - переменные используемые в циклах типа for - next основной процедуры расчета надежности сети;
PlasResult - хранит число благоприятных исходов;
x( ) - динамический массив, равномерно распределенных в интервале (0, 1) чисел;
Nnoi - хранит текущий номер испытания;
maxNnoi - хранит общее число испытаний;
PP - хранит значение вероятности события - сеть связна;
Imeny - хранит номер случайно выбранного узла;
S( ) - динамический массив, для хранения номеров смежных узлов;
Nnew - хранит информацию о наличии новых смежных вершин;
sngStartWork(1, 2) - массив дат начала и конца расчета надежности сети;
sngStartWorkSEC - хранит число секунд расчета надежности сети;
bar - промежуточная переменная для хранения текущего номера испытаний.
Рисунок 2.1 - Алгоритм расчета структурной надежности сети
Отобразим более подробно алгоритмы тех процедур, которые непосредственно участвуют в определении события - сеть связна. Алгоритмы этих процедур разместим в порядке их вызова основной программой расчета структурной надежности сети связи методом статистического моделирования. Порядок вызова этих процедур и краткое описание их задачи сведем в таблицу 2.1.
Таблица 2.1 - Процедуры определения связности сети
Имя процедуры | Задача процедуры | |
VektStrok Nnew, Imeny, S, A | Соединение смежных узлов | |
SvjazNet Imeny, A, p | Проверка на единичность полученной вектор-строки | |
FinishAnswer A, PlasResult, Imeny, p, S, Nnew | Вынесение решения о связности сети, проверка наличия новых смеж-ных узлов для формирования нового массива смежных узлов |
Рисунок 2.2 - Алгоритм процедуры “ VektStrok ”
Рисунок 2.3 - Алгоритм процедуры “ SvjazNet ”
Рисунок 2.4 - Алгоритм процедуры “ FinishAnswer ”
2.2.2 Алгоритм интерфейсной части программы расчета надежности сети методом статистического моделирования
Приведем рисунок алгоритма программы интерфейса.
2.3 Разработка программы расчета структурной надежности методом
статического моделирования
2.3.1 Разработка расчетной части программы расчета структурной надежности сети
Option Explicit
Dim A (200, 200) As Single, p As Integer
Public maxNnoi As Single, flgstopuser As Boolean
Private Sub firstStepp (A( ) As Single, x( ) As Single)
Dim n As Integer
Dim i As Integer
Dim j As Integer
n = 1
For i = 1 To ((FrmSSN.kolvouzlov) - 1) '4
For j = i + 1 To (FrmSSN.kolvouzlov) '5
If A (i, j) > 0 Then
If x (n) < A (i, j) Then
A (i, j) = 1
Else
A (i, j) = 0
End If
n = n + 1
End If
A (j, i) = A (i, j)
Next j
Next i
End Sub
Private Sub VektStrok (Nnew, Imeny As Integer, S( ) As Integer, A( ) As Single)
Dim k As Integer
Dim j As Integer
For k = 1 To (FrmSSN.kolvouzlov)
If S (k) > 0 Then
For j = 1 To (FrmSSN.kolvouzlov)
A (Imeny, j) = A (Imeny, j) + A (k, j)
If A (Imeny, j) > 1 Then
A (Imeny, j) = 1
End If
Next j
End If
Next k
Nnew = 0
End Sub
Private Sub SvjazNet (Imeny As Integer, A( ) As Single, p As Integer)
Dim j As Integer
p = 1
For j = 1 To (FrmSSN.kolvouzlov)
If A (Imeny, j) = 0 Then
p = 0
Exit Sub
End If
Next j
End Sub
Private Sub FinishAnswer (A( ) As Single, PlasResult As Integer, Imeny As Integer, p _ As Integer, S() As Integer, Nnew As Integer)
Dim j As Integer
Dim Pm (1 To 6) As Integer
Dim Nbg As Integer, nUlvekt As Integer
If p <> 0 Then
PlasResult = PlasResult + 1
Exit Sub
End If
Nbg = 0
Nnew = 0
nUlvekt = 0
For j = 1 To (FrmSSN.kolvouzlov)
If A (Imeny, j) = 1 Then
Pm (j) = j
Else: nUlvekt = nUlvekt + 1
End If
Next j
If nUlvekt = (FrmSSN.kolvouzlov) Then
Exit Sub
End If
For j = 1 To (FrmSSN.kolvouzlov)
If Pm (j) <> S (j) Then
S (j) = Pm (j)
Nnew = Nnew + 1
End If
Next j
End Sub
Private Sub FormirNLmassWork ( )
Dim initm As Integer
For initm = 1 To FrmSSN.kolvolin
FrmSSN.numUZmu initm, FrmSSN.kolvouzlov, 2, na1, na2
A (na1, na2) = FrmSSN.UvmLN (initm)
A (na2, na1) = A (na1, na2)
Next initm
End Sub
Public Sub cmdrasch_workmod ( )
Dim i As Integer, j As Integer
Dim PlasResult As Integer, e As Integer
Dim x( ) As Single, C As Integer
Dim Nnoi As Integer
Dim PP As Currency, Imeny As Integer
Dim S ( ) As Integer
Dim Nnew As Integer
Dim sngStartWork (1, 1 To 2) As Date
Dim sngStartWorkSEC As Single, bar As Integer
frmBrWk.PrgBarWSind.Min = 0: frmBrWk.PrgBarWSind.Max = 100
frmBrWk.PrgBarWSind.Visible = False
frmBrWk.LblSwrE(1).Caption = 0
PlasResult = 0
ReDim Preserve x (FrmSSN.kolvolin)
ReDim Preserve S (FrmSSN.kolvouzlov)
Randomize
For Nnoi = 1 To maxNnoi
DoEvents
If MdlWorkSpase.flgstopuser = True Then Exit For
If Nnoi = 1 Then
sngStartWork(1, 1) = Now
sngStartWorkSEC = Timer
frmBrWk.LblSwrE(1).Caption = sngStartWork(1, 1)
End If
For e = 1 To FrmSSN.kolvolin
x (e) = Rnd
Next e
firstStepp A, x'1
Imeny = (((FrmSSN.kolvouzlov) - 1) * Rnd) + 1
S (Imeny) = Imeny
For j = 1 To FrmSSN.kolvouzlov
If A (Imeny, j) = 1 Then
S (j) = j
End If
Next j
VektStr:
VektStrok Nnew, Imeny, S, A'2
SvjazNet Imeny, A, p'3
FinishAnswer A, PlasResult, Imeny, p, S, Nnew'4
If Nnew <> 0 Then
GoTo VektStr
End If
For i = 1 To FrmSSN.kolvouzlov
S (i) = 0
For j = 1 To FrmSSN.kolvouzlov
A (i, j) = 0
Next j
Next i
bar = Nnoi
frmBrWk.PrgBarWSind.Value = ((bar / maxNnoi) * 100)
frmBrWk.PrgBarWSind.Visible = True
Next Nnoi
If MdlWorkSpase.flgstopuser = True Then Exit Sub
PP = (PlasResult / maxNnoi)
sngStartWorkSEC = (Timer - sngStartWorkSEC)
sngStartWork (1, 2) = Now: frmBrWk.LblSwrE(0).Caption = sngStartWork(1, 2)
UserFormVorkClosed sngStartWorkSEC, maxNnoi, PP, sngStartWork
End Sub
Private Sub UserFormVorkClosed (sngStartWorkSEC, maxNnoi, PP, sngStartWork)
Dim work As Integer, TimeWork As String
Dim bufchench1 As Date, bufchench2 As Currency
If sngStartWork (1, 1) <> sngStartWork (1, 2) Then
If (sngStartWork (1, 2) - sngStartWork (1, 1)) > sngStartWorkSEC _
And (sngStartWork (1, 2) - sngStartWork (1, 1)) < 1 Then GoTo 12
bufchench1 = (sngStartWork(1, 2) - sngStartWork(1, 1))
TimeWork = Str(bufchench1)
Else
12:
bufchench2 = sngStartWorkSEC
TimeWork = Str (0) & Str (bufchench2) & " секунды"
End If
work = MsgBox("Расчет структурной надежности закончен !" & vbCrLf & Chr$(13) & "Число испытаний : " & maxNnoi & vbCrLf & "Вероятность связности : " & PP & vbCrLf & "Расчет длился около : " & TimeWork, vbInformation + vbOKOnly, " ")
sngStartWork(1, 1) = 0: sngStartWork(1, 2) = 0
sngStartWorkSEC = 0: frmBrWk.PrgBarWSind.Value = 0
Unload frmBrWk
End Sub
2.3.2 Разработка интерфейсной части программы расчета структурной надежности сети
Интерфейсная часть программы состоит из четырех частей, а именно:
первая, основная часть, располагается в файле формы основного окна
“ FrmSSN ”;
следующая часть располагается в файле формы окна расчета структурной надежности “ frmBrWk ”;
третья часть программы находится в файле формы окна конфигурирования координатной сетки “ FrmPrWeb ”;
четвертая, последняя, часть программы - в файле формы окна ввода числовой характеристики выбранной линии “ FrmNwORsZ ”.
Приведем листинги данных частей, интерфейсной части программы расчета структурной надежности сети, в этом же порядке.
Первая часть
Option Explicit
Public kolvouzlov As Integer, needFRsave As Boolean
Public kolvolin As Integer
Dim znak As Boolean, zamok As Boolean
Dim x1 As Integer, y1 As Integer
Dim x2 As Integer, y2 As Integer
Dim MasKoLuZv(1 To 200, 1 To 5) As Single
Dim keeCH As Boolean
Dim deletealluz As Boolean, deletealllinsv As Boolean
Dim keeAB As Boolean, testimonial As Boolean
Dim testNyn As Boolean, change As Boolean
Dim mlinesSV(1 To 400, 1 To 10) As Single, SFALNAME As String
Const myORno As String = "sns"
Dim zapros As Boolean
Public poweb As Boolean
Public shwebx As Single, shweby As Single
Public bJampWeb As Boolean
Private Sub svayzy (x1, x2, y1, y2, iduzla, Index, mlinesSV, kolvolin)
Dim i As Integer, j As Integer
On Error GoTo metSVx
If deletealllinsv = True And kolvolin > 0 Then
FrmSSN.Enabled = False
FrmSSN.MousePointer = 3
For i = 1 To kolvolin
For j = 1 To 10
mlinesSV(i, j) = 0
Next j: Next i
kolvolin = 0
Else
For i = 1 To kolvolin
If mlinesSV(i, 1) = 0 Then
mlinesSV(i, 1) = iduzla: mlinesSV(i, 2) = Index
mlinesSV(i, 3) = x1: mlinesSV(i, 4) = y1
mlinesSV(i, 5) = x2: mlinesSV(i, 6) = y2
mlinesSV(i, 7) = 0
mlinesSV(i, 8) = 0: mlinesSV(i, 9) = 0 '-номера вершин (новые)
mlinesSV(i, 10) = 0 '-вес линии
Exit Sub
End If
Next i
End If
FrmSSN.Enabled = True
FrmSSN.MousePointer = 0
brcoutSVX:
Exit Sub
metSVx:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutSVX
End Sub
Private Sub LinColorsv (NuMl As Integer, LcolorS, mlinesSV)
On Error GoTo HTYH
Select Case mlinesSV(NuMl, 7)
Case Is = 0
LcolorS = vbBlue
Case Is = 1
LcolorS = vbRed
Case Is = 2
LcolorS = RGB(210, 0, 210)
End Select
HTYH:
End Sub
Private Sub CmdBk_Click ( )
Dim nnoN As Integer
CmdWORKsch.Enabled = False
Cmd1.Visible = True
Cmd2.Visible = True
keeAB = False
For nnoN = 1 To kolvouzlov
nnOuzN((MasKoLuZv(nnoN, 1))).Enabled = False
Next nnoN
CmdFwd.Enabled = False
CmdBk.Enabled = False
Frame1.Enabled = True
Frame1.Caption = ("План сети")
End Sub
Private Sub CmdFwd_Click ( )
CmdFwd.Enabled = False
CmdBk.Enabled = True
If keeAB = False Then Frame1.Caption = ("Параметры")
Cmd1.Visible = False
Cmd2.Visible = False
keeAB = True
If change = True Or change = False Then TestNet testNyn
End Sub
Private Sub TestNet (testNyn) '-проверка связанных узлов
Dim tuZnSvYnOk As Integer, nuzysy As Integer
On Error GoTo metTNx
If change = False And kolvouzlov = 0 Then GoTo 101
For tuZnSvYnOk = 1 To kolvouzlov
If MasKoLuZv(tuZnSvYnOk, 1) > 0 And MasKoLuZv(tuZnSvYnOk, 4) >= 1 Then
nuzysy = nuzysy + 1
End If
Next tuZnSvYnOk
If nuzysy = kolvouzlov And nuzysy > 1 Then
testNyn = True
For tuZnSvYnOk = 1 To kolvouzlov
If MasKoLuZv(tuZnSvYnOk, 1) > 0 Then
nnOuzN(MasKoLuZv(tuZnSvYnOk, 1)).Move (MasKoLuZv(tuZnSvYnOk, 2) - _ (nnOuzN(MasKoLuZv(tuZnSvYnOk, 1)).Width / 2)), (MasKoLuZv(tuZnSvYnOk, 3) -
- (nnOuzN(MasKoLuZv(tuZnSvYnOk, 1)).Height / 2))
nnOuzN(MasKoLuZv(tuZnSvYnOk, 1)).Visible = True: nnOuzN(MasKoLuZv(tuZnSvYnOk, 1)).Enabled = True
End If
Next tuZnSvYnOk
change = False
Else
101: nuzysy = 0
nuzysy = MsgBox(" ВЫ допустили ошибку. Данная сеть НЕ связна !!! " _
& vbCrLf & vbCr & " Это не позволит вам ввести характеристики сети" _
& vbCrLf & " Для исправления ошибки нажмите : << Назад >>" _
, vbCritical + vbOKOnly, " Проверка связности сети ")
Frame1.Enabled = False
CmdFwd.Enabled = False
End If
brcoutTN:
Exit Sub
metTNx:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutTN
End Sub
Private Sub CmdWEB_Click ( )
Dim Wsetki As Single, Hsetki As Single
Dim i As Integer, j As Integer
Dim shag As Boolean, LcolorS As Double
Const webxy As Single = 201
On Error GoTo metWEBx
If poweb = False Then
shwebx = webxy
shweby = shwebx
End If
If bJampWeb = True And keeCH = True Then
shag = True: GoTo 7
ElseIf bJampWeb = True And keeCH = False Then
shag = False: GoTo 7
End If
If keeCH = False Then
8: Picture1.DrawStyle = 2
For Wsetki = (shwebx) To (Picture1.Width) Step (shwebx)
Picture1.Line ((Wsetki), 1)-((Wsetki), (Picture1.Height - 1))
Next Wsetki
For Hsetki = (shweby) To (Picture1.Height) Step (shweby)
Picture1.Line (1, Hsetki)-((Picture1.Width - 1), Hsetki)
Next Hsetki
keeCH = True
Else '*перерисовка линий S-T*
7: Picture1.DrawStyle = 6
Picture1.Cls
For i = 1 To kolvolin
If mlinesSV(i, 1) <> 0 Then
LinColorsv i, LcolorS, mlinesSV '- определение цвета линии
Picture1.Line ((mlinesSV(i, 3)), (mlinesSV(i, 4)))-((mlinesSV(i, 5)), _
(mlinesSV(i, 6))), LcolorS
End If '*перерисовка линий E-D*
Next i
If shag = True Then GoTo 8
keeCH = False
End If
Picture1.DrawStyle = 6
brcoutWEB:
Exit Sub
metWEBx:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutWEB
End Sub
Private Sub Cmd1_Click ( ) '-уменьшение узла
Dim ti As Integer, tip As Integer
On Error GoTo metGGG
If Optuzel.Value = False Then Exit Sub:
Picture1.AutoRedraw = False: Picture1.Enabled = False
For ti = Pct1.lBound To kolvouzlov
If (Pct1(0).Width) > 402 Then '-мин размер для индекса=400
If ti > 0 Then tip = MasKoLuZv(ti, 1) Else tip = ti
Pct1(tip).Visible = False
Pct1(tip).Width = (Pct1(0).Width - 20)
Pct1(tip).Height = (Pct1(0).Height - 20)
If ti <> 0 Then
Pct1(tip).Left = (Pct1(tip).Left + 10)
Pct1(tip).Top = (Pct1(tip).Top + 10)
Pct1(tip).Visible = True
End If
End If
Next ti
Picture1.AutoRedraw = True: Picture1.Enabled = True
brcoutGGG:
Exit Sub
metGGG:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutGGG
End Sub
Private Sub Cmd2_Click ( ) '-увеличение узла
Dim i As Integer, pip As Integer
On Error GoTo metTYP
If Optuzel.Value = False Then Exit Sub:
Picture1.AutoRedraw = False: Picture1.Enabled = False
For i = 0 To kolvouzlov
If (Pct1(0).Width) < 700 Then
If i > 0 Then pip = MasKoLuZv(i, 1) Else pip = i
Pct1(pip).Visible = False
Pct1(pip).Width = (Pct1(0).Width + 20)
Pct1(pip).Height = (Pct1(0).Height + 20)
If i <> 0 Then
Pct1(pip).Left = (Pct1(pip).Left - 10)
Pct1(pip).Top = (Pct1(pip).Top - 10)
Pct1(pip).Visible = True
End If
End If
Next i
Picture1.AutoRedraw = True: Picture1.Enabled = True
brcoutTYP:
Exit Sub
metTYP:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutTYP
End Sub
Private Sub CmdWORKsch_Click ( )
Dim parallyn As Integer, zn As Integer
Dim zun As Integer
Dim ikf As Integer
On Error GoTo metBRsy
If testimonial = True Then
zn = 0
For parallyn = 1 To kolvolin
If mlinesSV(parallyn, 10) > 0 And mlinesSV(parallyn, 8) > 0 _
And mlinesSV(parallyn, 9) = 0 Then
For ikf = 1 To kolvouzlov
If MasKoLuZv(ikf, 1) > 0 And MasKoLuZv(ikf, 1) = mlinesSV(parallyn, 2) Then
mlinesSV(parallyn, 9) = MasKoLuZv(ikf, 5)
Exit For
End If
Next ikf
ElseIf mlinesSV(parallyn, 10) > 0 And mlinesSV(parallyn, 8) = 0 _
And mlinesSV(parallyn, 9) > 0 Then
For ikf = 1 To kolvouzlov
If MasKoLuZv(ikf, 1) > 0 And MasKoLuZv(ikf, 1) = mlinesSV(parallyn, 1) Then
mlinesSV(parallyn, 8) = MasKoLuZv(ikf, 5)
Exit For
End If
Next ikf
ElseIf mlinesSV(parallyn, 10) > 0 And mlinesSV(parallyn, 8) = 0 _
And mlinesSV(parallyn, 9) = 0 Then
For ikf = 1 To kolvouzlov
If MasKoLuZv(ikf, 1) > 0 And MasKoLuZv(ikf, 1) = mlinesSV(parallyn, 1) Then
mlinesSV(parallyn, 8) = MasKoLuZv(ikf, 5)
ElseIf MasKoLuZv(ikf, 1) > 0 And MasKoLuZv(ikf, 1) = mlinesSV(parallyn, 2) Then
mlinesSV(parallyn, 9) = MasKoLuZv(ikf, 5)
End If
Next ikf
End If
If mlinesSV(parallyn, 8) > 0 And mlinesSV(parallyn, 9) > 0 _
And mlinesSV(parallyn, 10) > 0 Then zn = zn + 1
Next parallyn
zun = 0
For parallyn = 1 To kolvouzlov
If MasKoLuZv(parallyn, 5) <> 0 Then zun = zun + 1
Next parallyn
If zn = kolvolin And zun = kolvouzlov Then
Load frmBrWk
frmBrWk.Show vbModal
Exit Sub
Else
247:
zn = MsgBox(" Вы ввели НЕ все параметры сети. " & vbCrLf & _
" Проверьте ! ВСЕ ЛИ узлы пронумерованы " & vbCrLf & _
" Для ВСЕХ ЛИ линий вы ввели характеристики ?", _
vbCritical + vbOKOnly, _
" Ошибка ввода числовых характеристик сети !")
Exit Sub
End If
Else
GoTo 247
End If
brcoutZZ:
Exit Sub
metBRsy:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutZZ
End Sub
Private Sub Form_Load ( )
On Error GoTo metLFM
FrmSSN.MousePointer = vbArrow
Picture2.Visible = True
keeCH = False
bJampWeb = False
deletealluz = False
deletealllinsv = False
CmdFwd.Enabled = False
CmdBk.Enabled = False
CmdWORKsch.Enabled = False
keeAB = False
testNyn = False
change = False
testimonial = False
needFRsave = False
zapros = False
poweb = False
'&&& начальная установка подменю
mnuClose.Enabled = False
mnuSave.Enabled = False
mnuSaveAs.Enabled = False
mnuweb.Enabled = False
mnuwebYN.Checked = False
mnuWBconf.Enabled = False
'&&&
Picture1.Visible = False: Frame1.Visible = False
Cmd1.Visible = False: Cmd2.Visible = False
CmdWEB.Enabled = False
brcoutLFM:
Exit Sub
metLFM:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutLFM
End Sub
Private Sub mnuClose_Click ( )
Dim emss As Integer
On Error GoTo metClDf
If needFRsave = True Then
emss = MsgBox(" Вы хотите сохранить внесенные изменения ?",_
vbExclamation + vbYesNo, " Закрытие файла ")
If emss = vbYes Then mnuSave_Click
End If
SFALNAME = ""
Picture2.Visible = True: Picture1.Visible = False
Frame1.Visible = False: Cmd1.Visible = False
Cmd2.Visible = False: CmdWEB.Visible = False
Opt1.Value = True: CmdWORKsch.Enabled = False
zapros = False
poweb = False
mnuOpen.Enabled = True
deletealluz = True: deletealllinsv = True
Picture1.Cls: svayzy 0, 0, 0, 0, 0, 0, mlinesSV, kolvolin
NeWorKorrkolUZ 0, kolvouzlov, 0, 0, 0
LblLN(1).Caption = 0
LbluZ(1).Caption = 0
mnuNew.Enabled = True
mnuClose.Enabled = False
mnuSave.Enabled = False
mnuSaveAs.Enabled = False
mnuweb.Enabled = False
mnuwebYN.Checked = False
keeAB = False
testimonial = False
needFRsave = False
CmdFwd.Enabled = False
CmdBk.Enabled = False
brcoutDf:
Exit Sub
metClDf:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcoutDf
End Sub
Private Sub mnuExit_Click ( )
Dim emss As Integer
If needFRsave = True Then
emss = MsgBox(" Вы хотите сохранить внесенные изменения ?", _
vbExclamation + vbYesNo, " Завершение работы с программой ")
If emss = vbYes Then mnuSave_Click
End If
Unload FrmSSN
Set FrmSSN = Nothing
End Sub
Private Sub mnuNew_Click ( )
On Error GoTo metOUTsbA
Picture2.Visible = False: Picture1.Visible = True
Frame1.Visible = True: Cmd1.Visible = True
Cmd2.Visible = True: CmdWEB.Visible = True
mnuOpen.Enabled = False
mnuNew.Enabled = False
mnuClose.Enabled = True
mnuSave.Enabled = True
mnuSaveAs.Enabled = True
mnuweb.Enabled = True
deletealluz = False
deletealllinsv = False
testimonial = False
needFRsave = False
brcoutA0:
Exit Sub
metOUTsbA:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", _
vbCritical, "Error"
GoTo brcoutA0
End Sub
Private Sub mnuOpen_Click ( )
Dim ORnost As String, msNMF As Integer
Dim nF As Integer
Dim BREDpt As Boolean
On Error GoTo metERSSst
BREDpt = False
mnuNew.Enabled = False
mnuweb.Enabled = True
deletealluz = False
deletealllinsv = False
cldfilfunk.Flags = cdlOFNHideReadOnly
cldfilfunk.ShowOpen
SFALNAME = cldfilfunk.FileName
ORnost = Right$(SFALNAME, 4)
If Len(SFALNAME) = 0 Then
564:mnuNew.Enabled = True
mnuweb.Enabled = False
Exit Sub
End If
If myORno = Right$(SFALNAME, 3) And 46 = Asc(Mid(ORnost, 1, 1)) Then
FCnetR BREDpt
cldfilfunk.FileName = ""
If BREDpt = True Then GoTo 564
netUPload
Else
msNMF = MsgBox("Данный файл НЕ является файлом приложения SSN", _
vbCritical + vbOKOnly, " Не верный формат файла ")
cldfilfunk.FileName = " "
mnuNew.Enabled = True
mnuweb.Enabled = False
Exit Sub
End If
brcout77:
Exit Sub
metERSSst:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", _
vbCritical, "Error"
GoTo brcout77
End Sub
Private Sub netUPload ( )
Dim w As Integer
On Error GoTo metERSS03
For w = 1 To kolvouzlov
Load nnOuzN(MasKoLuZv(w, 1))
Load Pct1(MasKoLuZv(w, 1))
Pct1(MasKoLuZv(w, 1)).Move MasKoLuZv(w, 2) -
- Pct1(MasKoLuZv(w, 1)).Width / 2, _
MasKoLuZv(w, 3) - Pct1(MasKoLuZv(w, 1)).Height / 2
Pct1(MasKoLuZv(w, 1)).Visible = True
If MasKoLuZv(w, 1) > 0 Then
nnOuzN(MasKoLuZv(w, 1)).Move (MasKoLuZv(w, 2) -
- (nnOuzN(MasKoLuZv(w, 1)).Width / 2)), _
(MasKoLuZv(w, 3) - (nnOuzN(MasKoLuZv(w, 1)).Height / 2))
nnOuzN(MasKoLuZv(w, 1)).Visible = True
nnOuzN(MasKoLuZv(w, 1)).Enabled = True
End If
If testimonial = True And MasKoLuZv(w, 5) > 0 Then
nnOuzN(MasKoLuZv(w, 1)).Text = MasKoLuZv(w, 5)
nnOuzN(MasKoLuZv(w, 1)).BackColor = RGB(0, 250, 243)
nnOuzN(MasKoLuZv(w, 1)).Locked = True
End If
Next w
bJampWeb = True
CmdWEB_Click
bJampWeb = False
Picture2.Visible = False: Picture1.Visible = True
Frame1.Visible = True: Cmd1.Visible = True
Cmd2.Visible = True: CmdWEB.Visible = True
mnuClose.Enabled = True
mnuSave.Enabled = True
mnuSaveAs.Enabled = True
mnuOpen.Enabled = False
LbluZ(1).Caption = kolvouzlov
LblLN(1).Caption = kolvolin
If keeAB = True Then
Cmd1.Visible = False
Cmd2.Visible = False
End If
brcout3:
Exit Sub
metERSS03:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout3
End Sub
Private Sub FcnetR (Bpt As Boolean)
Dim st0 As String, j As Integer
Dim nF As Integer, nwwd As Integer
Dim clermgs As String, st1 As String
Dim stx As String
On Error GoTo kasjakmet
nF = FreeFile
st1 = "777*NSN!& - _
&!SEV_*_ftAC*&&&*015401680161013101470146013600163046014101740162 _
0174099016801610168011209901700*777"
Open SFALNAME For Input As #nF
Input #nF, st0
If st0 <> st1 Then
clermgs = "Данный файл НЕ является файлом приложения SSN"
GoTo 22
End If
Input #nF, stx
keeAB = CBool(stx)
Input #nF, stx
testimonial = CBool(stx)
Input #nF, stx
kolvouzlov = CInt(stx)
For nwwd = 1 To kolvouzlov
For j = 1 To 5
Input #nF, MasKoLuZv(nwwd, j) 'stx
Next j
Next nwwd '-конец ввода массива узлов
Input #nF, stx
Input #nF, stx
kolvolin = CInt(stx)
For nwwd = 1 To kolvolin
For j = 1 To 10
If j = 10 Then
Input #nF, mlinesSV(nwwd, j)
mlinesSV(nwwd, j) = mlinesSV(nwwd, j) / 1000
Else
Input #nF, mlinesSV(nwwd, j) 'stx
End If
Next j
Next nwwd '- конец ввода массива линий
23:
Close #nF
Exit Sub
kasjakmet:
Select Case Err
Case Is = 76
clermgs = " Путь " & SFALNAME & " НЕ найден "
Case Is = 62
GoTo 23
Case Else
clermgs = "Данный файл НЕ является файлом приложения SSN"
End Select
22:
nwwd = MsgBox(clermgs, vbInformation + vbOKOnly, " Ошибка чтения файла")
Bpt = True
GoTo 23
End Sub
Private Sub mnuSave_Click ( )
If SFALNAME <> "" And needFRsave = True And zapros = False Then
cldfilfunk.Flags = cdlOFNOverwritePrompt
FCnetM
ElseIf needFRsave = True Then
mnuSaveAs_Click
End If