控制转速.frm

电机控制板程序修改.机电一体化的实际应用。可操作性强

         TabIndex        =   16
         Top             =   480
         Width           =   1455
      End
   End
   Begin VB.Frame Frame5 
      Caption         =   "直流电机控制"
      Height          =   1455
      Left            =   2400
      TabIndex        =   22
      Top             =   6360
      Width           =   2055
      Begin VB.CommandButton Command8 
         Caption         =   "停止"
         Height          =   495
         Left            =   1080
         TabIndex        =   27
         Top             =   840
         Width           =   855
      End
      Begin VB.CommandButton Command6 
         Caption         =   "确认"
         Height          =   495
         Left            =   120
         TabIndex        =   25
         Top             =   840
         Width           =   855
      End
      Begin VB.TextBox Text6 
         Height          =   375
         Left            =   960
         TabIndex        =   24
         Text            =   "Text6"
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label7 
         Caption         =   "PWM设定"
         Height          =   375
         Left            =   240
         TabIndex        =   23
         Top             =   480
         Width           =   975
      End
   End
   Begin VB.Label Label17 
      Caption         =   "Label17"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   7800
      TabIndex        =   46
      Top             =   120
      Width           =   975
   End
   Begin VB.Label Label16 
      Caption         =   "当前PWM(%):"
      Height          =   255
      Left            =   6840
      TabIndex        =   45
      Top             =   120
      Width           =   1095
   End
   Begin VB.Label Label15 
      Caption         =   "转速动态曲线图"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   3960
      TabIndex        =   43
      Top             =   0
      Width           =   2295
   End
   Begin VB.Label Label14 
      Caption         =   "当前转速："
      Height          =   375
      Left            =   1680
      TabIndex        =   42
      Top             =   120
      Width           =   975
   End
   Begin VB.Label Label13 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   2760
      TabIndex        =   41
      Top             =   120
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim XGrid, YGrid, YStart As Integer
Dim GridSpaceX, GridSpaceY
Dim SampleInterval As Integer
Dim StepSpeed As Integer
Dim MotoPWM As Integer
Dim X, Y As Integer
Dim xx0, yy0
Dim Pause As Boolean
Dim Kp, Ki, Kd
Dim ExpectSpeed, PIDInterval, PIDTimes As Integer   'PIDInterval 是指采样周期的倍数，而PIDTimes是指经过了多少个采样周期
Dim P(2) As Integer              ' P(0)=P(K-1),P(1)=P(K)
Dim E(3) As Integer   ' E(0)=E(K-2),E(1)=E(K-1),E(2)=E(K)
Dim PIDControl As Boolean


  

Sub Transmit_byte(TByte)    '串行发送
  Dim outbuffer(0) As Byte
On Error GoTo err1
  
  outbuffer(0) = TByte
  MSComm1.InBufferCount = 0 '清空接收缓存
  MSComm1.Output = outbuffer
  Exit Sub
  
err1:
   MsgBox ("先要打开串口")
   Err.Clear
   Resume 'Next
End Sub
Function Receive_byte() As Byte  '串行接收
On Error GoTo err1
    MSComm1.InputLen = 1
    t = Timer
    Do
        DoEvents
    Loop Until MSComm1.InBufferCount > 0 Or t < Timer
    
    If MSComm1.InBufferCount > 0 Then
        inbuffer = MSComm1.Input
    End If
    Receive_byte = inbuffer(0)
    Exit Function
err1:
   'MsgBox ("串口通信出错")
   Err.Clear
   Resume Next
End Function


Sub DrawlinearGrid()   '画坐标系
   Gridlines = 10
   Picture1.AutoRedraw = False
   GridSpaceX = Picture1.ScaleWidth \ Gridlines
   GridSpaceY = Picture1.ScaleHeight \ Gridlines
   For i = 0 To Gridlines + 1
      Picture1.Line (GridSpaceX * i + 1, 0)-(GridSpaceX * i + 1, Picture1.Height - 2), RGB(150, 150, 150) '竖线
      Picture1.Line (1, Picture1.Height - GridSpaceY * i - 2)-(Picture1.Width - 1, Picture1.Height - GridSpaceY * i - 2), RGB(150, 150, 150) '横线
   Next
   For i = 0 To Gridlines
      CurrentX = GridSpaceX * i + 12: CurrentY = Picture1.Top + Picture1.Height + 1
      Print i * XGrid;
      CurrentX = Picture1.Left - 9: CurrentY = Picture1.Height - GridSpaceY * i + 3
      Print YStart + YGrid * i;
   Next
   
   CurrentX = Picture1.Left - 9: CurrentY = Picture1.Top - 4
   Print "转速r/m";

   CurrentX = Picture1.Left + Picture1.Width \ 2: CurrentY = Picture1.Top + Picture1.Height + 5
   Print "时间ms";
End Sub

Private Sub Command1_Click()    '连续测速
    'If MSComm1.PortOpen Then
    'MSComm1.PortOpen = False
    Picture1.Refresh
    X = 0:
    Call Transmit_byte(&HC3)
    Y = Receive_byte
    Y = (Y * 256 + Receive_byte) Mod 32768
    Picture1.CurrentX = 1
    Picture1.CurrentY = Picture1.Height - 2 - (Y - YStart) * GridSpaceY / YGrid
    xx0 = Picture1.CurrentX
    yy0 = Picture1.CurrentY
    SampleInterval = Val(Text5.Text)
    Timer1.Interval = SampleInterval
    Timer1.Enabled = True
End Sub

Private Sub Command10_Click()  '连续测速 暂停
    If Pause = True Then
       Timer1.Enabled = True
       Command10.Caption = "暂停"
    Else
       Timer1.Enabled = False
       Command10.Caption = "继续"
    End If
    Pause = Not Pause
End Sub

Private Sub Command11_Click()   'PID退出
   Dim temp As Byte
   PIDControl = False
   Call Transmit_byte(&HC2)
   Call Transmit_byte(0)
   Call Transmit_byte(0)
   E(0) = 0: E(1) = 0
   P(0) = 0
End Sub

Private Sub Command2_Click()  '关闭退出
    If MSComm1.PortOpen = True Then
       Call Transmit_byte(&HC5)  '关步进电机
       Call Transmit_byte(&HC2)  '关直流电机
        Call Transmit_byte(0)
       Call Transmit_byte(0)
       MSComm1.PortOpen = False
    End If
    Timer1.Enabled = False
    End
End Sub

Private Sub Command3_Click()  '打开串口
  On Error GoTo err1
  If MSComm1.PortOpen = True Then
     Exit Sub
  End If
  Command3.Caption = "串口已打开"
  MSComm1.CommPort = Right(Combo1.Text, 1)
  MSComm1.PortOpen = True
  MSComm1.InputMode = comInputModeBinary
  MSComm1.Settings = "19200,n,8,1"
  Exit Sub
err1:
  MsgBox ("无此串口")
  Err.Clear
  Resume Next
End Sub

Private Sub List1_Click()

End Sub

Private Sub Command4_Click()  '刷新坐标系
  
  XGrid = Val(Text1.Text)
  YGrid = Val(Text2.Text)
  YStart = Val(Text3.Text)
  SampleInterval = Val(Text5.Text)
  Form1.Refresh
  'Picture1.Refresh
  Call DrawlinearGrid
End Sub

Private Sub Command5_Click()   '步进电机启动
   StepSpeed = Val(Text4.Text)
   Call Transmit_byte(&HC0)
   Call Transmit_byte(StepSpeed \ 256)
   Call Transmit_byte(StepSpeed Mod 256)
End Sub

Private Sub Command6_Click()  '直流电机PWM启动
   Dim sum As Byte
   MotoPWM = 10 * Val(Text6.Text)
   Call Transmit_byte(&HC2)
   Call Transmit_byte(MotoPWM \ 256)
   Call Transmit_byte(MotoPWM Mod 256)
End Sub

Private Sub Command7_Click()  '步进电机停止
   'StepSpeed = Val(Text4.Text)
   Call Transmit_byte(&HC5)
End Sub

Private Sub Command8_Click() '直流电机PWM停止
   Call Transmit_byte(&HC2)
   Call Transmit_byte(0)
   Call Transmit_byte(0)
End Sub

Private Sub Command9_Click()  'PID控制确认
   Kp = Val(Text7.Text)
   Ki = Val(Text8.Text)
   Kd = Val(Text9.Text)
   ExpectSpeed = Val(Text10.Text)
   PIDInterval = Val(Text11.Text)
   'MotoPWM = 10 * Val(Text6.Text) '启动直流电机
   'Call Transmit_byte(&HC2)
   'Call Transmit_byte(MotoPWM \ 256)
   'Call Transmit_byte(MotoPWM Mod 256)
    P(0) = MotoPWM
   'E(0) = 0
   'E(1) = 0
   PIDControl = True
   
   
End Sub

Private Sub Form_Load()
   Text1.Text = "200": XGrid = Val(Text1.Text)
   Text2.Text = "300": YGrid = Val(Text2.Text)
   Text3.Text = "0": YStart = Val(Text3.Text)
   Text4.Text = "300": StepSpeed = Val(Text4.Text)
   Text5.Text = "50": SampleInterval = Val(Text5.Text)
   Text6.Text = "10.0": MotoPWM = 10 * Val(Text6.Text)
   Text7.Text = "0.02"
   Text8.Text = "0.04"
   Text9.Text = "0.002"
   Text10.Text = "1500"
   Text11.Text = "2"
   E(0) = 0: E(1) = 0   'PID速度差给予初值
   Label17.Caption = ""
   PIDControl = False
   Pause = False
End Sub

Private Sub Picture1_Paint()
   Call DrawlinearGrid
End Sub

Private Sub Timer1_Timer()   '定时测速
  Dim xx, yy
  Dim sum As Byte
  Dim temp As Single
  Dim CurrentSpeed As Integer
    Call Transmit_byte(&HC3)
    Y = Receive_byte Mod &H13    '防止数据受干扰时数字太大死机
    Y = (Y * 256 + Receive_byte) Mod 32768
    CurrentSpeed = Y
    
    X = X + 1
    xx = X * SampleInterval * GridSpaceX / XGrid + 1
    If xx > Picture1.Width Then
       xx0 = 1: X = 1
       xx = 2
       Picture1.Refresh
    End If
    yy = Picture1.Height - 2 - (Y - YStart) * GridSpaceY / YGrid
    Picture1.Line (xx0, yy0)-(xx, yy), RGB(255, 0, 255)
    xx0 = xx: yy0 = yy
    Label13.Caption = Y
   If (PIDControl = True) And (PIDTimes < PIDInterval) Then
      PIDTimes = PIDTimes + 1
   ElseIf PIDControl = True Then
      E(2) = ExpectSpeed - CurrentSpeed
      P(1) = P(0) + Kp * (E(2) - E(1)) + Ki * E(2) + Kd * (E(2) - 2 * E(1) + E(0))
      If P(1) < 0 Then P(1) = 0
      If P(1) > 1000 Then P(1) = 1000
      P(0) = P(1)
      Call Transmit_byte(&HC2)
      Call Transmit_byte(P(1) \ 256)
      Call Transmit_byte(P(1) Mod 256)
      E(0) = E(1)
      E(1) = E(2)
      PIDTimes = 0
      Label17.Caption = P(1) / 10
   End If
End Sub