prgcontrolfrm.frm

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

'    If ((Abs(X2 - dX01) < Ax) And (Abs(Y2 - dY01) < Ay)) Then
'        Timer.Enabled = False
'        'StopGoOnCmd.Enabled = False
'    End If
    
   ' If (Abs(X2 - dX01) <= Ax) And (Abs(Y2 - dY01) <= Ay) Then
    
'    If (iTag = 0) Then
'        If (Abs(curx - dX01) <= Ax0) And (Abs(cury - dY01) <= Ay0) Then
'            Timer.Enabled = False
'            StopGoOnCmd.Enabled = False
''            Exit Sub
'        End If
'    Else
'        If (Abs(curx - dY01) <= Ax0) And (Abs(cury - dX01) <= Ay0) Then
'            Timer.Enabled = False
'            StopGoOnCmd.Enabled = False
''            Exit Sub
'        End If
'    End If
    
    If (d < 0) Then
        d = d + inc1
    Else
        cury = cury + ty
        d = d + inc2
    End If
    If (iTag) Then
        If (cury > OldPx) Then
            WritePortDirect 2, 1
            Result = WriteOneSignal(2, 1)
        End If
        Call Judge
        If (cury < OldPx) Then
            WritePortDirect 2, 2
            Result = WriteOneSignal(2, 1)
        End If
        Call Judge
        If (curx > OldPy) Then
            WritePortDirect 1, 1
            Result = WriteOneSignal(1, 1)
        End If
        Call Judge
        If (curx < OldPy) Then
            WritePortDirect 1, 2
            Result = WriteOneSignal(1, 1)
        End If
        Call Judge
        OldPx = cury
        OldPy = curx
        
        X2 = cury
        Y2 = curx
        xPos = X2
        yPos = Y2
    Else
        If (curx > OldPx) Then
            WritePortDirect 2, 1
            Result = WriteOneSignal(2, 1)
        End If
        Call Judge
        If (curx < OldPx) Then
            WritePortDirect 2, 2
            Result = WriteOneSignal(2, 1)
        End If
        Call Judge
        If (cury > OldPy) Then
            WritePortDirect 1, 1
            Result = WriteOneSignal(1, 1)
        End If
        Call Judge
        If (cury < OldPy) Then
            WritePortDirect 1, 2
            Result = WriteOneSignal(1, 1)
        End If
        Call Judge
        OldPx = curx
        OldPy = cury

        X2 = curx
        Y2 = cury
        xPos = X2
        yPos = Y2
    End If
    
    LblXPos.Caption = Format(xPos, "###0.0")
    LblYPos.Caption = Format(yPos, "###0.0")
    
    'Picture2.PSet (2000 + xPos, 2000 + yPos), RGB(255, 0, 0)
    
    If (iTag = 0) Then
        If (Abs(curx - dX01) < Ax0) Then
            Timer.Enabled = False
            If Not (bDrawCircle) Then
                StopGoOnCmd.Enabled = False
            End If
            Exit Sub
        End If
    Else
        If (Abs(curx - dY01) < Ax0) Then
            Timer.Enabled = False
            If Not (bDrawCircle) Then
                StopGoOnCmd.Enabled = False
            End If
            Exit Sub
        End If
    End If
    
    curx = curx + tx
    
    
'    If (DirectX) Then
'        If (Abs(Y2 - dY01) < Ay) Then
'            Timer.Enabled = False
''            'StopGoOnCmd.Enabled = False
'        End If
'    End If
'
'    If (DirectY) Then
'        If (Abs(X2 - dX01) < Ax) Then
'            Timer.Enabled = False
'            'StopGoOnCmd.Enabled = False
'        End If
'    End If
'
'    If Not (DirectX) And Not DirectY And ((Abs(X2 - dX01) < Ax) And (Abs(Y2 - dY01) < Ay)) Then
'        Timer.Enabled = False
'        'StopGoOnCmd.Enabled = False
'    End If
'
'    If Not (DirectX) And Not DirectY And ((Abs(X2 - dX01) < Ax) Or (Abs(Y2 - dY01) < Ay)) Then
'        Timer.Enabled = False
'        'StopGoOnCmd.Enabled = False
'    End If
'    If ((Abs(X2 - dX01) <= Ax) And (Abs(Y2 - dY01) <= Ay)) Then
'        Timer.Enabled = False
'        'StopGoOnCmd.Enabled = False
'    End If
    
'    If (iTag = 0) Then
'        If (Abs(curx - dX01) < Ax0) And (Abs(cury - dY01) < Ay0) Then
'            Timer.Enabled = False
'            StopGoOnCmd.Enabled = False
'            Exit Sub
'        End If
'    Else
'        If (Abs(curx - dY01) < Ax0) And (Abs(cury - dX01) < Ay0) Then
'            Timer.Enabled = False
'            StopGoOnCmd.Enabled = False
'            Exit Sub
'        End If
'    End If
    
    
End Sub

Private Sub XTimer_Timer()
    If (X1 > X0) Then
        X2 = X2 + Ax
        xPos = xPos + Ax
        WritePortDirect 1, 1
        Result = WriteOneSignal(1, 1)
    Else
        X2 = X2 - Ax
        xPos = xPos - Ax
        WritePortDirect 1, 2
        Result = WriteOneSignal(1, 1)
    End If
    
    Call Judge
    LblXPos.Caption = Format(xPos, "###0.0")

'    If (Abs(X2 - X1) < Ax) Or (Abs(Y2 - Y1) < Ay) Then
'        XTimer.Enabled = False
'        YTimer.Enabled = False
''        LblYPos.Caption = Format(Y1, "###0.0")
''        LblXPos.Caption = Format(X1, "###0.0")
''        StopNow = False
'    End If
    xStartCount = xStartCount + 1
    If (xStartCount >= xCount) Then
        XTimer.Enabled = False
        StopGoOnCmd.Enabled = False
    End If
End Sub

Private Sub YTimer_Timer()
    If (Y1 > Y0) Then
        Y2 = Y2 + Ay
'        xPos = xPos + Ax
        yPos = yPos + Ay
        WritePortDirect 2, 1
        Result = WriteOneSignal(2, 1)
    Else
        Y2 = Y2 - Ay
'        xPos = xPos - Ax
        yPos = yPos - Ay
        WritePortDirect 2, 2
        Result = WriteOneSignal(2, 1)
    End If
    
    Call Judge
'    LblXPos.Caption = xPos
    LblYPos.Caption = Format(yPos, "###0.0")

'    If (Abs(X2 - X1) < Ax) Or (Abs(Y2 - Y1) < Ay) Then
'        XTimer.Enabled = False
'        YTimer.Enabled = False
''        LblYPos.Caption = Format(Y1, "###0.0")
''        LblXPos.Caption = Format(X1, "###0.0")
''        StopNow = False
'    End If
    yStartCount = yStartCount + 1
    If (yStartCount >= yCount) Then
        YTimer.Enabled = False
        StopGoOnCmd.Enabled = False
    End If
End Sub

Public Function SendCircleSignal() As Boolean
    Dim Xc, Yc As Double  '圆坐标
    Dim Rc As Double      '圆半径
    Dim iDirect As Integer '1--顺时针,2--逆时针
    Dim dX0, dY0, dX1, dY1 As Double  '把圆心移到坐标原点后的起点和终点坐标X0,Y0,X1,Y1
    Dim sX0, sY0, sX1, sY1 As Double
    
    If (G0 = 2) Then
        iDirect = 1
    End If
    
    If (G0 = 3) Then
        iDirect = 2
    End If
    Dim StartAngle As Double
    Dim EndAngle As Double
    
    SendCircleSignal = True
    '已知圆心坐标
    If (I <> 0) Or (J <> 0) Then
        Xc = X0 + I
        Yc = Y0 + J
        Rc = Sqr(I * I + J * J)
        'R = Rc
        dX0 = -I    'X0 - Xc
        dY0 = -J    'Y0 - Yc
        dX1 = X1 - X0 - I 'X1 - Xc
        dY1 = Y1 - Y0 - J 'Y1 - Yc
    Else
        SendCircleSignal = False
        Exit Function
        '已知圆心半径
        If (r <> 0) Then
            Rc = r
            
        End If
    End If
    If (r < 500) Then
        perAngle = Pi / 180
    Else
        perAngle = Pi / 360
    End If
    
    If (iDirect = 1) Then
        perAngle = -perAngle
    End If
    
    StartAngle = GetAngle(dX0, dY0)
    EndAngle = GetAngle(dX1, dY1)
    
    If (iDirect = 1) Then
        If (StartAngle <= EndAngle) Then
            StartAngle = StartAngle + 2 * Pi
        End If
    End If
    
    If (iDirect = 2) Then
        If (StartAngle >= EndAngle) Then
            EndAngle = EndAngle + 2 * Pi
        End If
    End If

'    If (iDirect = 1) Then
'        If (StartAngle < EndAngle) Then
'            EndAngle = -EndAngle
'        End If
'    End If
    
    sX0 = dX0 + Xc
    sY0 = dY0 + Yc
    sX1 = sX0
    sY1 = sY0
    
    CircleGoOn = True
    bDrawCircle = True
    
    'Do While (IIf(Abs(StartAngle - EndAngle) > 2 * Pi, Abs(StartAngle - EndAngle) - 2 * Pi, Abs(StartAngle - EndAngle)) >= Abs(perAngle))
    Do While (Abs(StartAngle - EndAngle) >= Abs(perAngle))
        Do While (Not CircleGoOn)
            DoEvents
        Loop
        sX0 = sX1
        sY0 = sY1
        
        StartAngle = StartAngle + perAngle
        sX1 = Abs(Rc) * Cos(StartAngle) + Xc
        sY1 = Abs(Rc) * Sin(StartAngle) + Yc
        
        dX01 = sX1
        dY01 = sY1
        SendLineSignal sX0, sY0, sX1, sY1
    Loop
    
    If (Abs(StartAngle - EndAngle) < Abs(perAngle)) And (Abs(StartAngle - EndAngle) > 0) Then
        dX01 = sX1
        dY01 = sY1
        StopGoOnCmd.Enabled = False
        SendLineSignal sX1, sY1, X1, Y1
    End If
    CircleGoOn = False
    bDrawCircle = False
    X0 = X1
    Y0 = Y1
    StopGoOnCmd.Enabled = False
    
'    LblXPos.Caption = Format(X0, "###0.0")
'    LblYPos.Caption = Format(Y0, "###0.0")
End Function

'Public Function calcuInterval(dX0 As Double, dY0 As Double, dX1 As Double, dY1 As Double, dR As Double, iDirect As Integer) As Long
'    Dim LenOfArc As Double
'    Dim dxDistance As Double
'    Dim dyDistance As Double
'    Dim lInterval As Long
'    Dim lTime As Long
'    Dim pDistance As Double
'    Dim vDistance As Double
'
'    LenOfArc = 0
'    dxDistance = 0
'    dyDistance = 0
'
'    pDistance = Sqr((dX1 - dX0) * (dX1 - dX0) + (dY1 - dY0) * (dY1 - dY0)) / 2
'    vDistance = Sqr(dR * dR - pDistance * pDistance)
'
'    If (dX0 >= 0 And dY0 >= 0) And (dX1 >= 0 And dY1 >= 0) And (iDirect = 1) Then
'        LenOfArc = Atn(pDistance / vDistance) * 2 * dR
'
'        dxDistance = Abs(dX1 - dX0)
'        dyDistance = Abs(dY1 - dY0)
'
'        lTime = CLng(LenOfArc / F)
'        lInterval = 1000 * lTime / (Abs(dxDistance / Ax) + Abs(dyDistance / Ay))
'        calcuInterval = lInterval
''        lInterval = Abs(dxDistance / Ax) + Abs(dyDistance / Ay)
'    Else
'        If (dX0 >= 0 And dY0 >= 0) And (dX1 >= 0 And dY1 >= 0) And (iDirect = 2) Then
'            LenOfArc = 2 * Pi * dR - Atn(pDistance / vDistance) * 2 * dR
'
'            dxDistance = 3 * dR + dX0 + dX1
'            dyDistance = 3 * dR + dY0 + dY1
'
'            lTime = CLng(LenOfArc / F)
'            lInterval = 1000 * lTime / (Abs(dxDistance / Ax) + Abs(dyDistance / Ay))
'            calcuInterval = lInterval
'
'        Else
'            If (dX0 >= 0 And dY0 >= 0) And (dX1 >= 0 And dY1 < 0) And (iDirect = 1) Then
'                LenOfArc = Atn(pDistance / vDistance) * 2 * dR
'
'                dxDistance = Abs(dX0 + dX1)
'                dyDistance = Abs(dY1 - dY0)
'
'                lTime = CLng(LenOfArc / F)
'                lInterval = 1000 * lTime / (Abs(dxDistance / Ax) + Abs(dyDistance / Ay))
'                calcuInterval = lInterval
'            Else
'                If (dX0 >= 0 And dY0 >= 0) And (dX1 >= 0 And dY1 < 0) And (iDirect = 2) Then
'                    LenOfArc = 2 * Pi * dR - Atn(pDistance / vDistance) * 2 * dR
'
'                    dxDistance = 2 * dR + dX0 + dX1
'                    dyDistance = 4 * dR - dY0 + dY1
'
'                    lTime = CLng(LenOfArc / F)
'                    lInterval = 1000 * lTime / (Abs(dxDistance / Ax) + Abs(dyDistance / Ay))
'                    calcuInterval = lInterval
'                Else
'                    If (dX0 >= 0 And dY0 >= 0) And (dX1 < 0 And dY1 >= 0) And (iDirect = 1) Then
'                        LenOfArc = 2 * Pi * dR - Atn(pDistance / vDistance) * 2 * dR
'
'                        dxDistance = 4 * dR - dX0 + dX1
'                        dyDistance = 2 * dR + dY0 + dY1
'
'                        lTime = CLng(LenOfArc / F)
'                        lInterval = 1000 * lTime / (Abs(dxDistance / Ax) + Abs(dyDistance / Ay))
'                        calcuInterval = lInterval
'                    Else
'                        If (dX0 >= 0 And dY0 >= 0) And (dX1 < 0 And dY1 >= 0) And (iDirect = 2) Then
'                            LenOfArc = Atn(pDistance / vDistance) * 2 * dR
'
'                            dxDistance = Abs(dX0 - dX1)
'                            dyDistance = Abs(dY0 - dY1)
'
'                            lTime = CLng(LenOfArc / F)
'                            lInterval = 1000 * lTime / (Abs(dxDistance / Ax) + Abs(dyDistance / Ay))
'                            calcuInterval = lInterval
'                        Else
'                            If (dX0 >= 0 And dY0 >= 0) And (dX1 < 0 And dY1 < 0) And (iDirect = 1) Then
'                                If (dX0 < dY0 And dX1 < dY1) Then
'                                    LenOfArc = 2 * Pi * dR - Atn(pDistance / vDistance) * 2 * dR
'                                Else
'                                    LenOfArc = Atn(pDistance / vDistance) * 2 * dR
'                                End If
'
'                                dxDistance = 2 * dR - dX0 - dX1
'                                dyDistance = 2 * dR + dY0 + dY1
'
'                                lTime = CLng(LenOfArc / F)
'                                lInterval = 1000 * lTime / (Abs(dxDistance / Ax) + Abs(dyDistance / Ay))
'                                calcuInterval = lInterval
'                            Else
'                                If (dX0 >= 0 And dY0 >= 0) And (dX1 < 0 And dY1 < 0) And (iDirect = 2) Then
'                                    If (dX0 < dY0 And dX1 < dY1) Then
'                                        LenOfArc = Atn(pDistance / vDistance) * 2 * dR
'                                    Else
'                                        LenOfArc = 2 * Pi * dR - Atn(pDistance / vDistance) * 2 * dR
'                                    End If