VERSION 5.00
Begin VB.Form frmHand 
   Caption         =   "Form1"
   ClientHeight    =   1020
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   3615
   LinkTopic       =   "Form1"
   ScaleHeight     =   1020
   ScaleWidth      =   3615
   StartUpPosition =   3  'Windows �̊���l
   Begin VB.CommandButton cmdConnect 
      Caption         =   "Connect"
      Height          =   615
      Left            =   240
      TabIndex        =   1
      Top             =   240
      Width           =   1455
   End
   Begin VB.CommandButton cmdExecute 
      Caption         =   "Execute"
      Height          =   615
      Left            =   1920
      TabIndex        =   0
      Top             =   240
      Width           =   1335
   End
End
Attribute VB_Name = "frmHand"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal sec As Long)
Private Const MOTOR_ON As Boolean = True
Private Const MOTOR_OFF As Boolean = False

Dim m_caoEng  As CaoEngine
Dim m_caoCtrl As CaoController
Attribute m_caoCtrl.VB_VarHelpID = -1
Dim m_caoExt  As CaoExtension
Dim m_caoErrorCode As CaoVariable
Dim m_caoErrorDescription As CaoVariable

'----------------------------------------------------------
' cmdConnect
'----------------------------------------------------------
Private Sub cmdConnect_Click()
    If cmdConnect.Caption = "Connect" Then
        Connect
    Else
        DisConnect
    End If
End Sub

'----------------------------------------------------------
' cmdExecute
'----------------------------------------------------------
Private Sub cmdExecute_Click()

    On Error GoTo ErrProc
    
    'Motor on
    If Not ExecMotor(MOTOR_ON) Then
        Exit Sub
    End If
    
    'Org Command
    If Not ExecOrg Then
        Exit Sub
    End If

    'Chuck Command
    If Not ExecChuck(0) Then
        Exit Sub
    End If
    
    'UnChuck Command
    If Not ExecUnChuck(1) Then
        Exit Sub
    End If

    'MoveA Command
    If Not ExecMoveA(4.5, 20) Then
        Exit Sub
    End If
    
    'MoveA Command
    If Not ExecMoveA(0, 50) Then
        Exit Sub
    End If

    Exit Sub
    
ErrProc:
    MsgBox "Failed to Execute"

End Sub

' -------------------------------Form-----------------------------------------------------
Private Sub Form_Load()
    
    ' Create CaoEngine
    Set m_caoEng = New CaoEngine
    
    cmdExecute.Enabled = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    ' DisConnect
    If cmdConnect.Caption = "DisConnect" Then
        DisConnect
    End If
    
   ' Erase CaoEngine
    Set m_caoEng = Nothing
    
End Sub

' -------------------------------RC8 Provider-----------------------------------------------------

'----------------------------------------------------------
' Connect RC8 Provider
'----------------------------------------------------------
Private Sub Connect()
   
    On Error GoTo ErrProc

    Set m_caoCtrl = m_caoEng.Workspaces(0).AddController("RC8", "caoProv.DENSO.RC8", "", "Server=192.168.0.1")
    Set m_caoExt = m_caoCtrl.AddExtension("Hand0")                          'Set Hand0
    Set m_caoErrorCode = m_caoCtrl.AddVariable("@ERROR_CODE")               'Set Error Number
    Set m_caoErrorDescription = m_caoCtrl.AddVariable("@ERROR_DESCRIPTION") 'Set Error Description

    cmdConnect.Caption = "DisConnect"
    cmdExecute.Enabled = True
    
    Exit Sub
    
ErrProc:
    DisConnect
    MsgBox "Failed to Connect"
        
End Sub

'----------------------------------------------------------
' DisConnect RC8 Provider
'----------------------------------------------------------
Private Sub DisConnect()

    On Error GoTo ErrProc
    
    If Not (m_caoExt Is Nothing) Then
        m_caoCtrl.Extensions.Remove m_caoExt.Index
    End If
    
    If Not (m_caoErrorCode Is Nothing) Then
        m_caoCtrl.Variables.Remove m_caoErrorCode.Index
    End If
    
    If Not (m_caoErrorDescription Is Nothing) Then
        m_caoCtrl.Variables.Remove m_caoErrorDescription.Index
    End If

    If Not (m_caoCtrl Is Nothing) Then
        m_caoEng.Workspaces(0).Controllers.Remove m_caoCtrl.Index
    End If
    
    Set m_caoCtrl = Nothing
    
    cmdConnect.Caption = "Connect"
    cmdExecute.Enabled = False
    
    Exit Sub

ErrProc:
    MsgBox Err.Description
        
End Sub

'----------------------------------------------------------
' Execute motor turn On/Off
' @param:   blFlg (ON:True OFF:False)
' @ret:     SUCCEED(TRUE)/FAIL(FALSE)
'----------------------------------------------------------
Private Function ExecMotor(ByVal blFlg As Boolean) As Boolean
    
    On Error GoTo ErrProc
    
    ExecMotor = False
    
    If Not CheckError Then
        Exit Function
    End If
    
   m_caoExt.Execute "Motor", blFlg
    
    WaitExec
    
    If Not CheckError Then
        Exit Function
    End If
    
    ExecMotor = True
    
    Exit Function
    
ErrProc:
    MsgBox Err.Description

End Function

'----------------------------------------------------------
' In the first execution, calculate an origin then return to origin.
' From the second time, return to origin.
' @ret:     SUCCEED(TRUE)/FAIL(FALSE)
'----------------------------------------------------------
Private Function ExecOrg() As Boolean
    
    On Error GoTo ErrProc
    
    ExecOrg = False
    
    If Not CheckError Then
        Exit Function
    End If
    
   m_caoExt.Execute "Org"
    
    WaitExec
    
    If Not CheckError Then
        Exit Function
    End If
    
    ExecOrg = True
    
    Exit Function
    
ErrProc:
    MsgBox Err.Description

End Function

'----------------------------------------------------------
' Execute Chuck Command
' @param:   lPointNo (Point Data)
' @ret:     SUCCEED(TRUE)/FAIL(FALSE)
'----------------------------------------------------------
Private Function ExecChuck(ByVal lPointNo As Long) As Boolean
    
    On Error GoTo ErrProc
    
    ExecChuck = False
    
    If Not CheckError Then
        Exit Function
    End If
    
    m_caoExt.Execute "Chuck", lPointNo
    
    WaitExec
    
    If Not CheckError Then
        Exit Function
    End If
    
    ExecChuck = True
    
    Exit Function
    
ErrProc:
    MsgBox Err.Description

End Function

'----------------------------------------------------------
' Execute UnChuck Command
' @param:   lPointNo (Point)
' @ret:     SUCCEED(TRUE)/FAIL(FALSE)
'----------------------------------------------------------
Private Function ExecUnChuck(ByVal lPointNo As Long) As Boolean
    
    On Error GoTo ErrProc
    
    ExecUnChuck = False
    
    If Not CheckError Then
        Exit Function
    End If
    
    m_caoExt.Execute "UnChuck", lPointNo
    
    WaitExec
    
    If Not CheckError Then
        Exit Function
    End If
    
    ExecUnChuck = True
    
    Exit Function
    
ErrProc:
    MsgBox Err.Description

End Function

'----------------------------------------------------------
' To move to an absolute position.
' @param:   SMvLen (Position[mm])
' @param:   lSpeed (Speed[%])
' @ret:     SUCCEED(TRUE)/FAIL(FALSE)
'----------------------------------------------------------
Private Function ExecMoveA(ByVal sMvLen As Single, ByVal lSpeed As Long) As Boolean
    
    On Error GoTo ErrProc
    
    ExecMoveA = False
    
    If Not CheckError Then
        Exit Function
    End If
    
   m_caoExt.Execute "MoveA", Array(sMvLen, lSpeed)
    
    WaitExec
    
    If Not CheckError Then
        Exit Function
    End If
    
    ExecMoveA = True
    
    Exit Function
    
ErrProc:
    MsgBox Err.Description

End Function

'----------------------------------------------------------
' Command synchronous processing
'----------------------------------------------------------
Private Sub WaitExec()
    On Error GoTo ErrProc
    
    Do
      Sleep 10
      DoEvents
    Loop While m_caoExt.Execute("get_BusyState")
    
    Exit Sub
    
ErrProc:
    MsgBox Err.Description
    
End Sub

'----------------------------------------------------------
' Check RC8 Error
' @ret: SUCCEED(TRUE)/FAIL(FALSE)
'----------------------------------------------------------
Private Function CheckError() As Boolean
    
    On Error GoTo ErrProc
    
    Dim lErrorCode As Long
    
    CheckError = False
    
    lErrorCode = m_caoErrorCode.Value
    If lErrorCode <> 0 Then
        GoTo ErrRC8
    End If
    
    CheckError = True
    
    Exit Function
    
ErrRC8:
    MsgBox "ErrorCode�F0x" & CStr(Hex(lErrorCode)) & vbNewLine & m_caoErrorDescription.Value
    Exit Function

ErrProc:
    MsgBox Err.Description
    
End Function