Исследование структурной надежности методом статистического моделирования
Точные и приближенные методы анализа структурной надежности. Критерии оценки структурной надежности методом статистического моделирования. Разработка алгоритма и программы расчета структурной надежности. Методические указания по работе с программой.
Рубрика | Программирование, компьютеры и кибернетика |
Вид | дипломная работа |
Язык | русский |
Дата добавления | 17.11.2010 |
Размер файла | 857,8 K |
Отправить свою хорошую работу в базу знаний просто. Используйте форму, расположенную ниже
Студенты, аспиранты, молодые ученые, использующие базу знаний в своей учебе и работе, будут вам очень благодарны.
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 градусов. Высота экрана определяется высотой уровня глаз наблюдателя и требованием перпендикулярности плоскости экрана к нормальной линии взора. Если позволяют размеры и масса, то рекомендуется снабжать экраны основанием с поворотным кронштейном, допускающим регулировку экрана по высоте, по наклону вперед-назад и при горизонтальном вращении вокруг вертикальной оси.
Подобные документы
Построение графика изменения вероятности безотказной работы системы согласно структурной схемы. Порядок определения процентной наработки технической системы, обеспечение ее увеличения за счет повышения надежности элементов, структурного резервирования.
контрольная работа [482,9 K], добавлен 12.05.2009Анализ зависимостей вероятности безотказной системы работы от времени (наработки), который показывает, что способ повышения надежности системы структурным резервированием является эффективным. Методы повышения надежности и увеличения наработки системы.
контрольная работа [163,4 K], добавлен 18.04.2010Особенности аналитической и эмпирической моделей надежности программных средств. Проектирование алгоритма тестирования и разработка программы для определения надежности ПО моделями Шумана, Миллса, Липова, с использованием языка C# и VisualStudio 2013.
курсовая работа [811,5 K], добавлен 29.06.2014Контроль качества производимой продукции. Надежность информационной системы. Потеря данных по "техническим причинам". Понятие двоичного бинарного дерева. Понятие структурно-логических схем надежности. Математическое ожидание случайной наработки.
курсовая работа [88,9 K], добавлен 27.01.2011Архитектура информационной системы автоматической пожарной сигнализации, разработка обобщенной структурной схемы, алгоритмов моделирования области, использующей адресно-аналоговую схему соединения шлейфов. Показатели надежности и пути ее повышения.
курсовая работа [627,9 K], добавлен 19.05.2015Структурная схема надежности технической системы. Вероятность безотказной работы системы, ее график. Метод разложения относительно особого элемента. Период нормальной эксплуатации и экспотенциальный закон. Процентная наработка системы и резервирование.
контрольная работа [500,6 K], добавлен 09.05.2009Ошибки, которые воздействуют на программное обеспечение и методы прогнозирования программных отказов. Анализ моделей надежности программного обеспечения и методика оценки ее надежности. Экспоненциальное распределение. Методика оценки безотказности.
курсовая работа [71,5 K], добавлен 15.12.2013Структурная схема надежности технической системы Построение диаграммы изменения вероятности безотказной работы системы от времени наработки в диапазоне снижения вероятности. Определение процентной наработки технической системы и ее увеличение.
контрольная работа [448,9 K], добавлен 27.04.2009Действия, которые выполняются при проектировании АИС. Кластерные технологии, их виды. Методы расчета надежности на разных этапах проектирования информационных систем. Расчет надежности с резервированием. Испытания программного обеспечения на надежность.
курсовая работа [913,7 K], добавлен 02.07.2013Анализ методов оценки надежности программных средств на всех этапах жизненного цикла, их классификация и типы, предъявляемые требования. Мультиверсионное программное обеспечение. Современные модели и алгоритмы анализа надежности программных средств.
дипломная работа [280,5 K], добавлен 03.11.2013