молодец!

тормоз, с этим надо будет что-то делать, посмотри из-за чего он у тебя возникает и по возможности оптимизируй код

прямоугольник: если вести его снизу вверх или справа налево, то он отрисовывается в сторону положительного height и width, глянь вобщем

может это мое личное мнение, но какое-то маленькое окошко, в котором генерируется код.. (то же самое эллипс)

лень было искать, мож. оно и есть: когда просмотр и кнопка закрыть не входит в область видимости, то что?

Я и сам рад бы, да только за два года нагородил там такие дебри (в отображении), что сунуцо туда боюсь )))

Прямоугольник я замутил в виде шапы(Shape), поэтому ему Left было сложно менять. А графич. методы не юзал - отключать надо будет все отображение, сумасойду )))

точно! два раза!

покажи как рисуется. У тебя вся форма через что рисуется?

Private Sub Form_Activate()
Call MDIForm1.INME_Click(CInt(Instrument))
MDIForm1.INME(CInt(Instrument)).Value = True
On Error Resume Next
With MDIForm1
.Panel(3).Enabled = True
.Panel(5).Enabled = True
.Panel(7).Enabled = True
.Panel(6).Enabled = True
.UpDown16.Enabled = True
.Menn(5).Enabled = True
.SuperPanel(1).Enabled = True
.UpDown17.Value = YSJ * 10
.UpDown18.Value = XSJ * 10
Timer1.Enabled = True
If Shape1.Visible = True Then
.Check5.Value = 1
Else
.Check5.Value = 0
End If
.Text1.Text = Me.Tag
Timer2.Enabled = True
.UpDown16.Value = kZoom
.UpDown19.Min = 1
.UpDown19.Max = PointCount
.UpDown19.Value = sta
.UpDown20.Min = sta
.UpDown20.Max = PointCount
.UpDown20.Value = en
.Check8.Value = (sta = 1 And en = PointCount)
.Check8.Enabled = True
End With
If Shape1.Width > Shape1.Height Then
Form12.UpDown1.Max = Shape1.Width
Else
Form12.UpDown1.Max = Shape1.Height
End If
MDIForm1.Picture11.BackColor = Picture1.BackColor
Zapolnat
RIFRIF
End Sub
Function GetGRANICA(POL As Integer)
Dim h As Long
Dim i As Integer
Select Case POL
Case 0:
h = Shape1.Height
For i = sta To en
If Points(i).Y < h Then
h = Points(i).Y
End If
Next i
Case 1:
h = Shape1.Width
For i = sta To en
If Points(i).X < h Then
h = Points(i).X
End If
Next i
Case 2:
h = 0
For i = sta To en
If Points(i).Y > h Then
h = Points(i).Y
End If
Next i
Case 3:
h = 0
For i = sta To en
If Points(i).X > h Then
h = Points(i).X
End If
Next i
End Select
Select Case POL
Case 0
          LinXCount = LinXCount + 1
          ReDim Preserve LinekaX(LinXCount) As Long
          ReDim Preserve LiXCol(LinXCount) As Long
          LinekaX(LinXCount) = h
          LiXCol(LinXCount) = 0
Case 1
          LinYCount = LinYCount + 1
          ReDim Preserve LinekaY(LinYCount) As Long
          ReDim Preserve LiYCol(LinYCount) As Long
          LinekaY(LinYCount) = h
          LiYCol(LinYCount) = 0
Case 2
          LinXCount = LinXCount + 1
          ReDim Preserve LinekaX(LinXCount) As Long
          ReDim Preserve LiXCol(LinXCount) As Long
          LinekaX(LinXCount) = h
          LiXCol(LinXCount) = 0
Case 3
          LinYCount = LinYCount + 1
          ReDim Preserve LinekaY(LinYCount) As Long
          ReDim Preserve LiYCol(LinYCount) As Long
          LinekaY(LinYCount) = h
          LiYCol(LinYCount) = 0
End Select
End Function
Function GETNachalo()
On Error Resume Next

Dim X As Integer, Y As Integer
X = Points(1).X
Y = Points(1).Y
          LinYCount = LinYCount + 1
          ReDim Preserve LinekaY(LinYCount) As Long
          ReDim Preserve LiYCol(LinYCount) As Long
          LinekaY(LinYCount) = X
          Randomize: LiYCol(LinYCount) = MDIForm1.Oneded.BackColor
          
          LinXCount = LinXCount + 1
          ReDim Preserve LinekaX(LinXCount) As Long
          ReDim Preserve LiXCol(LinXCount) As Long
          LinekaX(LinXCount) = Y
          Randomize: LiXCol(LinYCount) = MDIForm1.Oneded.BackColor
          
End Function
Function GETConec()
On Error Resume Next
Dim X As Integer, Y As Integer
X = Points(PointCount).X
Y = Points(PointCount).Y
          LinYCount = LinYCount + 1
          ReDim Preserve LinekaY(LinYCount) As Long
          ReDim Preserve LiYCol(LinYCount) As Long
          LinekaY(LinYCount) = X
          Randomize: LiYCol(LinYCount) = MDIForm1.Ended.BackColor
          
          LinXCount = LinXCount + 1
          ReDim Preserve LinekaX(LinXCount) As Long
          ReDim Preserve LiXCol(LinXCount) As Long
          LinekaX(LinXCount) = Y
          Randomize: LiXCol(LinYCount) = MDIForm1.Ended.BackColor
          
End Function
Function DisplayPointsBU()
Dim LAMA As Double
LAMA = Timer
On Error Resume Next
Dim X34 As Integer, Y34 As Integer
Dim X36 As Integer, Y36 As Integer
Dim cccx As Integer, cccy As Integer
cccx = 4
cccy = 2
Dim i As Integer
Picture1.DrawMode = 6
Picture1.DrawWidth = 1
Picture1.Cls
Dim Cool As Long
Cool = Picture4.BackColor
If MDIForm1.Check10.Value = 1 Then
For i = 2 To PointCount - 1
With Points(i)

If .X > Picture1.ScaleLeft And .Y > Picture1.ScaleTop And .X < Picture1.ScaleLeft + Picture1.ScaleWidth And .Y < Picture1.ScaleTop + Picture1.ScaleHeight Then
If i >= sta And i <= en And MDIForm1.Check8.Value = 1 Then Picture1.DrawMode = 13 Else Picture1.DrawMode = 6
If .Tag = "NoMovie" Then
Picture1.Line (.X - Rad * 3, .Y - Rad * 3)-(.X + Rad * 3, .Y + Rad * 3), Cool
Picture1.Line (.X + Rad * 3, .Y - Rad * 3)-(.X - Rad * 3, .Y + Rad * 3), Cool
End If
Select Case MDIForm1.Uzels
Case 0:
UzelPovorot = UzelPovorot + 3
If UzelPovorot >= 360 Then UzelPovorot = 0

X34 = .X + (Rad * cccx) * Cos(6.28 / 360 * UzelPovorot)
Y34 = .Y + (Rad * cccy) * Sin(6.28 / 360 * UzelPovorot)
X36 = .X + (Rad * cccx) * Cos(6.28 / 360 * (UzelPovorot + 90))
Y36 = .Y + (Rad * cccy) * Sin(6.28 / 360 * (UzelPovorot + 90))
Picture1.Line (X34, Y34)-(X36, Y36), Cool

X34 = .X + (Rad * cccx) * Cos(6.28 / 360 * (UzelPovorot + 90))
Y34 = .Y + (Rad * cccy) * Sin(6.28 / 360 * (UzelPovorot + 90))
X36 = .X + (Rad * cccx) * Cos(6.28 / 360 * (UzelPovorot + 180))
Y36 = .Y + (Rad * cccy) * Sin(6.28 / 360 * (UzelPovorot + 180))
Picture1.Line (X34, Y34)-(X36, Y36), Cool

X34 = .X + (Rad * cccx) * Cos(6.28 / 360 * (UzelPovorot + 180))
Y34 = .Y + (Rad * cccy) * Sin(6.28 / 360 * (UzelPovorot + 180))
X36 = .X + (Rad * cccx) * Cos(6.28 / 360 * (UzelPovorot + 270))
Y36 = .Y + (Rad * cccy) * Sin(6.28 / 360 * (UzelPovorot + 270))
Picture1.Line (X34, Y34)-(X36, Y36), Cool

X34 = .X + (Rad * cccx) * Cos(6.28 / 360 * (UzelPovorot + 270))
Y34 = .Y + (Rad * cccy) * Sin(6.28 / 360 * (UzelPovorot + 270))
X36 = .X + (Rad * cccx) * Cos(6.28 / 360 * UzelPovorot)
Y36 = .Y + (Rad * cccy) * Sin(6.28 / 360 * UzelPovorot)
Picture1.Line (X34, Y34)-(X36, Y36), Cool

Case 1:
Picture1.Circle (.X, .Y), Rad, Cool
Case 2:
Picture1.Line (.X - Rad, .Y - Rad)-(.X + Rad, .Y + Rad), Cool, B
End Select
'Picture1.Circle (.X, .Y), rad / 2, cool
End If
End With

Next i
End If
Picture1.DrawMode = 6
Picture1.DrawWidth = 1
For i = 1 To PointCount - 1
With Points(i)
If i >= sta And i <= en And MDIForm1.Check8.Value = 1 Then Picture1.DrawMode = 13 Else Picture1.DrawMode = 6
Picture1.Line (.X, .Y)-(Points(i + 1).X, Points(i + 1).Y), Cool
End With
Next i
If MDIForm1.Instrument = 5 Then
Picture1.FillStyle = 1
Picture1.DrawMode = 9
Picture1.DrawWidth = 1
Picture1.Circle (Povorot.X, Povorot.Y), 100 / kZoom, RGB(128, 128, 128)
Picture1.DrawMode = 6
End If
Picture1.DrawMode = 13
If MDIForm1.Check10.Value = 1 Then
With Points(PointCount)
Picture1.Circle (.X, .Y), Rad, MDIForm1.Ended.BackColor
'Picture1.Circle (.X, .Y), rad / 2, vbRed
Picture1.Line (.X - Rad / 2, .Y)-(.X + Rad / 2, .Y), MDIForm1.Ended.BackColor
Picture1.Line (.X, .Y - Rad / 2)-(.X, .Y + Rad / 2), MDIForm1.Ended.BackColor
If .Tag = "NoMovie" Then
Picture1.Line (.X - Rad * 3, .Y - Rad * 3)-(.X + Rad * 3, .Y + Rad * 3), Cool
Picture1.Line (.X + Rad * 3, .Y - Rad * 3)-(.X - Rad * 3, .Y + Rad * 3), Cool
End If
End With
With Points(1)
Picture1.Circle (.X, .Y), Rad, MDIForm1.Oneded.BackColor
Picture1.Line (.X - Rad / 2, .Y)-(.X + Rad / 2, .Y), MDIForm1.Oneded.BackColor
Picture1.Line (.X, .Y - Rad / 2)-(.X, .Y + Rad / 2), MDIForm1.Oneded.BackColor
If .Tag = "NoMovie" Then
Picture1.Line (.X - Rad * 3, .Y - Rad * 3)-(.X + Rad * 3, .Y + Rad * 3), Cool
Picture1.Line (.X + Rad * 3, .Y - Rad * 3)-(.X - Rad * 3, .Y + Rad * 3), Cool
End If
'Picture1.Circle (.X, .Y), rad / 2, vbBlue
End With
End If
If MDIForm1.Check14.Value = 1 Then
Dim tx As Integer
Dim ty As Integer
tx = (Points(1).X - Points(PointCount).X) / 2 + Points(PointCount).X
ty = (Points(1).Y - Points(PointCount).Y) / 2 + Points(PointCount).Y
Picture1.DrawStyle = vbDot
Picture1.Line (tx, ty)-(Points(1).X, Points(1).Y), MDIForm1.Oneded.BackColor
Picture1.Line (tx, ty)-(Points(PointCount).X, Points(PointCount).Y), MDIForm1.Ended.BackColor
Picture1.DrawStyle = vbSolid
End If
If MDIForm1.Check16.Value = 1 Then
For i = 1 To PointCount
With Points(i)
Picture1.CurrentX = .X
Picture1.CurrentY = .Y
End With
Picture1.Print i
Next i
End If
If LinXCount > 0 Or LinYCount > 0 Then
With Picture1
.DrawStyle = vbDashDot
For i = 1 To LinXCount
Picture1.Line (.ScaleLeft, LinekaX(i))-Step(.ScaleWidth, 0), LiXCol(i)
Next i
.DrawStyle = vbSolid
For i = 1 To LinYCount
.DrawStyle = vbDashDot
Picture1.Line (LinekaY(i), .ScaleTop)-Step(0, .ScaleHeight), LiYCol(i)
.DrawStyle = vbSolid
Next i
End With
End If
On Error Resume Next
With Form12
If .CODEFO > 0 Then
i = .Sli
If .CODEFO = 1 Then
Picture1.Line (Picture1.ScaleLeft + 300 / kZoom, LinekaX(i) - 100 / kZoom)-Step(Picture1.ScaleWidth - 600 / kZoom, 200 / kZoom), vbBlack, B
ElseIf .CODEFO = 2 Then
Picture1.Line (LinekaY(i) - 100 / kZoom, Picture1.ScaleTop + 300 / kZoom)-Step(200 / kZoom, Picture1.ScaleHeight - 600 / kZoom), vbBlack, B
End If
End If
End With
'Operats = Operats + 1
'If Timer - Zader > 1 Then
'MDIForm1.StatusBar1.Panels(5).Text = Operats & " обн/с"
'Operats = 0
'Zader = Timer
'End If
'If Abs(LAMA - Timer) > 1 And Ignorate3 = False Then
'Set Orm = Me
'Form13.Label3.Caption = "Уровень опасности 3!"
'Form13.Show
'Form13.Caption = Ignorate3
'MDIForm1.Enabled = False
'ElseIf Abs(LAMA - Timer) > 0.5 And Ignorate2 = False And Ignorate3 = False Then
'Set Orm = Me
'Form13.Show
'Form13.Label3.Caption = "Уровень опасности 2"
'MDIForm1.Enabled = False
'ElseIf Abs(LAMA - Timer) > 0.1 And Ignorate1 = False And Ignorate2 = False And Ignorate3 = False Then
'Set Orm = Me
'Form13.Show
'Form13.Label3.Caption = "Уровень опасности 1"
'MDIForm1.Enabled = False
'End If
DoEvents

End Function
Function Podognat()
Dim i As Integer
Dim maXX As Integer
Dim maYY As Integer
For i = 1 To PointCount
If Points(i).X > maXX Then
maXX = Points(i).X
End If
If Points(i).Y > maYY Then
maYY = Points(i).Y
End If
Next i
If Shape1.Width < maXX Then
Shape1.Width = maXX + 100
PoleX = Shape1.Width
End If
If Shape1.Height < maYY Then
Shape1.Height = maYY + 100
PoleY = Shape1.Height
End If
End Function
Function Ships(ByVal Length As Long)
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
For i = sta To en - 1 Step 2
c1 = Points(i)
C2 = Points(i + 1)
G.XA1 = c1.X
G.YA1 = c1.Y
G.XA2 = C2.X
G.YA2 = C2.Y
result = GradsNineteen(G, CInt(Length))
Points(i + 1).X = result.XA2
Points(i + 1).Y = result.YA2
Next i
End Function
Function Bordur(Vel As Integer)
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
Dim GAP() As PO
ReDim GAP(sta To en) As PO
Dim popa As Long
popa = en
For i = sta To en - 1 Step 2
c1 = Points(i)
C2 = Points(i + 1)
G.XA1 = c1.X
G.YA1 = c1.Y
G.XA2 = C2.X
G.YA2 = C2.Y
result = GradsNineteen(G, CInt(200))
GAP(i + 1).X = result.XA2
GAP(i + 1).Y = result.YA2
Next i
p% = PointCount
PointCount = PointCount + Abs(sta - en)
ReDim Preserve Points(1 To PointCount) As PO
i = 0
For i = sta To popa - 1
If Points(i + p).Tag <> "NoMovie" Then
Points(i + p).X = GAP(i).X
Points(i + p).Y = GAP(i).Y
End If
Next i
End Function
Function BOBOR()
Dim WICA As Integer
Dim s As String
s = InputBox(("Введите толщину:", , "100"
If s = "" Then Exit Function
If Val(s) > 2000 Then s = "2000": MsgBox (("Максимальная толщина - 2000 твип!"), vbCritical: Exit Function
WICA = Abs(Val(s))
On Error Resume Next
Dim i As Integer
Dim LO As LINETWIP
Dim c1 As PO
Dim C2 As PO
Dim C3 As PO
Dim Ser1 As PO
Dim loGo As Long
loGo = PointCount
PointCount = loGo * 2
ReDim Preserve Points(1 To PointCount) As PO
For i = 2 To loGo - 1
c1 = Points(i - 1)
C2 = Points(i)
C3 = Points(i + 1)
With LO
.XA1 = c1.X
.YA1 = c1.Y
.XA2 = C3.X
.YA2 = C3.Y
End With
Ser1.X = c1.X + (C3.X - c1.X) / 2
Ser1.Y = c1.Y + (C3.Y - c1.Y) / 2
LO = GradsNineteen(LO, Rassto(Ser1, C2) + WICA)
If Points(PointCount).Tag <> "NoMovie" Then
Points(PointCount - i).X = LO.XA2
Points(PointCount - i).Y = LO.YA2
End If
Next i
KillPoint (PointCount)
KillPoint (PointCount)
End Function
Private Function Rassto(Point1 As PO, Point2 As PO) As Integer
Rassto = Sqr((Point1.X - Point2.X) ^ 2 + (Point1.Y - Point2.Y) ^ 2)
End Function
Function Volna(ByVal Length As Long, Gradus As Integer)
If Gradus = 0 Then Gradus = 360
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
For i = sta To en - 1 Step 2
c1 = Points(i)
C2 = Points(i + 1)
G.XA1 = c1.X
G.YA1 = c1.Y
G.XA2 = C2.X
G.YA2 = C2.Y
result = GradsNineteen(G, CInt(Sin(6.28 / Gradus * i) * Length))
If Points(i + 1).Tag <> "NoMovie" Then
Points(i + 1).X = result.XA2
Points(i + 1).Y = result.YA2
End If
Next i
End Function
Function Curive(ByVal Length As Long, ByVal Gradus As Integer)
If Gradus = 0 Then Gradus = 360
Dim r() As PO
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
ReDim r(1 To PointCount) As PO
For i = sta To en
r(i) = Points(i)
Next i
Dim x1 As Integer
Dim x2 As Integer
For i = sta To en - 1 Step 1
c1 = Points(i)
C2 = Points(i + 1)
G.XA1 = c1.X
G.YA1 = c1.Y
G.XA2 = C2.X
G.YA2 = C2.Y
result = GradsNineteen(G, CInt(Sin(6.28 / Gradus * i) * Length))
r(i).X = result.XA2
r(i).Y = result.YA2
Next i
For i = sta To en
If Points(i).Tag <> "NoMovie" Then
Points(i) = r(i)
End If
Next i
ReDim r(0) As PO
End Function
Function Svig()
Dim i As Integer
Dim x1 As Integer, x2 As Integer
Dim y1 As Integer, y2 As Integer
Dim Dx As Integer
Dim Dy As Integer
For i = sta To en - 1
x1 = Points(i).X
y1 = Points(i).Y
x2 = Points(i + 1).X
y2 = Points(i + 1).Y
Dx = x1 - x2
Dy = y1 - y2
Dx = Dx / 2
Dy = Dy / 2
If Points(i + 1).Tag <> "NoMovie" Then
Points(i + 1).X = x1 - Dx
Points(i + 1).Y = y1 - Dy
End If
Next i
End Function
Function Smoothing(ByVal Sila As Integer)
On Error Resume Next
If Gradus = 0 Then Gradus = 360
Dim r() As PO
Dim i As Integer
Dim mC1 As PO
Dim c As PO
Dim c1 As PO
Dim sC As PO
Dim sdvi As PO
Dim G As LINETWIP
Dim result As LINETWIP
ReDim r(sta To en) As PO
If MDIForm1.Check8.Value = 0 Then sta = 1: en = PointCount
For i = sta - 1 To en
r(i) = Points(i)
Next i
Dim x1 As Integer
Dim x2 As Integer
For i = sta + 1 To en - 1 Step 1
mC1 = r(i - 1)
c = r(i)
c1 = r(i + 1)

sC.X = (c1.X - mC1.X) / 2 + mC1.X
sC.Y = (c1.Y - mC1.Y) / 2 + mC1.Y

sdvi.X = (c.X - sC.X) / Sila + sC.X
sdvi.Y = (c.Y - sC.Y) / Sila + sC.Y
If Points(i).Tag <> "NoMovie" Then
Points(i) = sdvi
End If
Next i
If sta = 1 And en = PointCount Then
'Последняя точка
mC1 = r(en - 1)
c = r(en)
c1 = r(1)
sC.X = (c1.X - mC1.X) / 2 + mC1.X
sC.Y = (c1.Y - mC1.Y) / 2 + mC1.Y
sdvi.X = (c.X - sC.X) / Sila + sC.X
sdvi.Y = (c.Y - sC.Y) / Sila + sC.Y
If Points(PointCount).Tag <> "NoMovie" Then
Points(PointCount) = sdvi
End If
'первая точка
mC1 = r(en)
c = r(1)
c1 = r(2)
sC.X = (c1.X - mC1.X) / 2 + mC1.X
sC.Y = (c1.Y - mC1.Y) / 2 + mC1.Y
sdvi.X = (c.X - sC.X) / Sila + sC.X
sdvi.Y = (c.Y - sC.Y) / Sila + sC.Y
If Points(1).Tag <> "NoMovie" Then
Points(1) = sdvi
End If
End If
ReDim r(0) As PO
End Function
Function Veter(ByVal LengthX As Long, ByVal LengthY As Integer)
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
For i = sta To en - 1 Step 2
If Points(i).Tag <> "NoMovie" Then
Points(i + 1).X = Points(i).X + LengthX
Points(i + 1).Y = Points(i).Y + LenghtY
End If
Next i
End Function
Function Bang(ByVal LengthX As Long, ByVal LengthY As Integer)
On Error Resume Next
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
For i = sta To en - 1 Step 1
If Points(i).Tag <> "NoMovie" Then
Points(i).X = Points(i).X + Abs(Points(i).X - Points(i + 1).X)
Points(i).Y = Points(i).Y + Abs(Points(i).Y - Points(i + 1).Y) + (Points(i).X / 700)
End If
Next i
End Function
Function Deformate(ByVal MaxLengthX As Long, ByVal MaxLengthY As Integer)
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
Randomize
For i = sta To en Step 1
If Points(i).Tag <> "NoMovie" Then
Points(i).X = Points(i).X + Int(Rnd * MaxLengthX * 2) - MaxLengthX
Points(i).Y = Points(i).Y + Int(Rnd * MaxLengthY * 2) - MaxLengthY
End If
Next i
End Function
Function Rastush(ByVal Length As Long)
Dim i As Integer
Dim c1 As PO
Dim C2 As PO
Dim G As LINETWIP
Dim result As LINETWIP
For i = sta To en - 1
c1 = Points(i)
C2 = Points(i + 1)
G.XA1 = c1.X
G.YA1 = c1.Y
G.XA2 = C2.X
G.YA2 = C2.Y
result = GradsNineteen(G, CInt(Length))
If Points(i + 1).Tag <> "NoMovie" Then
Points(i + 1).X = result.XA2
Points(i + 1).Y = result.YA2
End If
Next i
End Function

Private Sub Form_Deactivate()
Timer1.Enabled = False
Timer2.Enabled = False
End Sub

Private Sub Form_LinkOpen(Cancel As Integer)
On Error Resume Next
PoleX = X
PoleY = Y
End Sub

Private Sub Form_Load()

On Error Resume Next
kZoom = 10
XSJ = 1
YSJ = 1
ReDim LinekaX(0) As Long
ReDim LinekaY(0) As Long
ReDim LiXCol(0) As Long
ReDim LiYCol(0) As Long
Rad = Screen.TwipsPerPixelX * 2
Picture2.Picture = Picture1.Picture
WA = Picture1.ScaleWidth
HA = Picture1.ScaleHeight
PoleX = Shape1.Width
PoleY = Shape1.Height
AutorStr = "Homacosoft"
NameStr = "PolYgoN"
CommentStr = "<no comments>"
ReDim iPods(1 To 10, 1) As PO
End Sub
Function NAZAD()
On Error Resume Next
If PointCount = 1 Then Exit Function
Dim i As Integer
Dim z() As PO
ReDim z(1 To PointCount - 1) As PO
For i = 1 To PointCount - 1
z(i) = Points(i)
Next i
PointCount = PointCount - 1
ReDim Points(1 To PointCount) As PO
For i = 1 To PointCount
If Points(i).Tag <> "NoMovie" Then
Points(i) = z(i)
End If
Next i
ReDim z(0) As PO
End Function
Function RIFRIF()
Call Timer1_Timer
'DisplayPointsBU
End Function

Private Sub Form_Resize()
'Horisontal.Left = BOT.Width
'Vertical.Top = BOT.Height
'Horisontal.Top = 0
'Vertical.Left = 0

'Horisontal.Width = Me.ScaleWidth - Horisontal.Left
'Vertical.Height = Me.ScaleHeight - Vertical.Top
On Error Resume Next
Picture1.Left = Screen.TwipsPerPixelX * 3
Picture1.Top = Screen.TwipsPerPixelY * 3
WA = Picture1.Width
HA = Picture1.Height
If HScroll1.Visible = True Or VScroll1.Visible = True Then
Picture1.Width = Me.ScaleWidth - Picture1.Left * 2 - HScroll1.Height
Picture1.Height = Me.ScaleHeight - Picture1.Top * 2 - VScroll1.Width
Else
Picture1.Width = Me.ScaleWidth - Picture1.Left * 2
Picture1.Height = Me.ScaleHeight - Picture1.Top * 2
End If
HScroll1.Max = (Abs(Shape1.Width - Picture1.ScaleWidth) * kZoom + 100) / 20
VScroll1.Max = (Abs(Shape1.Height - Picture1.ScaleHeight) * kZoom + 100) / 20
HScroll1.Left = 0
HScroll1.Top = Picture1.Top + Picture1.Height
HScroll1.Width = Me.ScaleWidth - VScroll1.Width
HScroll1.Visible = (Shape1.Width > Picture1.ScaleWidth)
VScroll1.Visible = (Shape1.Height > Picture1.ScaleHeight)
VScroll1.Top = 0
VScroll1.Left = Picture1.Left + Picture1.Width
VScroll1.Height = Me.ScaleHeight - HScroll1.Height
If zopa <> Me.WindowState Then
WAD = 0
HAD = 0
zopa = Me.WindowState
End If
Shape1.Left = 0
Shape1.Top = 0
Shape1.Width = PoleX
Shape1.Height = PoleY
Horisontal.ScaleLeft = Picture1.ScaleLeft
Horisontal.ScaleWidth = Picture1.ScaleWidth
RIFRIF
If Me.WindowState = 2 Then
MDIForm1.Command15.Tag = "Big"
Else
MDIForm1.Command15.Tag = "Small"
End If
If Me.WindowState = 1 Then
MDIForm1.Command16.Tag = "Big"
Else
MDIForm1.Command16.Tag = "Min"
End If
Call MDIForm1.Command15_MouseUp(vbLeftButton, 0, 0, 0)
Call MDIForm1.Command16_MouseUp(vbLeftButton, 0, 0, 0)
End Sub


Private Sub HScroll1_Change()
WAD = (HScroll1.Value / 100) * 20 * 10 * 10
'RIFRIF
DisplayPointsBU
Call Timer1_Timer
End Sub

Private Sub HScroll1_Scroll()
WAD = (HScroll1.Value / 100) * 20 * 10 * 10
Call Timer1_Timer
Bistrov
End Sub

Sub mnuDownDetalliztion_Click()
Dim Opa() As PO
Dim i As Integer
ReDim Opa(1 To PointCount / 2)
For i = 1 To PointCount / 2 - PointCount Mod 2
Opa(i) = Points(i * 2)
Next i
PointCount = PointCount / 2
ReDim Preserve Points(1 To PointCount) As PO
For i = 1 To PointCount
Points(i) = Opa(i)
Next i
End Sub

Sub mnuPointAdd_Click()
AddPoint wqIn, wqX, wqY
End Sub
Function AddPoint(Index As Integer, X As Integer, Y As Integer)
Dim i As Integer
PointCount = PointCount + 1
ReDim Preserve Points(1 To PointCount) As PO
For i = PointCount - 1 To Index Step -1
Points(i + 1) = Points(i)
Next i
Points(Index).X = X
Points(Index).Y = Y
Points(Index).Tag = ""
End Function
Function KillPoint(Index As Integer)
Dim i As Integer
For i = Index To PointCount - 1
Points(i) = Points(i + 1)
Next i
PointCount = PointCount - 1
ReDim Preserve Points(1 To PointCount) As PO
End Function

Sub mnuPointKill_Click()
KillPoint wqIn
End Sub

 Sub mnuUpDetalization_Click()
Dim i As Integer
Dim Opa() As PO
Dim l As Long
l = PointCount
ReDim Opa(1 To PointCount) As PO
For i = 1 To PointCount
Opa(i) = Points(i)
Next i
Dim c As Integer
For i = 2 To l
AddPoint i + c, (Opa(i - 1).X - Opa(i).X) / -2 + Opa(i - 1).X, (Opa(i - 1).Y - Opa(i).Y) / -2 + Opa(i - 1).Y
c = c + 1
Next i
ReDim Opa(0) As PO
End Sub

Private Sub Picture1_DblClick()
isDraw = False
If NonStop > 0 Then
Select Case NonStop
Case 1:
DrawEllips Shape2.Left, Shape2.Top, Shape2.Width, Shape2.Height, MDIForm1.UpDown12.Value
Case 2:
DrawRestange Shape2.Left, Shape2.Top, Shape2.Width, Shape2.Height
'Case 3:
'drawrondrestange Shape2.Left, Shape2.Top, Shape2.Width, Shape2.Height, MDIForm1.UpDown17.Value, MDIForm1.UpDown18.Value
End Select
Shape1.Width = Shape2.Width + Shape2.Left + 100
Shape1.Height = Shape2.Height + Shape2.Top + 100
PoleX = Shape1.Width
PoleY = Shape1.Height
NonStop = 0
Shape2.Visible = False
End If
End Sub
Function DrawEllips(X As Integer, Y As Integer, x1 As Integer, y1 As Integer, Optional Segmentation As Integer)
Dim cx As Integer
Dim cy As Integer
Dim bX As Integer
Dim bY As Integer
Dim i As Integer
Dim siga As Integer
siga = Segmentation
If siga = 0 Then siga = 360
cx = X + x1 / 2
cy = Y + y1 / 2
For i = 1 To siga Step 1
bX = x1 / 2 * Cos(6.28 / siga * i) + cx
bY = y1 / 2 * Sin(6.28 / siga * i) + cy
PointCount = PointCount + 1
ReDim Preserve Points(1 To PointCount) As PO
Points(PointCount).X = bX
Points(PointCount).Y = bY
'(UndoCount, PointCount): If UndoCount < 10 Then UndoCount = UndoCount + 1 Else: '
'
Next i
If MDIForm1.Check8.Value = 0 And (sta <> 1 Or en <> PointCount) Then sta = 1: en = PointCount
End Function
Function DrawRestange(X As Integer, Y As Integer, x1 As Integer, y1 As Integer)
'Левый верхний
PointCount = PointCount + 1
ReDim Preserve Points(1 To PointCount) As PO
Points(PointCount).X = X
Points(PointCount).Y = Y
'(UndoCount, PointCount): If UndoCount < 10 Then UndoCount = UndoCount + 1 Else: '
'
'Правый верхний
PointCount = PointCount + 1
ReDim Preserve Points(1 To PointCount) As PO
Points(PointCount).X = X + x1
Points(PointCount).Y = Y
'(UndoCount, PointCount): If UndoCount < 10 Then UndoCount = UndoCount + 1 Else: '
'
'Правый нижний
PointCount = PointCount + 1
ReDim Preserve Points(1 To PointCount) As PO
Points(PointCount).X = X + x1
Points(PointCount).Y = Y + y1
'(UndoCount, PointCount): If UndoCount < 10 Then UndoCount = UndoCount + 1 Else: '
'
'Левый нижний
PointCount = PointCount + 1
ReDim Preserve Points(1 To PointCount) As PO
Points(PointCount).X = X
Points(PointCount).Y = Y + y1
'(UndoCount, PointCount): If UndoCount < 10 Then UndoCount = UndoCount + 1 Else: '
'
End Function
Function Zapolnat()
On Error Resume Next
Dim i As Integer
Dim roga As ListItem
With Form12.List1
.ListItems.Clear
For i = 1 To LinXCount
Set roga = .ListItems.Add(, "Horis" & i, Str(i), "Horisontal", "Horisontal"
roga.SubItems(1) = Str(LinekaX(i))
roga.SubItems(2) = Str("&H" & Hex(LiXCol(i)))
Next i
End With
With Form12.List2
.ListItems.Clear
For i = 1 To LinYCount
Set roga = .ListItems.Add(, "Horis" & i, Str(i), "Vertical", "Vertical"
roga.SubItems(1) = Str(LinekaY(i))
roga.SubItems(2) = "&H" & Hex(LiYCol(i))
Next i
End With

End Function