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

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

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