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

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