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
End Sub
Private Sub mnuSaveAs_Click ( )
cldfilfunk.Flags = cdlOFNOverwritePrompt
cldfilfunk.ShowSave
SFALNAME = cldfilfunk.FileName
If Len(SFALNAME) = 0 Then Exit Sub
myNfkorr
End Sub
Private Function CheckNames (name As String) As Boolean
Dim Result As Boolean
Result = True
If (InStr(name, "\")) Then Result = False
If (InStr(name, "/")) Then Result = False
If (InStr(name, ":")) Then Result = False
If (InStr(name, ";")) Then Result = False
If (InStr(name, "*")) Then Result = False
If (InStr(name, """")) Then Result = False
If (InStr(name, "?")) Then Result = False
If (InStr(name, ">")) Then Result = False
If (InStr(name, "<")) Then Result = False
If (InStr(name, "|")) Then Result = False
If (InStr(name, ",")) Then Result = False
CheckNames = Result
End Function
Private Sub myNfkorr ( )
Dim chstras As String, snumpoint As Integer
Dim rrr As String
On Error GoTo 898
rrr = cldfilfunk.FileTitle
If CheckNames(rrr) = False Or Len(rrr) = 0 Then
11:MsgBox " Недопустимое имя файла "
zapros = True
cldfilfunk.FileName = ""
Exit Sub
ElseIf 46 = Asc(Mid(rrr, 1, 1)) Then GoTo 11
End If
chstras = Right$(SFALNAME, 4)
If myORno <> Right$(SFALNAME, 3) And 46 = Asc(Mid(chstras, 1, 1)) Then
Mid(SFALNAME, (Len(SFALNAME) - 2), 3) = myORno
ElseIf myORno <> Right$(SFALNAME, 3) And 46 <> Asc(Mid(chstras, 1, 1)) Then
If InStr(1, SFALNAME, ".") <> 0 Then
SFALNAME = Left$(SFALNAME, (InStr(1, SFALNAME, ".") - 1))
SFALNAME = SFALNAME & ".sns"
Else
SFALNAME = SFALNAME & ".sns"
End If
End If
FCnetM
brcout:
Exit Sub
898:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout
End Sub
Private Sub FcnetM ( )
Dim st0 As String, j As Integer
Dim nF As Integer, nwwd As Integer
Dim clermgs As String
On Error GoTo kasjakmet
nF = FreeFile
st0 = "777*NSN!& – _
&!SEV_*_ftAC*&&&*015401680161013101470146013600163046014101740162 _
0174099016801610168011209901700*777"
FrmSSN.Enabled = False
FrmSSN.MousePointer = 11
Open SFALNAME For Output As #nF
Write #nF, st0
Write #nF, CStr(keeAB)
Write #nF, CStr(testimonial)
Print #nF, CStr(kolvouzlov),
For nwwd = 1 To kolvouzlov
If MasKoLuZv(nwwd, 1) > 0 Then
Write #nF,
For j = 1 To 5
Print #nF, MasKoLuZv(nwwd, j),
Next j
End If
Next nwwd '-конец ввода массива узлов
Write #nF,
Write #nF,
Print #nF, CStr(kolvolin),
For nwwd = 1 To kolvolin
If mlinesSV(nwwd, 1) > 0 Then
Write #nF,
For j = 1 To 10
If j = 10 Then
Print #nF, (mlinesSV(nwwd, j) * 1000),
Else
Print #nF, mlinesSV(nwwd, j),
End If
Next j
End If
Next nwwd '- конец ввода массива линий
Write #nF,
needFRsave = False
23:
Close #nF
FrmSSN.Enabled = True
FrmSSN.MousePointer = 0
Exit Sub
kasjakmet:
Select Case Err
Case Is = 76
clermgs = " Путь " & SFALNAME & " НЕ найден "
SFALNAME = ""
Case Is = 62
GoTo 23
Case Is = 53
clermgs = " Требуемый файл был удален или перемещен "
clermgs = clermgs & vbCrLf & " Используйте меню " & " Файл \ Сохранить как..."
Case Else
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo 23
End Select
nwwd = MsgBox(clermgs, vbInformation + vbOKOnly, _
" Ошибка сохранения файла")
cldfilfunk.FileName = ""
GoTo 23
End Sub
Public Sub ZAPWEB ( )
If keeCH = False Then
CmdWEB_Click
Else
CmdWEB_Click
keeCH = False
CmdWEB_Click
End If
End Sub
Private Sub mnuWBconf_Click ( )
On Error GoTo 1111
Load FrmPrWeb
FrmPrWeb.Show vbModal
brt1:
Exit Sub
1111:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brt1
End Sub
Private Sub mnuwebYN_Click ( ) '-активизация/де активизация сетки
Static webyes As Integer
On Error GoTo metERSS01
webyes = webyes + 1
If webyes = 1 Then
mnuwebYN.Checked = True: CmdWEB.Enabled = True
mnuWBconf.Enabled = True
Else
webyes = 0
mnuwebYN.Checked = False: CmdWEB.Enabled = False
mnuWBconf.Enabled = False
End If
brcout1:
Exit Sub
metERSS01:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout1
End Sub
Private Sub nnOuzN_GotFocus (Index As Integer)
nnOuzN(Index).SelStart = 0
nnOuzN(Index).SelLength = 3
End Sub
Private Sub nnOuzN_KeyPress (Index As Integer, KeyAscii As Integer)
Dim messege0 As Integer, zapMuzElin As Integer