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

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