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

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, " Ошибка пользовательского ввода !!! ")

Страницы: 1, 2, 3, 4