manulcontrolfrm.frm

数控切割控制系统,需要DLPORTIO,通过控制8位的并口的电位高低来4路控制数控切割机

         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   180
      TabIndex        =   1
      Top             =   840
      Width           =   1395
   End
End
Attribute VB_Name = "ManulControlFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Direction As Integer '方向(1 -- 前，2 -- 后， 3 -- 左， 4 -- 右)
Dim xPos As Double
Dim yPos As Double

Private Sub BackCmd_Click()
    Unload Me
    MainFrm.Show vbModal
End Sub

Private Sub Process_Key(KeyCode As Integer, Shift As Integer)
    If (KeyCode = vbKeyBack) And (Shift = 4) Then
        Call BackCmd_Click
    End If
    
    If (KeyCode = vbKeyF1) Then
        Call QuickFrontCmd_Click
    End If
    
    If (KeyCode = vbKeyF2) Then
        Call QuickBackCmd_Click
    End If
    
    If (KeyCode = vbKeyF3) Then
        Call SlowlyFrontCmd_Click
    End If
    
    If (KeyCode = vbKeyF4) Then
        Call SlowlyBackCmd_Click
    End If
    
    If (KeyCode = vbKeyF5) Then
        Call LeftCmd_Click
    End If
    
    If (KeyCode = vbKeyF6) Then
        Call RightCmd_Click
    End If
    
    If (KeyCode = vbKeyF7) Then
        Call StopYCmd_Click
    End If
    
    If (KeyCode = vbKeyF8) Then
        Call StopXCmd_Click
    End If
End Sub

Private Sub BackCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Form_Load()
    Dim Mystr As String
    Dim sQuickSpeed As String
    Dim sSlowlySpeed As String
    Dim sLRSpeed As String
    
    Direction = 0
    sQuickSpeed = "0"
    sSlowlySpeed = "0"
    sLRSpeed = "0"
    
    xPos = 0
    yPos = 0
    
    On Error GoTo errHandler
    Open App.Path + "\设置文件\Speed.txt" For Input As #1
    Do While Not EOF(1)
        Input #1, Mystr
        If (Mystr = "[Quick]") Then
            If Not EOF(1) Then
                Input #1, sQuickSpeed
                sQuickSpeed = ReadRightString(sQuickSpeed)
            End If
        End If
        If (Mystr = "[Slowly]") Then
            If Not EOF(1) Then
                Input #1, sSlowlySpeed
                sSlowlySpeed = ReadRightString(sSlowlySpeed)
            End If
        End If
        If (Mystr = "[LeftRight]") Then
            If Not EOF(1) Then
                Input #1, sLRSpeed
                sLRSpeed = ReadRightString(sLRSpeed)
            End If
        End If
    Loop
    Close #1
    LblQuick.Caption = sQuickSpeed + "米/分钟"
    LblSlowly.Caption = sSlowlySpeed + "米/分钟"
    
    LblLRSpeed.Caption = sLRSpeed + "米/分钟"
    
    FFBQuick = sQuickSpeed
    FFBSlow = sSlowlySpeed
    
    manulLRSpeed = sLRSpeed
'    FFBQuick = AtoL(sQuickSpeed)
'    FFBSlow = AtoL(sSlowlySpeed)
errHandler:
    If Err.Number = 53 Then
        MsgBox "'Speed.txt'文件不存在,请与管理员联系", vbInformation, "提示"
        Unload Me
        MainFrm.Show vbModal
    End If
End Sub

Private Sub LeftCmd_Click()
    Dim Interval As Double
    
    Interval = Ax * 60 / manulLRSpeed
    XTimer.Interval = Interval
    'XTimer.Interval = 10
    
    XTimer.Enabled = True
    Direction = 3
    
    StopXCmd.Enabled = True
    Call EnableXButton
    LeftCmd.Enabled = False
    Call DisableXButton
End Sub

Private Sub LeftCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub QuickBackCmd_Click()
    Dim Interval As Double
    
    Interval = Ay * 60 / FFBQuick
    YTimerQuick.Interval = Interval
    
    YTimerQuick.Enabled = True
    Direction = 2 '2 -- 向后
    
    StopYCmd.Enabled = True
    
    Call EnableYButton
    QuickBackCmd.Enabled = False
    SlowlyBackCmd.Enabled = False
    Call DisableYButton
End Sub

Private Sub QuickBackCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub QuickFrontCmd_Click()
    Dim Interval As Double
    
    Interval = Ay * 60 / FFBQuick
    YTimerQuick.Interval = Interval
    
    YTimerQuick.Enabled = True
    Direction = 1 '1--向前
    
    StopYCmd.Enabled = True
    
    EnableYButton
    QuickFrontCmd.Enabled = False
    SlowlyFrontCmd.Enabled = False
    QuickBackCmd.Enabled = False
    SlowlyBackCmd.Enabled = False
    Call DisableYButton
End Sub

Private Sub QuickFrontCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub RightCmd_Click()
    Dim Interval As Double
    
    Interval = Ax * 60 / manulLRSpeed
    XTimer.Interval = CInt(Interval)
    
    XTimer.Enabled = True
    Direction = 4
    
    StopXCmd.Enabled = True
    Call EnableXButton
    RightCmd.Enabled = False
    Call DisableXButton
End Sub

Private Sub RightCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub SlowlyBackCmd_Click()
    Dim Interval As Double
    
    Interval = Ay * 60 / FFBSlow
    YTimerSlow.Interval = Interval
    
    YTimerSlow.Enabled = True
    Direction = 2
    
    StopYCmd.Enabled = True
    Call EnableYButton
    SlowlyBackCmd.Enabled = False
    QuickBackCmd.Enabled = False
    Call DisableYButton
End Sub

Private Sub SlowlyBackCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub SlowlyFrontCmd_Click()
    Dim Interval As Double
    
    Interval = Ay * 60 / FFBSlow
    YTimerSlow.Interval = Interval
    
    YTimerSlow.Enabled = True
    Direction = 1
    
    StopYCmd.Enabled = True
    Call EnableYButton
    SlowlyFrontCmd.Enabled = False
    QuickFrontCmd.Enabled = False
    Call DisableYButton
End Sub

Private Sub SlowlyFrontCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub StopXCmd_Click()
    StopXCmd.Enabled = False
    
    Call EnableXButton
    StopXCmd.Enabled = False
    
    XTimer.Enabled = False
End Sub

Private Sub StopYCmd_Click()
    YTimerQuick.Enabled = False
    YTimerSlow.Enabled = False
    Call EnableYButton
    StopYCmd.Enabled = False
End Sub

Private Sub Timer_Beep_Timer()
    Beep
End Sub

Private Sub XTimer_Timer()
    If (Direction = 3) Then
        xPos = xPos + Ax
        WritePortDirect 1, 1
        Result = WriteOneSignal(1, 1)
    End If
    Call Judge
    If (Direction = 4) Then
        xPos = xPos - Ax
        WritePortDirect 1, 2
        Result = WriteOneSignal(1, 1)
    End If
    
    Call Judge
    
    LblXPosition.Caption = xPos
End Sub

Private Sub YTimer_Timer()
    If (Direction = 1) Then
        yPos = yPos + Ay
        WritePortDirect 2, 1
        Result = WriteOneSignal(2, 1)
    Else
        yPos = yPos - Ay
        WritePortDirect 2, 2
        Result = WriteOneSignal(2, 1)
    End If
    Call Judge
    LblYPosition.Caption = yPos
End Sub

Private Sub EnableYButton()
    QuickFrontCmd.Enabled = True
    QuickBackCmd.Enabled = True
    SlowlyFrontCmd.Enabled = True
    SlowlyBackCmd.Enabled = True
End Sub

Private Sub DisableYButton()
    QuickFrontCmd.Enabled = False
    QuickBackCmd.Enabled = False
    SlowlyFrontCmd.Enabled = False
    SlowlyBackCmd.Enabled = False
End Sub

Private Sub EnableXButton()
    LeftCmd.Enabled = True
    RightCmd.Enabled = True
End Sub

Private Sub DisableXButton()
    LeftCmd.Enabled = False
    RightCmd.Enabled = False
End Sub

Private Sub YTimerQuick_Timer()
    If (Direction = 1) Then
        yPos = yPos + Ay
        WritePortDirect 2, 1
        Result = WriteOneSignal(2, 1)
    Else
        yPos = yPos - Ay
        WritePortDirect 2, 2
        Result = WriteOneSignal(2, 1)
    End If
    Call Judge
    LblYPosition.Caption = yPos
End Sub

Private Sub YTimerSlow_Timer()
    If (Direction = 1) Then
        yPos = yPos + Ay
        WritePortDirect 2, 1
        Result = WriteOneSignal(2, 1)
    Else
        yPos = yPos - Ay
        WritePortDirect 2, 2
        Result = WriteOneSignal(2, 1)
    End If
    Call Judge
    LblYPosition.Caption = yPos
End Sub

Private Sub Judge()
    If (Result = 2) And XTimer.Enabled = True Then
        XTimer.Enabled = False
        
        MsgBox "X轴到头！返回", vbInformation, "提示"
        Unload Me
        MainFrm.Show vbModal
        Exit Sub
    End If
    
    If (Result = 3) And (YTimerSlow.Enabled Or YTimerQuick.Enabled) Then
        YTimerSlow.Enabled = False
        YTimerQuick.Enabled = False
        
        MsgBox "Y轴到头！返回", vbInformation, "提示"
        Unload Me
        MainFrm.Show vbModal
        Exit Sub
    End If
    
    If (Result = 1) Then
        XTimer.Enabled = False
        YTimerSlow.Enabled = False
        YTimerQuick.Enabled = False
        
        Timer_Beep.Enabled = True
        MsgBox "出现故障", vbInformation, "提示"
        Timer_Beep.Enabled = False
        Unload Me
        MainFrm.Show vbModal
        Exit Sub
    End If
End Sub