main.frm

单片机开放式数控系统 使用vb编写

Private Sub btnPosX_Click()
  Dim NewPos, X, Y, Z, A As Long
  Dim Ack As Byte
  Dim com As TDeskWinAPICommand
  
  If Jogging Then Exit Sub
  Jogging = True
  UpdatePositionFromController
  NewPos = Val(txtDist.Text)
  com.X = CurX + NewPos
  com.Y = CurY
  com.Z = CurZ
  com.A = CurA
  com.EndSPS = 0
  com.SlewSPS = Val(txtMaxSPS.Text)
  com.CommandType = RAPIDFEED
  Ack = SendAPICommandToController(com)
  GetStatusUntilInPosition
  Jogging = False
End Sub

Private Sub btnPosY_Click()
  Dim NewPos, X, Y, Z, A As Long
  Dim Ack As Byte
  Dim com As TDeskWinAPICommand
  
  If Jogging Then Exit Sub
  Jogging = True
  UpdatePositionFromController
  NewPos = Val(txtDist.Text)
  com.X = CurX
  com.Y = CurY + NewPos
  com.Z = CurZ
  com.A = CurA
  com.EndSPS = 0
  com.SlewSPS = Val(txtMaxSPS.Text)
  com.CommandType = RAPIDFEED
  Ack = SendAPICommandToController(com)
  GetStatusUntilInPosition
  Jogging = False
End Sub

Private Sub btnSetAccel_Click()
  Dim Ack As Byte
  Dim Accel As Long
  Dim MaxSPS As Long
  Dim StartVel As Long
  Dim AScale As Byte
 
  sbrBar.Caption = "Setting Acceleration..."
  sbrBar.Refresh
  Accel = Val(txtAccel.Text)
  MaxSPS = Val(txtMaxSPS.Text)
  StartVel = Val(txtStartVel.Text)
  AScale = Val(txtScale.Text)
  Ack = DeskWinSetAccelleration(ByVal Accel, ByVal MaxSPS, ByVal StartVel, ByVal AScale)
  If Mode2ndGen Then
    If Ack = DESKWIN_2nd_OK Then
      sbrBar.Caption = "Acceleration set!"
    Else
      sbrBar.Caption = "Failed " + str(Ack)
    End If
  Else
    If Ack = DESKWIN_OK Then
      sbrBar.Caption = "Acceleration set!"
    Else
      sbrBar.Caption = "Failed " + str(Ack)
    End If
  End If
End Sub

Private Sub btnUp_Click()
  Dim NewPos, X, Y, Z, A As Long
  Dim Ack As Byte
  Dim com As TDeskWinAPICommand
  
  If Jogging Then Exit Sub
  Jogging = True
  UpdatePositionFromController
  NewPos = Val(txtDist.Text)
  com.X = CurX
  com.Y = CurY
  com.Z = CurZ + NewPos
  com.A = CurA
  com.EndSPS = 0
  com.SlewSPS = Val(txtMaxSPS.Text)
  com.CommandType = RAPIDFEED
  Ack = SendAPICommandToController(com)
  GetStatusUntilInPosition
  Jogging = False
End Sub

Public Sub UpdateCoords(X, Y, Z, A As Long)

  CurX = X
  CurY = Y
  CurZ = Z
  CurA = A
  XCoord.Caption = Format(CurX, "000.000")
  YCoord.Caption = Format(CurY, "000.000")
  ZCoord.Caption = Format(CurZ, "000.000")
  ACoord.Caption = Format(CurA, "000.000")

  XCoord.Refresh
  YCoord.Refresh
  ZCoord.Refresh
  ACoord.Refresh
End Sub
Public Sub UpdateRPM(RPM As Long)
  lblRPM.Caption = Format(RPM, "00000")
  lblRPM.Refresh
End Sub

Public Sub DoEmStop(State As Boolean)
  Dim com As TDeskWinAPICommand
  Dim Ack As Byte
  
  If State Then
    EmStop = True
    Paused = False
    Jogging = False
    com.CommandType = EMERGENCYSTOP
    Ack = SendAPICommandToController(com)
    GetStatusUntilInPosition
    sbrBar.Caption = "Controller in EMSTOP..."
  Else
    com.CommandType = GETPOS
    If SendAPICommandToController(com) = COMMANDACCEPTED Then
      sbrBar.Caption = "Controller is Ready..."
      EmStop = False
    End If
  End If
End Sub

Public Sub UpdatePositionFromController()
  Dim com As TDeskWinAPICommand
  Dim Ack As Byte
  
  com.CommandType = GETPOS
  Ack = SendAPICommandToController(com)
End Sub

Public Sub GetStatusUntilInPosition()
  Dim com As TDeskWinAPICommand
  Dim Ack As Byte
  
 sbrBar.Caption = "Controller is NOT INPOSITION..."
 InPosition = False
  com.CommandType = GETPOS
  Do While Not InPosition
    Ack = SendAPICommandToController(com)
    DoEvents
    If EmStop Then Exit Do
  Loop
  sbrBar.Caption = "Controller is INPOSITION..."
End Sub

Public Sub GetStatusUntilInPositionRPM()
  Dim com As TDeskWinAPICommand
  Dim RPMCom As TDeskWinAPICommand
  Dim Ack As Byte
  Dim cnt As Long
  
 sbrBar.Caption = "Controller is NOT INPOSITION..."
 InPosition = False
  com.CommandType = GETPOS
  RPMCom.CommandType = READRPM
  RPMCom.NumSteps = 2000 'Change to encoder CPR
  
  Do While Not InPosition
    If cnt = 25 Then
      Ack = SendAPICommandToController(RPMCom)
      cnt = 0
    End If
    cnt = cnt + 1
    Ack = SendAPICommandToController(com)
    DoEvents
    If EmStop Then Exit Do
  Loop
  sbrBar.Caption = "Controller is INPOSITION..."
End Sub

Public Sub GetStatusRPM()
  Dim com As TDeskWinAPICommand
  Dim RPMCom As TDeskWinAPICommand
  Dim Ack As Byte
  Dim cnt As Long
  
 sbrBar.Caption = "Controller is NOT INPOSITION..."
 InPosition = False
  com.CommandType = GETPOS
  RPMCom.CommandType = READRPM
 
  Do While Command4.Caption = "ON"
    If cnt = 25 Then
      Ack = SendAPICommandToController(RPMCom)
      cnt = 0
    End If
    cnt = cnt + 1
    Ack = SendAPICommandToController(com)
    DoEvents
    If EmStop Then Exit Do
  Loop
  sbrBar.Caption = "Controller is INPOSITION..."
End Sub






Private Sub Command1_Click()

Dim ii As Integer

  If FirmVer > 1.3 Then
    sbrBar.Caption = "Inputs " + str(DeskWinReadInputs)
  Else
    sbrBar.Caption = "Not available in firmware versions before V1.31"
  End If
End Sub

Private Sub Command2_Click()
Timer2 = True
intIn = 0

  Dim block As String
  Dim error As Long
  Dim init As Long
  Dim l As Integer
  
''  block = StrConv(txtGcode.Text, vbUnicode)
''  block = String(101, 0)
''  block = StrConv(txtGcode.Text, vbUnicode)

  block = txtGcode.Text
  l = Len(block)
  If init = 0 Then
    error = rs274ngc_read_block(block)
    If error = 0 Then
      error = rs274ngc_execute_block
      FlushBuffer
      GetStatusUntilInPosition
      'G代码加载运行
      GetGChange
    Else
      If error <> 0 Then sbrBar.Caption = "Error " + rs274ngc_errors(error)
      Exit Sub
    End If
  Else
    sbrBar.Caption = "Interpreter failed to initialize - error " + str(init)
  End If
  If error <> 0 Then sbrBar.Caption = "Error " + str(error)
End Sub


Private Sub Command3_Click()
  Dim com As TDeskWinAPICommand
  Dim Ack As Byte
  
  Chase = Not Chase
  If Mode2ndGen Then
    com.CommandType = CHASEENCODER
    If Chase Then
      com.X = 0
      com.Y = 0
      com.Z = 70000   'Total Number of steps to move z
      com.A = 70000  'Number of encoder counts command is active
      com.Dir = 1    'Direction of Z
      com.Quad = 1   'Enable command
      com.Axis = 0   'Encoder Phase Direction (0 or 1 to reverse encoder count direction)
      Ack = SendAPICommandToController(com)
      sbrBar.Caption = "Encoder Chase On - "
      Command3.Caption = "ON"
    Else
      com.Quad = 0   'Disable command
      Ack = SendAPICommandToController(com)
      sbrBar.Caption = "Encoder Chase Off"
      Command3.Caption = "OFF"
    End If
    GetStatusUntilInPositionRPM
  End If
End Sub


Private Sub Command4_Click()
    RPMON = Not RPMON
    If RPMON Then
      Command4.Caption = "ON"
    Else
      Command4.Caption = "OFF"
    End If
    GetStatusRPM
End Sub

Private Sub Command5_Click()
txtNote = ""
End Sub

Private Sub Form_Load()
Me.Move 0, 200
'    Me.Move CInt((Screen.Width - Me.Width) / 2), CInt((Screen.Height - Me.Height) * 3 / 4)
    Shell App.Path & "\CNCView.exe", vbNormalFocus
    ControllerFound = True
  SetupErrorCodes
  LoadFileList
End Sub

Private Sub Form_Terminate()
  DeskWinClose
End Sub


Private Sub Form_Unload(Cancel As Integer)
TerminateTask "BASIC 3-D Viewer [NOT FOR PRODUCTION USE!]"
End
End Sub

Private Sub lstCategory_Click()
If lstCategory.ListIndex < 0 Then Exit Sub
    LoadFile lstCategory.List(lstCategory.ListIndex)
End Sub

Private Sub Timer1_Timer()
'此处为时钟触发G代码变化
    GetGChange
End Sub

 


Private Sub cmdStart_Click()
cmdStop.Enabled = True
cmdStart.Enabled = False
Timer1.Enabled = True
Timer1.Interval = txtTime
End Sub

Private Sub cmdStop_Click()
cmdStart.Enabled = True
cmdStop.Enabled = False
Timer1.Enabled = False

End Sub

'此处为时钟模拟触发变化, 链接硬件后,直接在硬件触发事件里面调用此函数
Public Function GetGChange()

    If lstCategory.ListIndex < 0 Then
        MsgBox "未选择G代码文件"
        cmdStop_Click
        Exit Function
    End If
    If lstSubCategory.ListIndex < 0 Then
        lstSubCategory.ListIndex = 0
    End If
    
    txtGcode = DelN(lstSubCategory.List(lstSubCategory.ListIndex))
    
    txtNote = AddN(txtGcode) & vbCrLf & txtNote
    
    If lstSubCategory.ListIndex < lstSubCategory.ListCount - 1 Then
        lstSubCategory.ListIndex = lstSubCategory.ListIndex + 1
    Else
        cmdStop_Click

    End If
End Function

'删除行号
Public Function DelN(s)
    Dim str1, myVar
    s = Trim$(s)
    If s = "" Then Exit Function
    If Left$(UCase$(s), 1) = "N" Then
        myVar = Split(s, " ")
        myVar(0) = ""
        s = Join(myVar, " ")
        DelN = DelN(s)
    Else
        DelN = Trim(s)
        
    End If

End Function

'加入行号
Public Function AddN(s)
Dim intI
intI = Format(lstSubCategory.ListIndex + 1, "00")
AddN = "N" & intI & " " & s
End Function

'处理G代码显示函数
Public Function GView()
On Error Resume Next
    Dim s, myVar, i
    myVar = Split(txtNote, vbCrLf)
    For i = UBound(myVar) To 0 Step -1
    
         If s <> "" Then
         s = s & vbCrLf & myVar(i)
         Else
         s = myVar(i)
         End If
    Next
    Open App.Path & "\Samples\MILL.CNC" For Output As #1
    Print #1, s
    Close #1
   
End Function



'加载G代码文件列表
Public Function LoadFileList()
    lstCategory.Clear
    Dim strFile$
    strFile$ = Dir(App.Path & "\G代码\*.ini")
    If Trim(RIni(strFile$)) <> "" Then
        If LCase$(strFile$) <> "userdefault.ini" Then
            lstCategory.AddItem RIni(strFile$)
        End If
    End If
    Do Until strFile$ = ""
        strFile$ = Dir()
       
        If Trim(RIni(strFile$)) <> "" Then
            If LCase$(strFile$) <> "userdefault.ini" Then
                lstCategory.AddItem RIni(strFile$)
            End If
        End If
    Loop
End Function



'字符串处理函数
'从后起 取出传入字符串的对应的字符串
'
'?GetStringBack("aa.exe",".")
'返回.exe
'去掉文件的扩展名
Public Function RIni(str)
    Dim s$
    s = GetStringBack(str, ".")
    RIni = Replace$(str, s, "")
End Function

Public Function GetStringBack(ByVal St$, _
                              ByVal sP$) As String
    If St$ = "" Then Exit Function
    GetStringBack = Mid(St$, InStrRev(St$, sP$), Len(St$) - InStrRev(St$, sP$) + 1)
End Function

'加载对应文件的内容
Function LoadFile(sFileName)

    If Dir(App.Path & "\G代码\" & sFileName & ".ini") = "" Then Exit Function
    Dim strV$
    lstSubCategory.Clear
    Open App.Path & "\G代码\" & sFileName & ".ini" For Input As #1
    While Not EOF(1)
        Line Input #1, strV$
        'if Trim(strV$) <> "" Then
        '用户自己配置文件应该不去考虑是否有回车
        lstSubCategory.AddItem strV$
    Wend
    Close #1
End Function

Private Sub Timer2_Timer()

    If XCoord = "0" Then Command2_Click

    If sOldX = XCoord And sOldY = YCoord And sOldZ = ZCoord And sOldA = ACoord Then
    
    
        intIn = intIn + 1
        If intIn = 3 Then
            Timer2.Enabled = False
            Command2_Click
        End If
        Exit Sub
    End If
    sOldX = XCoord
    sOldY = YCoord
    sOldZ = ZCoord
    sOldA = ACoord
    intIn = 0
End Sub

Private Sub txtGcode_Change()

'    txtGcode = DelN(txtGcode)
'
'    txtNote = AddN(txtGcode) & vbCrLf & txtNote
End Sub

Private Sub txtNote_Change()
GView
End Sub