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)