Исследование структурной надежности методом статистического моделирования

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

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

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

needFRsave = True

testimonial = True

GoTo 176

ElseIf mlinesSV(StrLinsV, 10) <> 0 Then

mlinesSV(StrLinsV, 7) = 2

GoTo 176

Else

mlinesSV(StrLinsV, 7) = 0

GoTo 176

End If

brcout90:

Exit Sub

metERSS9:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo brcout90

End Sub

Private Sub NeWorKorrkolUZ (deliduz, kolvouzlov, x, Y, ci)

Dim iuz As Integer, juz As Integer

Dim UZkorR() As Integer, ff As Integer

Dim kkk As Integer

On Error GoTo metERSS10

If deletealluz = True And kolvouzlov > 0 Then

FrmSSN.Enabled = False

FrmSSN.MousePointer = 11

For iuz = 1 To kolvouzlov

If MasKoLuZv(iuz, 1) <> 0 Then

Unload nnOuzN(MasKoLuZv(iuz, 1))

Unload Pct1(MasKoLuZv(iuz, 1))

End If

For juz = 1 To 5

MasKoLuZv(iuz, juz) = 0

Next juz

Next iuz

kolvouzlov = 0

Else

FrmSSN.Enabled = True

FrmSSN.MousePointer = 0

If deliduz = 0 Then

For iuz = 1 To kolvouzlov

If MasKoLuZv(iuz, 1) = 0 Then

MasKoLuZv(iuz, 1) = ci + 1: MasKoLuZv(iuz, 2) = x

MasKoLuZv(iuz, 3) = Y: MasKoLuZv(iuz, 4) = 0

MasKoLuZv(iuz, 5) = 0

End If

Next iuz

Else

FrmSSN.Enabled = False

FrmSSN.MousePointer = 11

If kolvouzlov = 1 Then kkk = kolvouzlov Else kkk = kolvouzlov - 1

ReDim Preserve UZkorR(kkk, 5)

For iuz = 1 To kolvouzlov

If deliduz = MasKoLuZv(iuz, 1) Then

MasKoLuZv(iuz, 1) = 0: MasKoLuZv(iuz, 2) = 0: MasKoLuZv(iuz, 3) = 0

MasKoLuZv(iuz, 4) = 0: MasKoLuZv(iuz, 5) = 0

End If

Next iuz

For iuz = 1 To kolvouzlov

If MasKoLuZv(iuz, 1) <> 0 Then

ff = ff + 1

For juz = 1 To 5

UZkorR(ff, juz) = MasKoLuZv(iuz, juz): MasKoLuZv(iuz, juz) = 0

Next juz

End If

Next iuz

For iuz = 1 To kolvouzlov - 1

For juz = 1 To 5

MasKoLuZv(iuz, juz) = UZkorR(iuz, juz)

Next juz: Next iuz

End If

End If

FrmSSN.Enabled = True

FrmSSN.MousePointer = 0

brcout100:

Exit Sub

metERSS10:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo brcout100

End Sub

Private Sub lIniTiS (whatlin, nSovpad, StrLinsV, raznostimin() As Double, _

sovp As Boolean)

Dim ar As Integer, perehod As Boolean

Dim vib As Integer, arda As Integer

Dim prraznmin(1) As Double, wtlpr() As Integer

ReDim Preserve wtlpr(1, nSovpad)

On Error GoTo metERSS11

For arda = 1 To nSovpad '- 1

For ar = 1 To nSovpad - 1

If raznostimin(ar) = 0 And raznostimin(ar + 1) > 0 Then

raznostimin(ar) = raznostimin(ar + 1): raznostimin(ar + 1) = 0

whatlin(1, ar) = whatlin(1, ar + 1): whatlin(1, ar + 1) = 0

ElseIf raznostimin(ar) > raznostimin(ar + 1) And raznostimin(ar + 1) <> 0 Then

prraznmin(1) = raznostimin(ar): wtlpr(1, ar) = whatlin(1, ar)

raznostimin(ar) = raznostimin(ar + 1): whatlin(1, ar) = whatlin(1, ar + 1)

raznostimin(ar + 1) = prraznmin(1): whatlin(1, ar + 1) = wtlpr(1, ar)

End If

Next ar

Next arda

ar = 0: arda = 0

For ar = 1 To nSovpad

If raznostimin(ar) > 0 Then

StrLinsV = whatlin(1, ar): whatlin(1, ar) = 0

sovp = True

Exit For

End If

Next ar

ar = 0

brcout110:

Exit Sub

metERSS11:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo brcout110

End Sub

Private Sub FlinEd (rzn( ) As Double, wlinw( ) As Integer, x, Y, StrLV, mlSV, _

SVPD As Integer, StrLinsV)

On Error GoTo metERSS12

If mlSV(StrLV, 3) < x And x > mlSV(StrLV, 5) Then GoTo 977

If mlSV(StrLV, 3) > x And x < mlSV(StrLV, 5) Then GoTo 977

If mlSV(StrLV, 4) < Y And Y > mlSV(StrLV, 6) Then GoTo 977

If mlSV(StrLV, 4) > Y And Y < mlSV(StrLV, 6) Then

977:

If SVPD <> 0 Then rzn(SVPD) = 0

StrLinsV = 0

Else

If mlSV(StrLV, 3) = x And x <> mlSV(StrLV, 5) Then

Select Case x

Case Is > mlSV(StrLV, 5)

If x - mlSV(StrLV, 5) > 17 Then GoTo 977

Case Is < mlSV(StrLV, 5)

If mlSV(StrLV, 5) - x > 17 Then GoTo 977

End Select

End If

If mlSV(StrLV, 3) <> x And x = mlSV(StrLV, 5) Then

Select Case x

Case Is > mlSV(StrLV, 3)

If x - mlSV(StrLV, 3) > 17 Then GoTo 977

Case Is < mlSV(StrLV, 3)

If mlSV(StrLV, 3) - x > 17 Then GoTo 977

End Select

End If

If mlSV(StrLV, 4) = Y And Y <> mlSV(StrLV, 6) Then

Select Case Y

Case Is > mlSV(StrLV, 6)

If Y - mlSV(StrLV, 6) > 17 Then GoTo 977

Case Is < mlSV(StrLV, 6)

If mlSV(StrLV, 6) - Y > 17 Then GoTo 977

End Select

End If

If mlSV(StrLV, 4) <> Y And Y = mlSV(StrLV, 6) Then

Select Case Y

Case Is > mlSV(StrLV, 4)

If Y - mlSV(StrLV, 4) > 17 Then GoTo 977

Case Is < mlSV(StrLV, 4)

If mlSV(StrLV, 4) - Y > 17 Then GoTo 977

End Select

End If

End If

brcout120:

Exit Sub

metERSS12:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo brcout120

End Sub

Public Sub numUZmu (LN As Integer, MKUN As Integer, a12 As Integer, na1, na2)

Dim t As Integer

Dim td As Integer

For td = 1 To a12

For t = 1 To MKUN

If MasKoLuZv(t, 1) = mlinesSV(LN, td) Then

If td = 1 Then

na1 = t

Exit For

ElseIf td = 2 Then

na2 = t

Exit For

End If

End If

Next t

Next td

End Sub

Public Property Get UvmLN (LNmSV As Integer) As Single

UvmLN = mlinesSV(LNmSV, 10)

End Property

Public Property Get webchS (NWMW As Integer) As Single

Select Case NWMW

Case Is = 1

webchS = shwebx

Case Is = 2

webchS = shweby

End Select

End Property

Вторая часть

Dim flagnext As Boolean, flaghehe As Boolean

Private Sub CmdNOWer_Click ( )

Unload frmBrWk

End Sub

Private Sub CmdOKWer_Click ( )

Dim msg As Integer

If frmBrWk.FramNsInf.Caption = "Расчет" Then Exit Sub

If TextMNI.Locked = True Then Exit Sub

If Val(TextMNI.Text) = 0 Or Not IsNumeric(TextMNI) Then

msg = MsgBox("Данный параметр НЕ может содержать буквенные или _

нулевые значения " & vbCrLf & _

" Значением параметра может быть только целое число !!! " _

, vbCritical + vbOKOnly, " Ошибка пользовательского ввода !!! ")

Exit Sub

Else

MdlWorkSpase.maxNnoi = Val(TextMNI.Text)

TextMNI.BackColor = RGB(0, 250, 243)

TextMNI.Locked = True: TextMNI.Locked = True

needFRsave = True

flagnext = True

End If

End Sub

Private Sub CmmEd_Click ( )

Dim edms As Integer

If flaghehe = True Then Exit Sub

MdlWorkSpase.flgstopuser = True

edms = MsgBox(" Прервано пользователем !", vbInformation + vbOKOnly, _

" Останов расчета структурной надежности")

frmBrWk.PrgBarWSind.Value = 0

frmBrWk.FramNsInf.Enabled = True

flaghehe = True

End Sub

Private Sub CmmSt_Click ( )

Dim hehe As Integer

If flagnext = False Then

hehe = MsgBox(" Невозможно начать расчет Немея числа испытаний !!!", _

vbCritical + vbOKOnly, " Ошибка пользовательского ввода ")

flaghehe = True

Exit Sub

End If

frmBrWk.FramNsInf.Enabled = False

MdlWorkSpase.flgstopuser = False

flaghehe = False

MdlWorkSpase.cmdrasch_workmod

End Sub

Private Sub Form_Load ( )

frmBrWk.FramNsInf.ZOrder 0

flagnext = False

frmBrWk.FramNsInf.Enabled = True

End Sub

Private Sub TbSW_Click ( )

Dim ntemp As Integer

ntemp = TbSW.SelectedItem.Index

If ntemp = 2 Then

frmBrWk.FramNsInf.ZOrder 1

frmBrWk.FramWorkStart.ZOrder 0

ElseIf ntemp = 1 Then

frmBrWk.FramNsInf.ZOrder 0

frmBrWk.FramWorkStart.ZOrder 1

End If

End Sub

Private Sub TextMNI_KeyPress (KeyAscii As Integer)

Dim m2sg As Integer

If frmBrWk.FramNsInf.Caption = "Расчет" Then Exit Sub

If TextMNI.Locked = True Then

msg = MsgBox("Вы хотите изменить число испытаний ? : " & TextMNI.Text _

, vbQuestion + vbYesNo, " Новое число испытаний ")

If msg = vbYes Then

TextMNI.BackColor = vbGreen

TextMNI.Locked = False

Exit Sub

End If

End If

End Sub

Третья часть

Option Explicit

Private Sub CmdnulST_Click ( )

On Error GoTo 2311

FrmSSN.poweb = False

FrmSSN.bJampWeb = False

FrmSSN.ZAPWEB

Unload FrmPrWeb

2311:

End Sub

Private Sub CmdWno_Click ( )

Unload FrmPrWeb

End Sub

Private Sub CmdWOK_Click ( )

FrmPrWeb.Hide

End Sub

Private Sub CmdWup_Click ( )

Dim xsh As Single

Dim ysh As Single

Dim msnoes As Integer

On Error GoTo Qat5

If CheckNames2(TxtWbMm.Text) = False Or Len(TxtWbMm.Text) = 0 Then

msnoes = MsgBox("Значение масштаба НЕ может содержать пробелы !" _

& vbCrLf & "Данный параметр может содержать только числа !", _

vbCritical + vbOKOnly, " Ошибка пользовательского ввода !!! ")

CmdWup.Enabled = True

FramWMb.Enabled = True

Exit Sub

End If

If OptWW1(1).Value = False Then

'(1440 / 2.54)-при 72dpi ,(1080/2.54) - при 96dpi

xsh = (1080 / 2.54) * CSng(TxtXYwB(0))

FrmSSN.shwebx = 0

FrmSSN.shwebx = Round(xsh)

FrmSSN.shweby = 0

FrmSSN.shweby = Round(xsh)

Else

xsh = (1080 / 2.54) * CSng(TxtXYwB(0))

ysh = (1080 / 2.54) * CSng(TxtXYwB(1))

FrmSSN.shwebx = 0

FrmSSN.shwebx = Round(xsh)

FrmSSN.shweby = 0

FrmSSN.shweby = Round(ysh)

End If

FrmSSN.poweb = True

CmdWup.Enabled = False

FramWMb.Enabled = False

FrmSSN.bJampWeb = False 'True

FrmSSN.ZAPWEB

If UpDnXY(1).Enabled = False And LstWmB.ListIndex > (-1) Then

FrmSSN.LblMB2.Caption = FrmPrWeb.TxtWbMm.Text & Chr$(32) & _

FrmPrWeb.LstWmB.List(LstWmB.ListIndex)

ElseIf LstWmB.ListIndex = (-1) And UpDnXY(1).Enabled = False Then

msnoes = MsgBox("Вы не выбрали единицы измерения масштаба ! ", _

vbCritical + vbOKOnly, " Ошибка пользовательского ввода")

CmdWup.Enabled = True

FramWMb.Enabled = True

Exit Sub

End If

bcoutQ5:

Exit Sub

Qat5:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo bcoutQ5

End Sub

Private Function CheckNames2 (name As String) As Boolean

Dim Result As Boolean

On Error GoTo Qat6

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

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

If (InStr(name, "<")) Then Result = False

If (InStr(name, "|")) Then Result = False

CheckNames2 = Result

bcoutQ6:

Exit Function

Qat6:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo bcoutQ6

End Function

Private Sub Form_Load ( )

Dim promw1 As Single

Dim promw2 As Single

Dim spwx As Single

Dim spwy As Single

On Error GoTo Qat1

OptWW1(0).Value = True

promw1 = FrmSSN.webchS(1)

promw2 = FrmSSN.webchS(2)

If promw1 = promw2 And promw1 > 201 Then

TxtXYwB(0).Text = (2.54 * promw1) / 1080

spwx = (2.54 * promw1) / 1080

If spwx > 0.5 Then

spwx = (spwx - 0.5) * 10

Else

spwx = (0.5 - spwx) * 10

End If

UpDnXY(0).Value = spwx

TxtXYwB(1).Text = (2.54 * promw2) / 1080

spwy = (2.54 * promw2) / 1080

If spwy > 0.5 Then

spwy = (spwy - 0.5) * 10

Else

spwy = (0.5 - spwy) * 10

End If

UpDnXY(1).Value = spwy

End If

bcoutQ1:

Exit Sub

Qat1:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo bcoutQ1

End Sub

Private Sub OptWW1_Click (Index As Integer)

On Error GoTo Qat2

CmdWup.Enabled = True

If Index = 0 Then

FramWMb.Enabled = True

OptWW1(0).Value = True

TxtXYwB(1).Enabled = False

UpDnXY(1).Enabled = False

FrmSSN.LblMB2.Enabled = True

ElseIf Index = 1 Then

FramWMb.Enabled = False

OptWW1(1).Value = True

TxtXYwB(1).Enabled = True

UpDnXY(1).Enabled = True

FrmSSN.LblMB2.Enabled = False

End If

bcoutQ2:

Exit Sub

Qat2:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo bcoutQ2

End Sub

Private Sub TxtWbMm_Change ( )

Dim mgW As Integer

On Error GoTo Qat3

If Len(TxtWbMm.Text) > 0 Then

If Asc(TxtWbMm.Text) = 48 Then Exit Sub

If Asc(Mid(TxtWbMm.Text, 1, 1)) = 32 Then

12: mgW = MsgBox("Данный параметр НЕ может содержать пробелов ! ", _

vbCritical + vbOKOnly, " Ошибка пользовательского ввода !!! ")

Exit Sub

ElseIf InStr(1, TxtWbMm.Text, " ") > 0 Then

If Asc(Mid(TxtWbMm.Text, InStr(1, TxtWbMm.Text, " "), 1)) = 32 Then GoTo 12

End If

End If

If Len(TxtWbMm.Text) = 5 And Val(TxtWbMm.Text) = 0 Or _

Val(Mid(TxtWbMm.Text, 1, 1)) = 0 Or Not IsNumeric(TxtWbMm) Then

mgW = MsgBox("Данный параметр может содержать только числа больше нуля!"_

& vbCrLf & "Дробную часть числа отделять ЗАПЯТОЙ ! ", _

vbCritical + vbOKOnly, " Ошибка пользовательского ввода !!! ")

Exit Sub

End If

bcoutQ3:

Exit Sub

Qat3:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo bcoutQ3

End Sub

Private Sub TxtWbMm_GotFocus ( )

TxtWbMm.SelStart = 0

TxtWbMm.SelLength = 5

End Sub

Private Sub UpDnXY_MouseDown (Index As Integer, Button As Integer, _

Shift As Integer, x As Single, Y As Single)

On Error GoTo Qat4

CmdWup.Enabled = True

If OptWW1(1).Value = False Then FramWMb.Enabled = True

If UpDnXY(Index).Value > 0 And UpDnXY(Index).Enabled = True Then

TxtXYwB(Index).Text = 0.5 + (UpDnXY(Index).Value / 10)

ElseIf UpDnXY(Index).Value = 0 And TxtXYwB(Index).Text = 0.6 Then

TxtXYwB(Index).Text = TxtXYwB(Index).Text - 0.1

End If

bcoutQ4:

Exit Sub

Qat4:

MsgBox "Error № " & Err.Number & " " & " (" & Err.Description & ") occured.", vbCritical, "Error"

GoTo bcoutQ4

End Sub

Четвертая часть

Private Sub CmdZNC_Click (Index As Integer)

TxtOzN(1).Text = " "

Unload FrmNwORsZ

End Sub

Private Sub CmdZYL_Click (Index As Integer)

Dim prob As String, nbs As Integer

Dim nokorrZ As Integer

If Len(TxtOzN(1).Text) > 0 And Len(TxtOzN(1).Text) <> 1 Then

prob = TxtOzN(1).Text

For nbs = 1 To Len(TxtOzN(1).Text)

If Asc(Mid(prob, nbs, 1)) = 32 Then GoTo 11

If nbs = 2 And 46 = Asc(Mid(prob, nbs, 1)) Then

GoTo 12

ElseIf nbs = 2 And 46 <> Asc(Mid(prob, nbs, 1)) Then

GoTo 11

ElseIf nbs = 1 And 48 <> Asc(Mid(prob, nbs, 1)) Then

GoTo 11

End If

If 48 > Asc(Mid(prob, nbs, 1)) Or 57 < Asc(Mid(prob, nbs, 1)) Then

11:

nokorrZ = MsgBox(" Значение выбранной линии НЕ может быть целым числом!" _

& vbCrLf & " НЕ может быть больше единицы !" & vbCrLf & _

" НЕ может содержать пробелов или букв !!!", vbCritical + vbOKOnly, _

" Ошибка пользовательского ввода ")

TxtOzN(1).Text = "00000"

prob = TxtOzN(1).Text

Exit Sub

12: End If

Next nbs

TxtOzN(1).Text = prob

TxtOzN(1).BackColor = RGB(0, 250, 243)

TxtOzN(1).Locked = True

FrmNwORsZ.Hide

Else

nokorrZ = MsgBox(" Вы ввели пустую строку или целое число !!! ", _

vbCritical + vbOKOnly, " Ошибка пользовательского ввода ")

End If

End Sub

Private Sub TxtOzN_GotFocus (Index As Integer)

TxtOzN(1).SelStart = 0

TxtOzN(1).SelLength = Len(TxtOzN(1).Text)

End Sub

3 БЕЗОПАСНОСТЬ ЖИЗНЕДЕЯТЕЛЬНОСТИ

Так как большая часть дипломной работы выполняется на компьютере, то в данном разделе мы рассмотрим некоторые вопросы охраны труда при работе с дисплеем.

Психофизиологические требования к дисплею

Под дисплейным устройством понимается устройство ввода-вывода данных для отображения на экране в форме, удобной пользователю, и для ее редактирования в интерактивном режиме. Дисплеи совместно с другими устройствами ввода-вывода являются своеобразным “окном” в ЭВМ, обеспечивая не просто отображение результатов обработки, но и диалог с человеком. Визуализация вопросов и ответов, отображение текстов, рисунков, графиков, аналогичные изображениям в печатных и рукописных материалах, возможность вносить изменения и дополнения в обозримые человеком фрагменты, хранение и повторение материала, перевод его на другие носители и ряд прочих функциональных возможностей делают дисплеи универсальным средством, как отображения, так и управления информацией.

При работе с дисплеем наибольшее количество информации человеку поступает посредством зрительного анализатора, раздражителем которого является свет, а рецептором - глаз. Перегрузка зрительного анализатора приводит к его быстрому утомлению, а иногда и расстройству функций. Поэтому проектирование дисплея осуществляют с учетом психофизиологических требований, вытекающих из особенностей и характеристик зрительного восприятия. На основании психофизиологических требований определяются светотехнические параметры дисплея, размеры экрана и символов, цветовые параметры, скорость смены информации. Предлагаемый набор параметров, прежде всего, применим для дисплеев на базе ЭЛТ, как получивших наиболее широкое распространение и как наиболее полно исследованных.

При определении оптимального яркостного режима восприятия информации с экрана дисплея устанавливают уровень яркости, соотношение яркостей в поле зрения и уровень контраста. Оптимальной считают ту яркость, при которой максимально проявляются контрастная чувствительность глаза, острота зрения и быстрота различения сигналов.

Комфортной нижней границей уровня яркости светящихся сигналов можно считать 30 [кд / м], а верхняя граница определяется значением слепящей яркости. Яркость символов на экране обязательно согласуют с яркостью фона и окружающим освещением. При обратном контрасте яркостный контраст рекомендуется выбирать в пределах 85-90 [%] с возможностью регулировки яркости знака, а при прямом контрасте - 75-80 [%] с возможностью регулировки яркости фона экрана. Прямой контраст предпочтительнее обратного.

Вопрос об использовании цвета при воспроизведении информации на экране решают в каждом конкретном случае путем тщательного анализа и исследования. Учитывают то, что вклад цветового контраста в восприятие яркостного контраста невелик, максимальное проявление остроты зрения находится в желто-зеленой области спектра, скорость различения цветных светящихся знаков минимальна для крайних цветов спектра, при увеличении насыщенности цвета символы воспринимаются лучше.

Выбор размера экрана и символов осуществляют с учетом требуемого объема предъявляемой информации, легкости ее считывания и длительности работы с экраном. Основные ограничения на размеры связаны со стремлением обеспечить оптимальные углы обзора и оптимальную остроту зрения.

Размер полезной площади экрана выбирают в пределах 30, чтобы не превышать оптимального угла зрения 15градусов по вертикали и горизонтали от нормальной линии взора, когда знаки опознаются без поворота головы, а мышцы глаз, шеи и плеч не напряжены. Плоскость экрана располагают перпендикулярно к нормальной линии взора.

Рабочее место

Рабочее место - это оснащенное техническими средствами пространство, где осуществляется деятельность исполнителя. Организацией рабочего места называется система мероприятий по оснащению рабочего места средствами и предметами труда и размещение их в определенном порядке. Совершенствование организации рабочего места является одним из условий, способствующих повышению производительности труда. Организация рабочего места включает антропометрические и биологические характеристики человека, выбор физиологически правильного рабочего положения и рабочих зон, рациональную компоновку рабочего места, учет факторов внешней среды.

Антропометрические характеристики человека определяют габаритные и компоновочные параметры рабочего места и свободные параметры отдельных его элементов.

Положение тела и наиболее частые позы, которые принимает или вынужден принимать человек при выполнении работы, являются одним из основных факторов, определяющих производительность труда. Работу оператора организуют в положении сидя. При этом основная нагрузка падает на мышцы, поддерживающие позвоночный столб и голову, а подавляющая часть массы тела передается на бедра, препятствуя проникновению крови в нижнюю часть тела. Поэтому при длительном сидении время от времени необходимо смещать массу тела и сменять фиксированные рабочие позы. К тому же при работе сидя обычно естественный спинно-поясничный прогиб вперед изменяется на изгиб назад, что зачастую является причиной болей в пояснице. Для физиологически правильно обоснованного рабочего положения сидя рекомендуется обеспечить следующие оптимальные положения частей тела: корпус выпрямлен, сохранены естественные изгибы позвоночного столба и угол наклона таза, нет необходимости в сильных наклонах туловища, поворотах головы и крайних положениях суставов конечностей.

Пространственная организация рабочего места. Это размещение в определенном порядке элементов основного и вспомогательного оборудования относительно друг друга и работающего человека. Пространственная организация рабочего места определяется размерами и формой сенсорного и моторного пространства, формой и параметрами элементов рабочего места и пространственным расположением элементов относительно работающего. Основными элементами рабочего места, оснащенного дисплеем, являются: рабочее кресло, рабочая поверхность, экран дисплея и клавиатура.

Рабочее кресло обеспечивает поддержание рабочей позы, в положении сидя, и чем дольше это положение в течение рабочего дня, тем настоятельнее требования к созданию удобных и правильных рабочих сидений. Можно дать следующие рекомендации по конструированию рабочего кресла: необходимость регулировки наиболее важных его элементов - высоты сиденья, высоты спинки сиденья и угла наклона спинки; причем процесс регулировки не должен быть сложным. Установка правильной высоты сиденья является первоочередной задачей при организации рабочего места, так как этот параметр определяет прочие пространственные параметры - высоту положения экрана, клавиатуры, поверхности для записей, и др. Диапазон регулировки высоты сиденья находится в пределах 380-500 [мм]. Регулируемая высота рабочей поверхности оптимальна в пределах 670-800 [мм], при отсутствии регулировки - 725 [мм]. Высота нижнего ряда клавиатуры от плоскости пола может быть 620-700 [мм], обычно рекомендуют 650 [мм]. Если использован стол стандартной высоты, то для удобства работы клавиатуру можно разместить в углублении стола или на отдельной плоскости. Передний ряд клавиш располагают таким образом, чтобы клавиатуру можно было без труда, обслуживать, слегка, согнутыми, пальцами, при, свободно опущенных плечах, и горизонтальном, положении рук; плечо и предплечье при этом образуют угол в 90 градусов. Высота экрана определяется высотой уровня глаз наблюдателя и требованием перпендикулярности плоскости экрана к нормальной линии взора. Если позволяют размеры и масса, то рекомендуется снабжать экраны основанием с поворотным кронштейном, допускающим регулировку экрана по высоте, по наклону вперед-назад и при горизонтальном вращении вокруг вертикальной оси.