On Error GoTo metERSS1
If Optlinswyazi.Value = True Or Opt1.Value = True Then Exit Sub
If KeyAscii = 13 Then
If KeyAscii = 13 And nnOuzN(Index).Locked = True Then Exit Sub
If Val(nnOuzN(Index).Text) = 0 Or Not IsNumeric(nnOuzN(Index)) Then
messege0 = MsgBox("Данный параметр НЕ может содержать буквенные или нулевые значения ", vbCritical + vbOKOnly, " Ошибка пользовательского ввода !!! ")
Exit Sub
Else
nnOuzN(Index).Text = Val(nnOuzN(Index).Text)
nnOuzN(Index).BackColor = RGB(0, 250, 243)
nnOuzN(Index).Locked = True: nnOuzN(Index).Locked = True
'- код присвоения нового номера узлу < и в м линий >
For zapMuzElin = 1 To kolvouzlov
If MasKoLuZv(zapMuzElin, 1) = Index Then
MasKoLuZv(zapMuzElin, 5) = Val(nnOuzN(Index).Text)
End If
Next zapMuzElin
For zapMuzElin = 1 To kolvolin
If mlinesSV(zapMuzElin, 1) > 0 Then
If mlinesSV(zapMuzElin, 1) = Index Then
mlinesSV(zapMuzElin, 8) = Val(nnOuzN(Index).Text)
ElseIf mlinesSV(zapMuzElin, 2) = Index Then
mlinesSV(zapMuzElin, 9) = Val(nnOuzN(Index).Text)
End If
End If
Next zapMuzElin
'-присвоение нового номера узлу<и в м линий>
needFRsave = True
testimonial = True
End If
Else
If nnOuzN(Index).Locked = True Then
messege0 = MsgBox("Вы хотите изменить номер выбранного узла : " _
& nnOuzN(Index).Text , vbQuestion + vbYesNo, " Изменение номера узла ")
If messege0 = vbYes Then
nnOuzN(Index).BackColor = vbGreen
nnOuzN(Index).Locked = False
Exit Sub
End If
End If
End If
brcout10:
Exit Sub
metERSS1:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout10
End Sub
Private Sub Opt1_Click ( )
Opt1.Value = True
If keeAB = False Then CmdFwd.Enabled = True
End Sub
Private Sub Opt1_GotFocus ( )
Opt1.DownPicture = LoadPicture(App.Path & "\Arrow_1.cur")
If keeAB = False Then
CmdFwd.Enabled = True
Else
CmdFwd.Enabled = False
CmdWORKsch.Enabled = True
CmdBk.Enabled = True
End If
End Sub
Private Sub Opt1_LostFocus ( )
Opt1.Picture = LoadPicture(App.Path & "\Busy_m.cur")
End Sub
Private Sub Optlinswyazi_Click ( )
CmdFwd.Enabled = False
CmdBk.Enabled = False
Optlinswyazi.Value = True
Opt1.Picture = LoadPicture(App.Path & "\Busy_m.cur")
Picture1.MousePointer = vbArrow
End Sub
Private Sub Optuzel_Click ( )
CmdFwd.Enabled = False
CmdBk.Enabled = False
Optuzel.Value = True
Opt1.Picture = LoadPicture(App.Path & "\Busy_m.cur")
Picture1.MousePointer = 2
End Sub
Private Sub svjaziuz (idsuz1 As Integer, idsuz2 As Integer, MasKoLuZv, kolvouzlov)
Dim nomuz As Integer
On Error GoTo metERSS2
For nomuz = 1 To kolvouzlov
If MasKoLuZv(nomuz, 1) > 0 And MasKoLuZv(nomuz, 1) = _
idsuz1 Or MasKoLuZv(nomuz, 1) = idsuz2 Then
MasKoLuZv(nomuz, 4) = MasKoLuZv(nomuz, 4) + 1
End If
Next nomuz
brcout20:
Exit Sub
metERSS2:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout20
End Sub
Private Sub Pct1_GotFocus(Index As Integer)
Pct1(Index).MousePointer = vbArrow
End Sub
Private Sub testlSN (tochka1 As Integer, tochka2 As Integer, SVLT( ) As Single, _
zkk As Boolean)
Dim mnl As Integer, msSVsp As Integer
On Error GoTo metERSS3
FrmSSN.Enabled = False
FrmSSN.MousePointer = 11
FrmSSN.Picture1.MousePointer = 11
For mnl = 1 To kolvolin
If SVLT(mnl, 1) > 0 Then
If SVLT(mnl, 1) = tochka1 And SVLT(mnl, 2) = tochka2 Or SVLT(mnl, 2) = _
tochka1 And SVLT(mnl, 1) = tochka2 Then
msSVsp = MsgBox(" Выбранная вами пара узлов уже соединена ", _
vbInformation + vbOKOnly, " Ограничение ввода ")
zkk = True
FrmSSN.Enabled = True
FrmSSN.MousePointer = 0
Exit Sub
End If
End If
Next mnl
zkk = False
FrmSSN.Enabled = True
FrmSSN.MousePointer = 0
FrmSSN.Picture1.MousePointer = 1
brcout30:
Exit Sub
metERSS3:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout30
End Sub
Private Sub Pct1_MouseDown (Index As Integer, Button As Integer, Shift As Integer, _
x As Single, Y As Single)
Static iduzla As Integer, i As Integer
Dim nResult As Integer, niduzla As Integer
Dim nPredeL1 As Integer
On Error GoTo metERSS4
If Optlinswyazi.Value = True And Button <> vbRightButton Then
If keeAB = True Then Exit Sub
Pct1(Index).BackColor = vbBlack
If znak = True Then
x1 = Pct1(Index).Left + ((Pct1(Index).Width) / 2)
y1 = Pct1(Index).Top + (Pct1(Index).Height / 2)
iduzla = Index
znak = False
Else:
If iduzla = Index Then Exit Sub
x2 = Pct1(Index).Left + (Pct1(Index).Width / 2)
y2 = Pct1(Index).Top + (Pct1(Index).Height / 2)
nResult = MsgBox(" Соединить узлы ? ", vbYesNo + vbExclamation, _
" Соединение выбранных узлов !")
If nResult = vbYes Then
zamok = False
Pct1(iduzla).BackColor = vbBlue: Pct1(Index).BackColor = vbBlue
svjaziuz iduzla, Index, MasKoLuZv, kolvouzlov
testlSN iduzla, Index, mlinesSV, zamok
If zamok = True Then GoTo 2
kolvolin = kolvolin + 1
LblLN(1).Caption = Str(kolvolin)
If kolvolin > 400 Then
nPredeL1 = MsgBox(" количество линий = 400 ! ", vbOKOnly, _
" предел количества линий ")
If nPredeL1 = vbOK Then GoTo 2
End If
svayzy x1, x2, y1, y2, iduzla, Index, mlinesSV, kolvolin
needFRsave = True
change = True
Picture1_GotFocus
Else:
2:
x1 = 0
x2 = 0
y1 = 0
y2 = 0
znak = True
Pct1(iduzla).BackColor = vbBlue: Pct1(Index).BackColor = vbBlue
End If
End If
ElseIf Button = vbRightButton And Optuzel.Value = True Then
If keeAB = True Then Exit Sub
Pct1_deluzel Index, Button, Shift, x, Y '- удаление узла и его линий
Exit Sub
End If
brcout40:
Exit Sub
metERSS4:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout40
End Sub
Private Sub Pct1_deluzel (Index As Integer, Button As Integer, Shift As Integer, _
x As Single, Y As Single)
Dim nResult As Integer, eraseslin As Integer
Dim i As Integer, j As Integer
Dim o As Integer
On Error GoTo metERSS5
Pct1(Index).BackColor = vbRed
nResult = MsgBox(" Удалить узел ?", vbYesNo + vbExclamation, _
" Удаление выбранного узла ! ")
If nResult = vbYes Then
NeWorKorrkolUZ Index, kolvouzlov, x, Y, 0 '-коррекция числа узлов
kolvouzlov = kolvouzlov - 1
LbluZ(1).Caption = Str(kolvouzlov)
Unload nnOuzN(Index)
Unload Pct1(Index)
needFRsave = True
change = True
eraseslin = 0 '- удаление связанных с узлом линий
If kolvolin > 0 Then
FrmSSN.Frame1.Enabled = False
FrmSSN.Picture1.MousePointer = 11
For i = 1 To kolvolin
If mlinesSV(i, 1) = Index Or mlinesSV(i, 2) = Index Then
mlinesSV(i, 1) = 0: mlinesSV(i, 2) = 0: mlinesSV(i, 3) = 0
mlinesSV(i, 4) = 0: mlinesSV(i, 5) = 0: mlinesSV(i, 6) = 0
mlinesSV(i, 7) = 0: mlinesSV(i, 8) = 0: mlinesSV(i, 9) = 0: mlinesSV(i, 10) = 0
eraseslin = eraseslin + 1
End If
Next i
FrmSSN.Frame1.Enabled = True
FrmSSN.Picture1.MousePointer = 0
korrmlinesSV mlinesSV, kolvolin, eraseslin
bJampWeb = True
CmdWEB_Click
bJampWeb = False
End If
Else: Pct1(Index).BackColor = vbBlue: End If
brcout50:
Exit Sub
metERSS5:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout50
End Sub
Private Sub korrmlinesSV (mlinesSV, kolvolin, eraseslin)
Dim masslinesSV() As Single, fth As Integer
Dim i As Integer, j As Integer
FrmSSN.Frame1.Enabled = False
FrmSSN.Picture1.MousePointer = 11
On Error GoTo metERSS6
ReDim Preserve masslinesSV((kolvolin - eraseslin), 10)
fth = 0
For i = 1 To kolvolin
If mlinesSV(i, 1) > 0 Then
fth = fth + 1
If fth <= (kolvolin - eraseslin) Then
For j = 1 To 10
masslinesSV(fth, j) = mlinesSV(i, j): mlinesSV(i, j) = 0
Next j
End If
End If
Next i
For i = 1 To (kolvolin - eraseslin)
For j = 1 To 10
mlinesSV(i, j) = masslinesSV(i, j)
masslinesSV(i, j) = 0
Next j
Next i:
kolvolin = kolvolin - eraseslin
LblLN(1).Caption = Str(kolvolin)
FrmSSN.Frame1.Enabled = True
FrmSSN.Picture1.MousePointer = 1
brcout60:
Exit Sub
metERSS6:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout60
End Sub
Private Sub Picture1_GotFocus ( )
If Optlinswyazi.Value = True And x1 <> 0 And y2 <> 0 And y1 <> 0 Or x2 <> 0 Then
Picture1.DrawStyle = 6
Picture1.Line (x1, y1)-(x2, y2), vbBlue
x1 = 0
x2 = 0
y1 = 0
y2 = 0
znak = True
End If
Picture1.DrawStyle = 6
End Sub
Private Sub Picture1_MouseDown (Button As Integer, Shift As Integer, x As Single, _
Y As Single)
Dim i As Integer, txtid As Integer
On Error GoTo metERSS7
Picture1.DrawStyle = 6
i = Pct1.UBound
txtid = nnOuzN.UBound
Pct1(i).MousePointer = vbArrow
If Optuzel.Value = True And kolvouzlov <= 200 Then
If keeAB = True Then Exit Sub
If x < (Pct1(i).Width / 2) Or ((Picture1.Width) - x) < (Pct1(i).Width / 2) Or _
Y < (Pct1(i).Height / 2) Or ((Picture1.Height) - Y) < (Pct1(i).Height / 2) Then Exit Sub
Load nnOuzN (txtid + 1)
Load Pct1(i + 1)
Pct1(i + 1).Move x - Pct1(i + 1).Width / 2, Y - Pct1(i + 1).Height / 2
Pct1(i + 1).Visible = True
znak = True
kolvouzlov = kolvouzlov + 1
NeWorKorrkolUZ 0, kolvouzlov, x, Y, i '- запись новых узлов
LbluZ(1).Caption = Str(kolvouzlov)
needFRsave = True
change = True
Else
If Optlinswyazi.Value = True And Button = vbRightButton Then
SVPprln mlinesSV, x, Y
End If
End If
brcout70:
Exit Sub
metERSS7:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout70
End Sub
Private Sub svjasiUZdel (numlinBRC As Integer, allUZsee As Integer)
Dim UNz As Integer
On Error GoTo metERSS8
FrmSSN.Frame1.Enabled = False
FrmSSN.Picture1.MousePointer = 11
For UNz = 1 To allUZsee
If MasKoLuZv(UNz, 1) > 0 Then
If MasKoLuZv(UNz, 1) = mlinesSV(numlinBRC, 1) Or MasKoLuZv(UNz, 1) = _
mlinesSV(numlinBRC, 2) Then
MasKoLuZv(UNz, 4) = MasKoLuZv(UNz, 4) - 1
End If
End If
Next UNz
FrmSSN.Frame1.Enabled = True
FrmSSN.Picture1.MousePointer = 1
brcout80:
Exit Sub
metERSS8:
MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"
GoTo brcout80
End Sub
Private Sub SVPprln (mlinesSV, x, Y)
Dim l As Integer, yyy As Double
Dim xxx As Double, nSovpad As Integer
Dim StrLinsV As Integer, DelAscK As Integer
Dim flagsovp As Boolean, raznostimin() As Double
Dim nuy As Integer, whatlin( ) As Integer
On Error GoTo metERSS9
FrmSSN.Frame1.Enabled = False
FrmSSN.Picture1.MousePointer = 11
nSovpad = 0
For l = 1 To kolvolin
If mlinesSV(l, 3) >= mlinesSV(l, 5) And mlinesSV(l, 3) - mlinesSV(l, 5) <= 15 Then GoTo 73
If mlinesSV(l, 3) <= mlinesSV(l, 5) And mlinesSV(l, 5) - mlinesSV(l, 3) <= 15 Then
73:Select Case x
Case Is >= mlinesSV(l, 3)
If x - mlinesSV(l, 3) <= 17 Then GoTo 77
Case Is <= mlinesSV(l, 3)
If mlinesSV(l, 3) - x <= 17 Then GoTo 77
Case Is >= mlinesSV(l, 5)
If x - mlinesSV(l, 5) <= 17 Then GoTo 77
Case Is <= mlinesSV(l, 5)
If mlinesSV(l, 5) - x <= 17 Then
77:StrLinsV = l
FlinEd raznostimin, whatlin, x, Y, StrLinsV, mlinesSV, nSovpad, StrLinsV
If StrLinsV <> 0 Then
nSovpad = 1
GoTo 78
End If
End If
End Select
Else
If mlinesSV(l, 4) >= mlinesSV(l, 6) And mlinesSV(l, 4) - mlinesSV(l, 6) <= 15 Then GoTo 74
If mlinesSV(l, 4) <= mlinesSV(l, 6) And mlinesSV(l, 6) - mlinesSV(l, 4) <= 15 Then
74:
Select Case Y
Case Is >= mlinesSV(l, 4)
If Y - mlinesSV(l, 4) <= 17 Then GoTo 77
Case Is <= mlinesSV(l, 4)
If mlinesSV(l, 4) - Y <= 17 Then GoTo 77
Case Is >= mlinesSV(l, 6)
If Y - mlinesSV(l, 6) <= 17 Then GoTo 77
Case Is <= mlinesSV(l, 6)
If mlinesSV(l, 6) - Y <= 17 Then GoTo 77
End Select
End If
End If
Next l
For l = 1 To kolvolin
If mlinesSV(l, 6) = mlinesSV(l, 4) Then mlinesSV(l, 6) = (mlinesSV(l, 6) + 2)
If mlinesSV(l, 5) = mlinesSV(l, 3) Then mlinesSV(l, 5) = (mlinesSV(l, 5) + 2)
yyy = ((Y - mlinesSV(l, 4)) / (mlinesSV(l, 6) - mlinesSV(l, 4)))
xxx = ((x - mlinesSV(l, 3)) / (mlinesSV(l, 5) - mlinesSV(l, 3)))
If xxx < 0 Then xxx = (xxx * (-1))
If yyy < 0 Then yyy = (yyy * (-1))
If xxx = 0 Or yyy = 0 Then GoTo 36
If yyy >= xxx And (yyy - xxx) < 0.554 Then
36: nuy = nuy + 1
ReDim Preserve raznostimin(nuy)
raznostimin(nuy) = (yyy - xxx): GoTo 32
ElseIf yyy <= xxx And (xxx - yyy) < 0.554 Then
nuy = nuy + 1
ReDim Preserve raznostimin(nuy)
raznostimin(nuy) = (xxx - yyy)
32: nSovpad = nSovpad + 1: StrLinsV = l
ReDim Preserve whatlin(1, nSovpad)
whatlin(1, nSovpad) = l
FlinEd raznostimin, whatlin, x, Y, StrLinsV, mlinesSV, nSovpad, StrLinsV
End If
yyy = 0: xxx = 0
Next l
If nSovpad > 1 Then
flagsovp = False
lIniTiS whatlin, nSovpad, StrLinsV, raznostimin( ), flagsovp
If flagsovp = True Then nSovpad = 1
End If
78:
FrmSSN.Frame1.Enabled = True
FrmSSN.Picture1.MousePointer = 1
If nSovpad = 1 And StrLinsV <> 0 Then
mlinesSV(StrLinsV, 7) = 1
bJampWeb = True
CmdWEB_Click
bJampWeb = False
If keeAB = True Then GoTo 179
DelAscK = MsgBox("Удалить линию ? ", vbExclamation + vbYesNo, _
" Удаление выбранной линии ")
If DelAscK = vbYes Then
bJampWeb = True
svjasiUZdel StrLinsV, kolvouzlov
mlinesSV(StrLinsV, 1) = 0: mlinesSV(StrLinsV, 2) = 0: mlinesSV(StrLinsV, 3) = 0
mlinesSV(StrLinsV, 4) = 0: mlinesSV(StrLinsV, 5) = 0: mlinesSV(StrLinsV, 6) = 0
mlinesSV(StrLinsV, 7) = 0: mlinesSV(StrLinsV, 8) = 0: mlinesSV(StrLinsV, 9) = 0
mlinesSV(StrLinsV, 10) = 0
korrmlinesSV mlinesSV, kolvolin, nSovpad
needFRsave = True
change = True
CmdWEB_Click
bJampWeb = False
Else
mlinesSV(StrLinsV, 7) = 0
176: bJampWeb = True
CmdWEB_Click
bJampWeb = False
End If
End If
Exit Sub
179:
Load FrmNwORsZ
FrmNwORsZ.TxtOzN(0).Text = mlinesSV(StrLinsV, 10)
FrmNwORsZ.TxtOzN(0).Locked = True
FrmNwORsZ.Show vbModal
If Len(FrmNwORsZ.TxtOzN(1).Text) <> 0 Then
mlinesSV(StrLinsV, 10) = Val(FrmNwORsZ.TxtOzN(1).Text)
Unload FrmNwORsZ
mlinesSV(StrLinsV, 7) = 2