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

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