'09/02/2009
'============================================================
Private Sub Form_Load()
On Error GoTo ELine
MSComm1.CommPort = 2
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputLen = 0
MSComm1.PortOpen = True
Timer_Comm_output.Enabled = False
'Me.Picture = LoadPicture("")
Exit Sub
ELine:
Lbl_Status = Err.Description
End Sub

'Нажатие клавиши на форме
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then Call SendKeys(vbTab)
If KeyAscii = 45 Then Call SendKeys("+" & vbTab)
If KeyAscii = 42 Then Cmd_Test_Click
If KeyAscii = 47 Then Cmd_exit_Click
If KeyAscii = 43 Then Cmd_save_detal_Click (0)
If KeyAscii = 46 Then Cmd_save_detal_Click (1)
If ((KeyAscii < 48) Or (KeyAscii > 57)) And KeyAscii <> 8 Then
  KeyAscii = False 'если не цифра и не <-- то ничего не нажималось
End If
End Sub

'черная рамка
Private Sub Chk_PRotate_GotFocus(Index As Integer)
Chk_PRotate(Index).BackColor = &H0&
End Sub

Private Sub Chk_PRotate_LostFocus(Index As Integer)
Chk_PRotate(Index).BackColor = &HFFFFC0
End Sub

Private Sub Chk_Rotate_GotFocus(Index As Integer)
Chk_Rotate(Index).BackColor = &H0&
End Sub

Private Sub Chk_Rotate_LostFocus(Index As Integer)
Chk_Rotate(Index).BackColor = &HFFFFC0
End Sub

Private Sub Chk_Rotate_Keydown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 97 Then Chk_Rotate(Index) = 1
If KeyCode = 96 Then Chk_Rotate(Index) = 0
End Sub

Private Sub Chk_PRotate_Keydown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 97 Then Chk_PRotate(Index) = 1
If KeyCode = 96 Then Chk_PRotate(Index) = 0
End Sub

'Нажатие на кнопку "Автомат" ==============================
Private Sub Cmd_Automat_Click()
'если положение упора = 0 то в блок посылаем в блок положение упора
If (Val(Txt_Upor(Num_step)) <> 0) Then
  F1 = Val(Txt_Upor(Num_step)) \ 35
  F2 = Val(Txt_Upor(Num_step)) Mod 35
  Lbl_upor_status.Caption = "Упор  " & (Txt_Upor(Num_step)) & "  мм."
  Do While (MSComm1.InBufferCount > 0)
    DoEvents
   Loop
  MSComm1.Output = "$E" & Chr$(F1) & Chr$(F2)
  'Через 0,2 сек. в блок уйдет следующее значение угла
End If
  order_out_rs232 = "D" 'далее посылаем значение угла
  Timer_Comm_output.Enabled = True
End Sub

Private Sub Cmd_save_detal_Click(Index As Integer)
Dim k_h As Single
Dim k_w As Single
Dim F, A As Integer
Dim Result1 As String * 280
Dim i As Integer
DoEvents
'Присваиваем первоначальные значения промежуточным переменным
Temp_minY = Pnt(0).Y
Temp_minX = Pnt(0).X
Temp_maxY = Pnt(0).Y
Temp_maxX = Pnt(0).X

'Нахождение min и max значений для масштабирования (центровки)
For i = 0 To 10
  If Pnt(i).Y < Temp_minY Then Temp_minY = Pnt(i).Y
  If Pnt(i).X < Temp_minX Then Temp_minX = Pnt(i).X
  If Pnt(i).Y > Temp_maxY Then Temp_maxY = Pnt(i).Y
  If Pnt(i).X > Temp_maxX Then Temp_maxX = Pnt(i).X
Next i
k_h = (2000 + Temp_maxY - Temp_minY) / PicDet.ScaleHeight
k_w = (2000 + Temp_maxX - Temp_minX) / PicDet.ScaleWidth
If (k_h < k_w) Then k_h = k_w
PicDet.Picture = LoadPicture("")
For i = 0 To 16
  Pnt_tmp(i).X = Pnt(i).X / k_h + (Temp_minX / k_h + (PicDet.ScaleWidth - Temp_maxX / k_h)) / 2 - Temp_minX / k_h
  Pnt_tmp(i).Y = Pnt(i).Y / k_h + (Temp_minY / k_h + (PicDet.ScaleHeight - Temp_maxY / k_h)) / 2 - Temp_minY / k_h
Next i

For j = 1 To 16
  PicDet.Line ((Pnt_tmp(Ord(j - 1)).X), (Pnt_tmp(Ord(j - 1)).Y))-((Pnt_tmp(Ord(j)).X), (Pnt_tmp(Ord(j)).Y))
Next j
If (Index = 0) Then
  SavePicture PicDet.Image, LTrim(Str$(Num_detal) & ".gif")
End If
If (Index = 1) Then
  SavePicture PicDet.Image, LTrim(Str$(Kol_detal) & ".gif")
End If
'SavePicture PicDet.Image, LTrim(Str$(Num_detal) & ".gif")

F = FreeFile
Open "base.txt" For Random As #F Len = 280
Result1 = ""
Mid(Result1, 275, 4) = Txt_Sum.Text
Mid(Result1, 271, 4) = TxtKodDetali.Text
For i = 1 To 15
  Mid(Result1, (i - 1) * 3 + 1, 3) = Val(LTrim(RTrim(Txt_Ugol(i).Text)))
Next i
For i = 1 To 15
  Mid(Result1, (i - 1) * 3 + 46, 3) = Val(LTrim(RTrim(Txt_Ugol_t(i).Text)))
Next i
For i = 1 To 15
  Mid(Result1, (i - 1) * 4 + 91, 4) = Val(LTrim(RTrim(Txt_Dlina(i).Text)))
Next i
For i = 1 To 15
  Mid(Result1, (i - 1) * 4 + 151, 4) = Val(LTrim(RTrim(Txt_Upor(i).Text)))
Next i
For i = 1 To 15
  Mid(Result1, (i - 1) * 2 + 211, 2) = Val(LTrim(RTrim(Txt_T(i).Text)))
Next i
For i = 1 To 15
  Mid(Result1, i + 240, 1) = Chk_Rotate(i).Value
Next i
For i = 1 To 15
  Mid(Result1, i + 255, 1) = Chk_PRotate(i).Value
Next i

If (Index = 0) Then
  Put #F, Num_detal + 1, Result1
  'A = MsgBox("Деталь " & TxtKodDetali.Text & " записана в базу данных.", 64, "Листогиб ЛГМ АЗКПО")
  Lbl_title = "Деталь " & TxtKodDetali.Text & " записана в базу данных."
  Timer1.Enabled = True
End If
If (Index = 1) Then
  Put #F, Kol_detal, Result1
  'A = MsgBox("Деталь №" & TxtKodDetali.Text & " добавлена в конец базы данных", 64, "Листогиб ЛГМ АЗКПО")
  Lbl_title = "Деталь " & TxtKodDetali.Text & " добавлена в конец базы данных"
  Timer1.Enabled = True
End If
Close F
End Sub

'Нажатие на кнопку "Стоп" ==============================
Private Sub Cmd_Stop_Click()
MSComm1.Output = "$A02"
End Sub

'Option Explicit
Private Sub Form_Resize()
'Вычисление координат для расположения заготовки
On Error GoTo ELine
DoEvents
flag_povorot = False

'Line1.Visible = True
Call Read_File(Num_detal, 1)
If (Val(Txt_Sum.Text) > 400) Then
  Line1.X1 = ScaleWidth / 4 + ScaleWidth / 20
  Line1.Y1 = ScaleHeight / 2
  Line1.X2 = ScaleWidth - ScaleWidth / 20
  Line1.Y2 = ScaleHeight / 2
  Res = (Line1.X2 - Line1.X1) / Txt_Sum.Text
Else
  Res = 12
  Line1.X1 = ScaleWidth / 3
  Line1.Y1 = ScaleHeight / 2
  Line1.X2 = Line1.X1 + Val(Txt_Sum.Text) * Res
  Line1.Y2 = ScaleHeight / 2
End If
Txt_opravka.Text = Num_opravki
For i = 1 To 16
  Txt_Dlina(i).Text = ""
Next i
'Нулевая точка отрезков
Pnt(0).X = Line1.X1
Pnt(0).Y = Line1.Y1
Call Read_File(Num_detal, 0)

PicDet.Picture = LoadPicture(LTrim(Str$(Num_detal) & ".gif"))
'Подсветка первого шага
Num_step = 1
Txt_Dlina(Num_step).BackColor = &HFF00&
Txt_Ugol(Num_step).BackColor = &HFF00&
Txt_Ugol_t(Num_step).BackColor = &HFF00&
Txt_Upor(Num_step).BackColor = &HFF00&
Txt_T(Num_step).BackColor = &HFF00&
Txt_opravka.SelStart = 0
Txt_opravka.SelLength = Len(Txt_opravka.Text)
'Посылаем в блок значение угла и положение упора
Call Cmd_Automat_Click
'Расставляем точки по порядку
For i = 1 To 16
  If (Val(Txt_Dlina(i).Text) = 0) Then
    tmp_Ord(i) = Val(Txt_Sum.Text)
  Else
    tmp_Ord(i) = Val(Txt_Dlina(i).Text)
  End If
Next i

For i = 16 To 1 Step -1
  Temp = 0
  For j = 1 To 16
    If (tmp_Ord(j) > Temp) Then
      Temp = tmp_Ord(j)
      Ord(i) = j
    End If
  Next j
  tmp_Ord(Ord(i)) = 0

Next i
'For i = 1 To 15
'  Txt_Dlina_Change (i)
'Next i
Shape_blink.Left = Pnt(1).X - 100
Shape_blink.Top = Pnt(1).Y - 100
Call paint_prizim_balka
Timer_Blink = True 'не мигать
Lbl_Status = "Деталь №" & TxtKodDetali.Text
Lbl_title = "Режим автоматической гибки детали №" & TxtKodDetali.Text
Exit Sub
ELine:
Lbl_Status = Err.Description

End Sub

'Поворот заготовки в гориз. плоскости на 180 град.(задняя сторона становится передней)
Private Sub Cmd_Rotate_Click()
'Присваиваем первоначальные значения промежуточным переменным
Temp_minX = Pnt(0).X
Temp_maxX = Pnt(0).X
'Нахождение min и max значений для оси симметрии поворота
For i = 0 To 16
  If Pnt(i).X < Temp_minX Then Temp_minX = Pnt(i).X
  If Pnt(i).X > Temp_maxX Then Temp_maxX = Pnt(i).X
Next i
TempX = Temp_minX + (Temp_maxX - Temp_minX) / 2
'Поворачиваем заготовку относительно оси симметрии
For i = 0 To 16
  Pnt(i).X = TempX - (Pnt(i).X - TempX)
Next i
'Задержка
Zentrovka
'нужно поменять местами оставшиеся хвосты гиба
Timer2.Enabled = False
Timer2.Enabled = True
End Sub

'Переворот заготовки (нижняя сторона становится верхней)
Private Sub Cmd_PRotate_Click()
'Присваиваем первоначальные значения промежуточным переменным
Temp_minY = Pnt(0).Y
Temp_maxY = Pnt(0).Y
'Нахождение min и max значений для оси симметрии
For i = 0 To 16
  If Pnt(i).Y < Temp_minY Then Temp_minY = Pnt(i).Y
  If Pnt(i).Y > Temp_maxY Then Temp_maxY = Pnt(i).Y
Next i
TempY = Temp_minY + (Temp_maxY - Temp_minY) / 2
'Переворачиваем заготовку относительно оси симметрии
For i = 0 To 16
  Pnt(i).Y = TempY - (Pnt(i).Y - TempY)
Next i
'Задержка
Zentrovka
Timer2.Enabled = False
Timer2.Enabled = True
End Sub

Private Sub Zentrovka()
'Присваиваем первоначальные значения промежуточным переменным
DoEvents
Temp_minY = Pnt(0).Y
Temp_minX = Pnt(0).X
Temp_maxY = Pnt(0).Y
Temp_maxX = Pnt(0).X
'Нахождение min и max значений для масштабирования (центровки)
For i = 0 To 16
  DoEvents
  If Pnt(i).Y < Temp_minY Then Temp_minY = Pnt(i).Y
  If Pnt(i).X < Temp_minX Then Temp_minX = Pnt(i).X
  If Pnt(i).Y > Temp_maxY Then Temp_maxY = Pnt(i).Y
  If Pnt(i).X > Temp_maxX Then Temp_maxX = Pnt(i).X
Next i
For i = 0 To 16
  DoEvents
  Pnt(i).X = Pnt(i).X + ScaleWidth / 10 + (Temp_minX + (ScaleWidth - Temp_maxX)) / 2 - Temp_minX
  Pnt(i).Y = Pnt(i).Y + (Temp_minY + (ScaleHeight - Temp_maxY)) / 2 - Temp_minY
Next i
End Sub

'====================================================================
Private Sub Cmd_Test_Click()
Dim alpha As Integer
Dim F1, F2 As Integer
DoEvents
Lbl_Status.Caption = "Гибка"
If ((Val(Txt_Ugol(Num_step)) <> 0) And (Num_step <= 15)) Then 'Если шаг не последний
  'Убираем подсветку предыдущего шага в таблице
  Txt_Dlina(Num_step).BackColor = &HFFFFC0
  Txt_Ugol(Num_step).BackColor = &HFFFFC0
  Txt_Ugol_t(Num_step).BackColor = &HFFFFC0
  Txt_Upor(Num_step).BackColor = &HFFFFC0
  Txt_T(Num_step).BackColor = &HFFFFC0
  
  '->Поварачиваем все точки от текущей и дальше на текущий угол гиба
  'если деталь поворачивалась
  If flag_povorot Then 'поворачиваем нулевую точку, если до этого поварачивали заготовку
    Call Rotate(Pnt(Num_step).X, Pnt(Num_step).Y, Pnt(0).X, Pnt(0).Y, Val(Txt_Ugol(Num_step)))
  End If
  
  For j = 1 To 16
    DoEvents
    If flag_povorot Then
      'Если очередная точка перегиба стоит ближе, то поворачивать
      If ((Val(Txt_Dlina(j)) < Val(Txt_Dlina(Num_step))) And (Val(Txt_Dlina(j).Text) <> 0)) Then
        Call Rotate(Pnt(Num_step).X, Pnt(Num_step).Y, Pnt(j).X, Pnt(j).Y, Val(Txt_Ugol(Num_step)))
      End If
    Else
      'Если очередная точка отстоит дальше, то поворачивать
      If ((Val(Txt_Dlina(j).Text) > Val(Txt_Dlina(Num_step).Text)) Or (Val(Txt_Dlina(j).Text) = 0)) Then
        Call Rotate(Pnt(Num_step).X, Pnt(Num_step).Y, Pnt(j).X, Pnt(j).Y, Val(Txt_Ugol(Num_step)))
      End If
    End If
  Next j
'<-

  'Рисуем ломаную по новым точкам
  For j = 1 To 16
    DoEvents
    Ln_Grand(j).X1 = Pnt(Ord(j - 1)).X
    Ln_Grand(j).Y1 = Pnt(Ord(j - 1)).Y
    Ln_Grand(j).X2 = Pnt(Ord(j)).X
    Ln_Grand(j).Y2 = Pnt(Ord(j)).Y
    Lbl_Metka(j).Left = Pnt(j).X
    Lbl_Metka(j).Top = Pnt(j).Y
  Next j

'Call paint_prizim_balka

  Timer2.Enabled = False
  Timer2.Enabled = True

  Num_step = Num_step + 1
  If Num_step = 16 Then
'    Num_step = 15
  End If

 'Поворачиваем всю заготовку, чтобы очередная полка гиба стала горизонтальной
 'нужно будет вычислять угол наклона очередной полки гиба к горизонтали и доворачивать
  For j = 1 To 16
    DoEvents
    If (Ord(j) = Num_step) Then
      If (flag_povorot) Then
        TempY = Pnt((Num_step)).Y - Pnt(Ord(j + 1)).Y
        TempX = Pnt((Num_step)).X - Pnt(Ord(j + 1)).X
      Else
        TempY = Pnt(Ord(j + 1)).Y - Pnt((Num_step)).Y
        TempX = Pnt(Ord(j + 1)).X - Pnt((Num_step)).X
      End If
    End If
  Next j

  'Вычисляем угол, на который поворачиваемая точка находится относительно центра
  alpha = Atn((TempY / (TempX + 0.00000001))) * 180 / 3.14159265358979
  If ((Val(Txt_Dlina(Num_step)) <> 0) And (Num_step <= 15)) Then
    If (alpha > 0) Then
      alpha = alpha - 180
    End If
    For j = 0 To 16
      DoEvents
      Call Rotate(Pnt(Num_step).X, Pnt(Num_step).Y, Pnt(j).X, Pnt(j).Y, alpha)
    Next j
  Else
    Shape_blink.Visible = False
    Timer_Blink.Enabled = False 'не мигать
    Lbl_Status.Caption = "Деталь №" & TxtKodDetali.Text & " готова!"
    cmd_Test.Caption = "Следующая деталь ( * )"
    Do While (MSComm1.InBufferCount > 0)
      DoEvents
    Loop
    MSComm1.Output = "$A04" 'Холостой цикл
  End If
  'Задержка
  'Подсветка очередного шага
  Txt_Dlina(Num_step).BackColor = &HFF00&
  Txt_Ugol(Num_step).BackColor = &HFF00&
  Txt_Ugol_t(Num_step).BackColor = &HFF00&
  Txt_Upor(Num_step).BackColor = &HFF00&
  Txt_T(Num_step).BackColor = &HFF00&
  'Если стоит значок "Поворот" поворачиваем заготовку
  If Chk_Rotate(Num_step).Value Then
    flag_povorot = Not flag_povorot
    Cmd_Rotate_Click
  Lbl_Status.Caption = "Поверните заготовку!"
  End If
  'Переворот заготовки
  If Chk_PRotate(Num_step).Value Then
    Cmd_PRotate_Click
    Lbl_Status.Caption = "Переверните заготовку!"
  End If
  If (Chk_PRotate(Num_step).Value And Chk_Rotate(Num_step).Value) Then
    Lbl_Status.Caption = "Поверните и переверните лист!"
  End If
  Call Zentrovka
 'если положение упора <> 0 то в блок посылаем в блок положение упора
  If (Val(Txt_Ugol(Num_step)) <> 0) Then
    F1 = Val(Txt_Upor(Num_step)) \ 35
    F2 = Val(Txt_Upor(Num_step)) Mod 35
    Lbl_upor_status.Caption = "Упор  " & (Txt_Upor(Num_step)) & "  мм."
    Do While (MSComm1.InBufferCount > 0)
      DoEvents
    Loop
    MSComm1.Output = "$E" & Chr$(F1) & Chr$(F2)
  End If
  'Через 0,2 сек. в блок уйдет следующее значение угла
  order_out_rs232 = "D" 'далее посылаем значение угла
  Timer_Comm_output.Enabled = True
Else 'если шаг последний
  'Убираем подсветку предыдущего шага в таблице
  Txt_Dlina(Num_step).BackColor = &HFFFFC0
  Txt_Ugol(Num_step).BackColor = &HFFFFC0
  Txt_Ugol_t(Num_step).BackColor = &HFFFFC0
  Txt_Upor(Num_step).BackColor = &HFFFFC0
  Txt_T(Num_step).BackColor = &HFFFFC0
  cmd_Test.Caption = "Имитация гибки ( * )"
  Call Form_Resize
End If
End Sub

'Выбрать новую деталь
Private Sub PicDet_Click()
Unload Me
Dim NewDoc As New Form2
' Создать новый экземпляр формы
NewDoc.Show
End Sub

'Периодический опрос входного буфера MSComm1.Input на наличие команды
Private Sub Timer_Comm_input_Timer()
Dim tmp_comm As String
On Error GoTo NoMem
DoEvents
If MSComm1.InBufferCount >= 4 Then
  tmp_comm = MSComm1.Input
  If (Left(tmp_comm, 3) = "$A9") Then
    Call Cmd_Test_Click
  End If
  If (Left(tmp_comm, 3) = "$OK") Then
    'если пришло подтверждение связи по RS232
    rs232 = 0 ' Если прошло > 5 сек.
    Shp_rs232.BackColor = &HFF00&     ' закрасить индикатор связи по RS232 зеленым
  
    'If (tmp_comm(3) And &H2) = 0 Then
     ' Shp_Prizim.BackColor = &HFF00&
    'Else
     ' Shp_Prizim.BackColor = &HFF&
    'End If
    'If (Mid(tmp_comm, 4, 1) And Chr(4)) = 0 Then
      'Shp_Otzim.BackColor = &HFF00&
    'Else
     ' Shp_Otzim.BackColor = &HFF&
    'End If
    'If (Val(Mid(tmp_comm, 4, 1)) And 8) = 0 Then
     ' Shp_Gibka.BackColor = &HFF00&
    'Else
      'Shp_Gibka.BackColor = &HFF&
    'End If
    'If (Val(Mid(tmp_comm, 4, 1)) And 16) = 0 Then
     ' Shp_Otgibka.BackColor = &HFF00&
    'Else
    '  Shp_Otgibka.BackColor = &HFF&
    'End If
  End If

'  If tmp_comm = "$A11" Then
'    ''перемещение по базе деталей влево
'  End If
 If tmp_comm = "$A12" Then
   '    'Выбор заготовки
   Unload Me
   Dim NewDoc As New Form2
   ' Создать новый экземпляр формы
   NewDoc.Show
 End If
End If
MSComm1.Input = ""
Exit Sub
NoMem:
'Lbl_Status.Caption = ""
End Sub

Private Sub Timer_Comm_output_Timer()
'Посылаем в блок значение угла
DoEvents
If (order_out_rs232 = "T") Then
  Do While (MSComm1.InBufferCount > 0)
    DoEvents
  Loop
  MSComm1.Output = "$T0" & Chr$(Val(Txt_T(Num_step)))
  Timer_Comm_output.Enabled = False
End If
If (order_out_rs232 = "D") Then
  F1 = Val(Txt_Ugol_t(Num_step)) \ 35
  F2 = Val(Txt_Ugol_t(Num_step)) Mod 35
  Do While (MSComm1.InBufferCount > 0)
    DoEvents
  Loop
  MSComm1.Output = "$D" & Chr$(F1) & Chr$(F2)
  Lbl_ugol_status.Caption = "Угол  " & (Txt_Ugol_t(Num_step)) & "  град."
  order_out_rs232 = "T"
End If
End Sub

Private Sub Timer2_Timer()
'Рисуем ломаную по новым точкам
For j = 1 To 16
  DoEvents
  Ln_Grand(j).X1 = Pnt(Ord(j - 1)).X
  Ln_Grand(j).Y1 = Pnt(Ord(j - 1)).Y
  Ln_Grand(j).X2 = Pnt(Ord(j)).X
  Ln_Grand(j).Y2 = Pnt(Ord(j)).Y
  Lbl_Metka(j).Left = Pnt(j).X
  Lbl_Metka(j).Top = Pnt(j).Y
Next j
Shape_blink.Left = Pnt(Num_step).X - 100
Shape_blink.Top = Pnt(Num_step).Y - 100
Call paint_prizim_balka
Timer2.Enabled = False
End Sub

Private Sub Timer_Blink_Timer()
rs232 = rs232 + 1
If (rs232 > 10) Then
  rs232 = 0 ' Если прошло > 5 сек.
  Shp_rs232.BackColor = &HFF& ' закрасить индикатор связи по RS232 красным
End If
Shape_blink.Visible = Not Shape_blink.Visible
End Sub


Private Sub Txt_Dlina_Change1(Index As Integer)
'Расстановка меток
'If Not IsNumeric(Txt_Dlina(Index).Text) Then Txt_Dlina(Index) = 0

If (Val(Txt_Dlina(Index).Text) <> 0) Then
  Ln_Metka.X2 = Line1.X1 + Res * Txt_Dlina(Index).Text
  Lbl_Metka(Index).Visible = True
Else
  Ln_Metka.X2 = Line1.X2
  Lbl_Metka(Index).Visible = False
End If
Ln_Metka.Y1 = Line1.Y1 + 100
'Расстановка подписей меток
Lbl_Metka(Index).Caption = Index
Lbl_Metka(Index).Left = Ln_Metka.X2
Lbl_Metka(Index).Top = Ln_Metka.Y1

'Расстановка отметок прижима
'Прорисовка отрезков
Pnt(Index).X = Ln_Metka.X2
Pnt(Index).Y = Line1.Y2

Ln_Grand(Index).X1 = Pnt(Index - 1).X 'Линия тянется от предыдущей точки
Ln_Grand(Index).X2 = Pnt(Index).X     'до текущей

Ln_Grand(Index).Y1 = Line1.Y1
Ln_Grand(Index).Y2 = Line1.Y1
Ln_Grand(Index).Visible = True
End Sub

'п/п поворачивает точку с координатами (TX2,TY2) относительно точки с координатами
' (TX1,TY1) на угол Ugol
Public Sub Rotate(ByRef TX1 As Single, TY1 As Single, TX2 As Single, _
TY2 As Single, Ugol As Integer)
Dim dlina As Double
Dim alpha As Double
DoEvents
'Вычисляем гипотенузу-радиус поворота
dlina = Sqr((TX2 - TX1) * (TX2 - TX1) + (TY2 - TY1) * (TY2 - TY1))
'Вычисляем угол, на который поворачиваемая точка находится относительно центра
alpha = Atn(Abs((TY2 - TY1) / ((TX2 - TX1) + 0.0000000001)))
'по квадрантам 1+alpha, 2+3.14-alpha, 3+3.14+alpha, 4-alpha
If (TY2 > TY1) Then
  If (TX2 > TX1) Then
    alpha = -alpha '4
  Else
    alpha = 3.14159265358979 + alpha '3
  End If
Else
  If (TX2 < TX1) Then
    alpha = 3.14159265358979 - alpha '2
  End If
End If
'Вычисляем новые координаты поворачиваемой точки
TX2 = TX1 + dlina * Cos(3.14159265358979 * Ugol / 180 + alpha)
TY2 = TY1 - dlina * Sin(3.14159265358979 * Ugol / 180 + alpha)

End Sub
'Заполнение параметров гибки из файла, mode=1 читаем только длину заготовки
Public Sub Read_File(NumIndex As Integer, mode As Integer)
Dim F As Integer
Dim Result1 As String * 280
Dim i As Integer
Dim Result As DataFile
DoEvents
F = FreeFile
Open "base.txt" For Random As #F Len = 280
Get #F, NumIndex + 1, Result1
If (mode) Then
  Txt_Sum.Text = Mid(Result1, 275, 4)
  Txt_Sum.SelStart = 0
  Txt_Sum.SelLength = Len(Txt_Sum.Text)
Else
  For i = 1 To 15
    Txt_Ugol(i).Text = LTrim(RTrim(Mid(Result1, (i - 1) * 3 + 1, 3)))
    Txt_Ugol(i).SelStart = 0
    Txt_Ugol(i).SelLength = Len(Txt_Ugol(i).Text)
  Next i
  For i = 1 To 15
    Txt_Ugol_t(i).Text = LTrim(RTrim(Mid(Result1, (i - 1) * 3 + 46, 3)))
    Txt_Ugol_t(i).SelStart = 0
    Txt_Ugol_t(i).SelLength = Len(Txt_Ugol_t(i).Text)
  Next i
  For i = 1 To 15
    Txt_Dlina(i).Text = LTrim(RTrim(Mid(Result1, (i - 1) * 4 + 91, 4)))
    Txt_Dlina(i).SelStart = 0
    Txt_Dlina(i).SelLength = Len(Txt_Dlina(i).Text)
    Txt_Dlina_Change1 (i)
  Next i
  Txt_Dlina_Change1 (16)
  For i = 1 To 15
    Txt_Upor(i).Text = LTrim(RTrim(Mid(Result1, (i - 1) * 4 + 151, 4)))
    Txt_Upor(i).SelStart = 0
    Txt_Upor(i).SelLength = Len(Txt_Upor(i).Text)
  Next i
  For i = 1 To 15
    Txt_T(i).Text = LTrim(RTrim(Mid(Result1, (i - 1) * 2 + 211, 2)))
    Txt_T(i).SelStart = 0
    Txt_T(i).SelLength = Len(Txt_Upor(i).Text)
  Next i
  For i = 1 To 15
    Chk_Rotate(i).Value = Mid(Result1, i + 240, 1)
  Next i
  For i = 1 To 15
    Chk_PRotate(i).Value = Mid(Result1, i + 255, 1)
  Next i
  TxtKodDetali.Text = LTrim(RTrim(Mid(Result1, 271, 4)))
  TxtKodDetali.SelStart = 0
  TxtKodDetali.SelLength = Len(TxtKodDetali.Text)
End If
Close F
End Sub

Public Sub paint_prizim_balka() ' As Integer)
Dim tmp As Single
'If Not (Cmd_save_detal.Visible) Then

If (Val(Txt_Dlina(Num_step)) = 0) Then
  For i = 0 To 6
    Ln_prizim(i).Visible = False
  Next i
Else
  tmX = Pnt(Num_step).X 'начальные координаты носика упора
  tmY = Pnt(Num_step).Y - 2 * Res
  For i = 0 To 6
    'Ln_prizim(i).Visible = True
    Ln_prizim(i).X1 = tmX: Ln_prizim(i).Y1 = tmY
    Ln_prizim(i).X2 = tmX: Ln_prizim(i).Y2 = tmY
  Next i
  'If (Num_opravki) Then
  'Ln_prizim(0).X1 = tmX: Ln_prizim(0).Y1 = tmY
  Ln_prizim(0).X2 = tmX - 32 * Res: Ln_prizim(0).Y2 = tmY - 32 * Res
  Ln_prizim(1).X1 = Ln_prizim(0).X2: Ln_prizim(1).Y1 = Ln_prizim(0).Y2
  Ln_prizim(1).X2 = Ln_prizim(1).X1: Ln_prizim(1).Y2 = tmY - (Num_opravki + 35) * Res '169 100
  Ln_prizim(2).X1 = Ln_prizim(1).X2: Ln_prizim(2).Y1 = Ln_prizim(1).Y2
  Ln_prizim(2).X2 = Ln_prizim(2).X1 - 340 * Res: Ln_prizim(2).Y2 = Ln_prizim(2).Y1 - 340 * Res
  Ln_prizim(3).X1 = Ln_prizim(2).X2: Ln_prizim(3).Y1 = Ln_prizim(2).Y2
  Ln_prizim(3).X2 = Ln_prizim(3).X1: Ln_prizim(3).Y2 = Ln_prizim(3).Y1 + 360 * Res
  Ln_prizim(4).X1 = Ln_prizim(3).X2: Ln_prizim(4).Y1 = Ln_prizim(3).Y2
  Ln_prizim(4).X2 = tmX - 65 * Res: Ln_prizim(4).Y2 = Ln_prizim(4).Y1
  Ln_prizim(5).X1 = Ln_prizim(4).X2: Ln_prizim(5).Y1 = Ln_prizim(4).Y2
  Ln_prizim(5).X2 = Ln_prizim(5).X1: Ln_prizim(5).Y2 = tmY
  Ln_prizim(6).X1 = Ln_prizim(5).X2: Ln_prizim(6).Y1 = Ln_prizim(5).Y2
  Ln_prizim(6).X2 = tmX: Ln_prizim(6).Y2 = tmY
  For i = 0 To 6
    Ln_prizim(i).Visible = True
  Next i
'  Else
'    Ln_prizim(0).X2 = tmX - 360 * Res: Ln_prizim(0).Y2 = tmY - 360 * Res
'  Ln_prizim(1).X1 = Ln_prizim(0).X2: Ln_prizim(1).Y1 = Ln_prizim(0).Y2
'  Ln_prizim(1).X2 = Ln_prizim(1).X1: Ln_prizim(1).Y2 = Ln_prizim(1).Y1 + 340 * Res
'  Ln_prizim(2).X1 = Ln_prizim(1).X2: Ln_prizim(2).Y1 = Ln_prizim(1).Y2
'  Ln_prizim(2).X2 = Ln_prizim(2).X1 + 300 * Res: Ln_prizim(2).Y2 = Ln_prizim(2).Y1
'  Ln_prizim(3).X1 = Ln_prizim(2).X2: Ln_prizim(3).Y1 = Ln_prizim(2).Y2
'  Ln_prizim(3).X2 = Ln_prizim(3).X1: Ln_prizim(3).Y2 = Ln_prizim(3).Y1 + 20 * Res
'  Ln_prizim(4).X1 = Ln_prizim(3).X2: Ln_prizim(4).Y1 = Ln_prizim(3).Y2
'  Ln_prizim(4).X2 = tmX: Ln_prizim(4).Y2 = tmY
'  Ln_prizim(3).X1 = Ln_prizim(2).X2: Ln_prizim(3).Y1 = Ln_prizim(2).Y2
  'Ln_prizim(3).X2 = tmx - 98 * Res: Ln_prizim(3).Y2 = Ln_prizim(3).Y1
  'Ln_prizim(4).X1 = Ln_prizim(3).X2: Ln_prizim(4).Y1 = Ln_prizim(3).Y2
  'Ln_prizim(4).X2 = Ln_prizim(4).X1: 'Ln_prizim(4).Y2 = Ln_prizim(3).Y1
  'Ln_prizim(5).X1 = Ln_prizim(4).X2: 'Ln_prizim(4).Y1 = Ln_prizim(3).Y2
'  For i = 0 To 4
'    Ln_prizim(i).Visible = True
'  Next i
End If
End Sub

Private Sub Txt_opravka_Change()
Num_opravki = Val(Txt_opravka.Text)

If Num_opravki > 150 Then
Num_opravki = 150
Txt_opravka.Text = "150"
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErLine
If MSComm1.PortOpen Then MSComm1.PortOpen = False
Exit Sub
ErLine:
Debug.Print Err.Description
End Sub

'Выход из формы
Private Sub Cmd_exit_Click()
'Выбрать новую деталь
Unload Me
Dim NewDoc As New Form2
' Создать новый экземпляр формы
NewDoc.Show

End Sub
Private Sub Timer1_Timer()
Lbl_title = "Режим автоматической гибки детали №" & TxtKodDetali.Text
Timer1.Enabled = False
End Sub