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

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11