VERSION 5.00
Begin VB.Form frmSample 
   Caption         =   "Sample"
   ClientHeight    =   5535
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5700
   LinkTopic       =   "Form1"
   ScaleHeight     =   5535
   ScaleWidth      =   5700
   StartUpPosition =   3  'Windows の既定値
   Begin VB.TextBox txtResult 
      Enabled         =   0   'False
      Height          =   270
      Left            =   120
      TabIndex        =   28
      Top             =   5160
      Width           =   5415
   End
   Begin VB.Frame Frame1 
      Caption         =   "データ"
      Height          =   1215
      Left            =   120
      TabIndex        =   18
      Top             =   3480
      Width           =   5415
      Begin VB.TextBox txtData 
         Height          =   270
         Left            =   2400
         TabIndex        =   34
         Text            =   "256,256,1,34464"
         Top             =   780
         Width           =   1575
      End
      Begin VB.CommandButton cmdDataWrite 
         Caption         =   "Write(0x10)"
         Height          =   375
         Left            =   4200
         TabIndex        =   32
         Top             =   720
         Width           =   1095
      End
      Begin VB.TextBox txtDataStart 
         Alignment       =   1  '右揃え
         Height          =   270
         Index           =   1
         Left            =   960
         TabIndex        =   30
         Text            =   "0"
         Top             =   780
         Width           =   615
      End
      Begin VB.TextBox txtDataCnt 
         Alignment       =   1  '右揃え
         Height          =   270
         Left            =   2400
         TabIndex        =   21
         Text            =   "4"
         Top             =   300
         Width           =   615
      End
      Begin VB.TextBox txtDataStart 
         Alignment       =   1  '右揃え
         Height          =   270
         Index           =   0
         Left            =   960
         TabIndex        =   20
         Text            =   "0"
         Top             =   300
         Width           =   615
      End
      Begin VB.CommandButton cmdDataRead 
         Caption         =   "Read(0x03)"
         Height          =   375
         Left            =   4200
         TabIndex        =   19
         Top             =   240
         Width           =   1095
      End
      Begin VB.Label Label12 
         AutoSize        =   -1  'True
         Caption         =   "データ"
         Height          =   180
         Left            =   1800
         TabIndex        =   33
         Top             =   840
         Width           =   495
      End
      Begin VB.Label Label11 
         AutoSize        =   -1  'True
         Caption         =   "開始番号"
         Height          =   180
         Left            =   120
         TabIndex        =   31
         Top             =   840
         Width           =   720
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "点数"
         Height          =   180
         Left            =   1920
         TabIndex        =   23
         Top             =   360
         Width           =   360
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "開始番号"
         Height          =   180
         Left            =   120
         TabIndex        =   22
         Top             =   360
         Width           =   720
      End
   End
   Begin VB.Frame YPoint 
      Caption         =   "Y接点"
      Height          =   1215
      Left            =   120
      TabIndex        =   11
      Top             =   2160
      Width           =   5415
      Begin VB.ComboBox cmbYSwitch 
         Height          =   300
         Left            =   2400
         TabIndex        =   29
         Top             =   780
         Width           =   735
      End
      Begin VB.TextBox txtYStart 
         Alignment       =   1  '右揃え
         Height          =   270
         Index           =   1
         Left            =   960
         TabIndex        =   25
         Text            =   "16"
         Top             =   780
         Width           =   615
      End
      Begin VB.CommandButton cmdYWrite 
         Caption         =   "Write(0x05)"
         Height          =   375
         Left            =   4200
         TabIndex        =   24
         Top             =   720
         Width           =   1095
      End
      Begin VB.CommandButton cmdYRead 
         Caption         =   "Read(0x01)"
         Height          =   375
         Left            =   4200
         TabIndex        =   17
         Top             =   240
         Width           =   1095
      End
      Begin VB.TextBox txtYStart 
         Alignment       =   1  '右揃え
         Height          =   270
         Index           =   0
         Left            =   960
         TabIndex        =   13
         Text            =   "0"
         Top             =   300
         Width           =   615
      End
      Begin VB.TextBox txtYCnt 
         Alignment       =   1  '右揃え
         Height          =   270
         Left            =   2400
         TabIndex        =   12
         Text            =   "4"
         Top             =   300
         Width           =   615
      End
      Begin VB.Label Label10 
         AutoSize        =   -1  'True
         Caption         =   "On/Off"
         Height          =   180
         Left            =   1800
         TabIndex        =   27
         Top             =   840
         Width           =   540
      End
      Begin VB.Label Label9 
         AutoSize        =   -1  'True
         Caption         =   "開始番号"
         Height          =   180
         Left            =   120
         TabIndex        =   26
         Top             =   840
         Width           =   720
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         Caption         =   "開始番号"
         Height          =   180
         Left            =   120
         TabIndex        =   15
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "点数"
         Height          =   180
         Left            =   1920
         TabIndex        =   14
         Top             =   360
         Width           =   360
      End
   End
   Begin VB.Frame XPoint 
      Caption         =   "X接点"
      Height          =   735
      Left            =   120
      TabIndex        =   6
      Top             =   1320
      Width           =   5415
      Begin VB.CommandButton cmdXRead 
         Caption         =   "Read(0x02)"
         Height          =   375
         Left            =   4200
         TabIndex        =   16
         Top             =   240
         Width           =   1095
      End
      Begin VB.TextBox txtXcnt 
         Alignment       =   1  '右揃え
         Height          =   270
         Left            =   2400
         TabIndex        =   10
         Text            =   "4"
         Top             =   300
         Width           =   615
      End
      Begin VB.TextBox txtXStart 
         Alignment       =   1  '右揃え
         Height          =   270
         Left            =   960
         TabIndex        =   9
         Text            =   "0"
         Top             =   300
         Width           =   615
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "点数"
         Height          =   180
         Left            =   1920
         TabIndex        =   8
         Top             =   360
         Width           =   360
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "開始番号"
         Height          =   180
         Left            =   120
         TabIndex        =   7
         Top             =   360
         Width           =   720
      End
   End
   Begin VB.TextBox txtSlaveId 
      Alignment       =   1  '右揃え
      Height          =   270
      Left            =   1320
      TabIndex        =   5
      Text            =   "1"
      Top             =   780
      Width           =   495
   End
   Begin VB.ComboBox cmbParameter 
      Height          =   300
      ItemData        =   "frmSample.frx":0000
      Left            =   1320
      List            =   "frmSample.frx":0002
      TabIndex        =   3
      Top             =   300
      Width           =   2535
   End
   Begin VB.CommandButton cmdDisconnect 
      Caption         =   "Disconnect"
      Height          =   375
      Left            =   4080
      TabIndex        =   1
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "Connect"
      Height          =   375
      Left            =   4080
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label Label13 
      Caption         =   "結果"
      Height          =   255
      Left            =   120
      TabIndex        =   35
      Top             =   4920
      Width           =   1335
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "SlaveID:"
      Height          =   180
      Left            =   480
      TabIndex        =   4
      Top             =   840
      Width           =   615
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Controller:"
      Height          =   180
      Left            =   360
      TabIndex        =   2
      Top             =   360
      Width           =   780
   End
End
Attribute VB_Name = "frmSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_caoEng As CaoEngine
Private m_caoCtrls As CaoControllers
Private m_caoCtrl As CaoController

' RacData
Private m_RacRes As New RacRes

'起動時処理
Private Sub Form_Load()

    With cmbParameter
        .Clear
        .AddItem "com:1:9600:N:8:1:0"
        .ListIndex = 0
    End With

    txtSlaveId.Text = 1

    With cmbYSwitch
        .Clear
        .AddItem "On"
        .AddItem "Off"
        .ListIndex = 0
    End With

    cmdConnect.Enabled = True
    cmdDisconnect.Enabled = False

    Set m_caoEng = New CaoEngine
    Set m_caoCtrls = m_caoEng.Workspaces(0).Controllers
    
    EnableControl False

End Sub

'終了処理
Private Sub Form_Unload(Cancel As Integer)

    If Not m_caoCtrl Is Nothing Then
        m_caoCtrls.Remove m_caoCtrl.Index
        Set m_caoCtrl = Nothing
    End If

End Sub

'接続
Private Sub cmdConnect_Click()
    
    On Error GoTo ErrProc
    
    Dim sConn As String
    
    '動作中であれば切断
    cmdDisconnect_Click
    
    sConn = "Conn=" & cmbParameter.Text
    
    'Controll生成
    Set m_caoCtrl = m_caoCtrls.Add("SMC", "CaoProv.Modbus", "", sConn)
        
    cmdConnect.Enabled = False
    EnableControl True
    
    Exit Sub
ErrProc:
    MsgBox Err.Description
End Sub

'切断
Private Sub cmdDisconnect_Click()

    If Not m_caoCtrl Is Nothing Then
        m_caoCtrls.Remove m_caoCtrl.Index
        Set m_caoCtrl = Nothing
    End If
    
    'コントロール使用可/不可
    cmdConnect.Enabled = True
    EnableControl False

End Sub

'データ書込(0x10)
Private Sub cmdDataWrite_Click()
    
    On Error GoTo ErrProc
    
    Dim vntRet As Variant
    
    'データ部構築
    Dim vntArg As Variant
    vntArg = Array(CInt(txtSlaveId), CInt(txtDataStart(1).Text), Split(txtData.Text, ","))
    
    'コマンド実行
    vntRet = m_caoCtrl.Execute("PresetMultipleRegisters", vntArg)
    
    '結果表示
    txtResult.Text = ChangeValueFormat(vntRet)
    
    Exit Sub
ErrProc:
    MsgBox Err.Description
    
End Sub

'入力信号読出(0x02)
Private Sub cmdXRead_Click()

    On Error GoTo ErrProc
    
    Dim vntRet As Variant
    'コマンド実行
    vntRet = m_caoCtrl.Execute("ReadInputStatus", _
        Array(CInt(txtSlaveId.Text), CInt(txtXStart.Text), CInt(txtXcnt.Text)))
    '結果表示
    txtResult.Text = ChangeValueFormat(vntRet)

    Exit Sub
ErrProc:
    MsgBox Err.Description

End Sub

'出力信号読出(0x01)
Private Sub cmdYRead_Click()

    On Error GoTo ErrProc
    
    Dim vntRet As Variant
    'コマンド実行
    vntRet = m_caoCtrl.Execute("ReadCoilStatus", _
        Array(CInt(txtSlaveId.Text), CInt(txtYStart(0).Text), CInt(txtYCnt.Text)))
    '結果表示
    txtResult.Text = ChangeValueFormat(vntRet)

    Exit Sub
ErrProc:
    MsgBox Err.Description

End Sub

'データ読出(0x03)
Private Sub cmdDataRead_Click()

    On Error GoTo ErrProc
    
    Dim vntRet As Variant
    'コマンド実行
    vntRet = m_caoCtrl.Execute("ReadHoldingRegister", _
        Array(CInt(txtSlaveId.Text), CInt(txtDataStart(0).Text), CInt(txtDataCnt.Text)))
    '結果表示
    txtResult.Text = ChangeValueFormat(vntRet)

    Exit Sub
ErrProc:
    MsgBox Err.Description

End Sub

'強制信号出力(0x05)
Private Sub cmdYWrite_Click()

    On Error GoTo ErrProc
    
    Dim vntRet As Variant
    Dim iSwitch As Integer
    
    'ON、OFFを数値に変換
    If cmbYSwitch.ListIndex = 0 Then
        iSwitch = &HFF00
    Else
        iSwitch = &H0
    End If
    'コマンド実行
    vntRet = m_caoCtrl.Execute("ForceSingleCoil", _
        Array(CInt(txtSlaveId.Text), CInt(txtYStart(1).Text), iSwitch))
    '結果を表示
    txtResult.Text = ChangeValueFormat(vntRet)

    Exit Sub
ErrProc:
    MsgBox Err.Description

End Sub

'結果を文字列に変換
Public Function ChangeValueFormat(vntVal As Variant) As String
    
    Dim strResVal As String
    Dim strVal As String
    Dim strSymbol As String
    Dim vt As Integer

    On Error GoTo ErrConv

    vt = VarType(vntVal)
    Select Case vt
    Case vbEmpty
        ChangeValueFormat = "(EMPTY)"
        Exit Function
    Case vbNull
        ChangeValueFormat = "(NULL)"
        Exit Function
    End Select
    
    ' Variant to BSTR
    strResVal = m_RacRes.BstrFromVariant(vntVal)
    
    If vt > vbArray Then
        ' 配列の場合は頭に"ARRAY"を付加
        vt = vt - vbArray
        strSymbol = " (ARRAY | "
    Else
        strSymbol = " ("
    End If
    
    Select Case vt
    Case vbEmpty
        strVal = "EMPTY)"
    Case vbNull
        strVal = "NULL)"
    Case vbBoolean
        strVal = "BOOL)"
    Case vbByte, 16
        strVal = "UI1)"
    Case vbInteger
        strVal = "I2)"
    Case 18
        strVal = "UI2)"
    Case vbLong
        strVal = "I4)"
    Case 19
        strVal = "UI4)"
    Case vbSingle
        strVal = "R4)"
    Case vbDouble
        strVal = "R8)"
    Case vbCurrency
        strVal = "CY)"
    Case vbDate
        strVal = "DATE)"
    Case vbString
        strVal = "BSTR)"
    Case vbVariant
        strVal = "VARIANT)"
    Case Else
        strVal = "?)"
    End Select

    ChangeValueFormat = Mid(strResVal, InStr(strResVal, ",") + 1) & strSymbol & strVal

    Exit Function
ErrConv:
    ChangeValueFormat = "(Unknown)"
    
End Function

'コントロールの使用可/不可の切り替え
Private Sub EnableControl(ByVal bEnable As Boolean)

    txtSlaveId.Enabled = bEnable
    cmdDisconnect.Enabled = bEnable
    txtXStart.Enabled = bEnable
    txtXcnt.Enabled = bEnable
    cmdXRead.Enabled = bEnable
    txtYStart(0).Enabled = bEnable
    txtYCnt.Enabled = bEnable
    cmdYRead.Enabled = bEnable
    txtYStart(1).Enabled = bEnable
    cmbYSwitch.Enabled = bEnable
    cmdYWrite.Enabled = bEnable
    txtDataStart(0).Enabled = bEnable
    txtDataCnt.Enabled = bEnable
    cmdDataRead.Enabled = bEnable
    txtDataStart(1).Enabled = bEnable
    txtData.Enabled = bEnable
    cmdDataWrite.Enabled = bEnable
    
End Sub