VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Begin VB.Form frmInfo BorderStyle = 1 '固定(実線) Caption = "NetwoRC" ClientHeight = 6300 ClientLeft = 45 ClientTop = 330 ClientWidth = 1725 Icon = "Info.frx":0000 MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6300 ScaleWidth = 1725 StartUpPosition = 3 'Windows の既定値 Begin VB.Frame fraInfo Height = 4575 Left = 30 TabIndex = 3 Top = 960 Width = 1695 Begin VB.PictureBox picErr Appearance = 0 'ﾌﾗｯﾄ BackColor = &H80000005& ForeColor = &H80000008& Height = 555 Left = 0 Picture = "Info.frx":5AEE ScaleHeight = 525 ScaleWidth = 495 TabIndex = 28 Top = 3960 Visible = 0 'False Width = 525 End Begin MSComctlLib.ProgressBar pbrAccel Height = 165 Index = 0 Left = 60 TabIndex = 11 Top = 1920 Width = 1545 _ExtentX = 2725 _ExtentY = 291 _Version = 393216 Appearance = 0 Scrolling = 1 End Begin MSComctlLib.ProgressBar pbrSpeed Height = 165 Index = 0 Left = 60 TabIndex = 8 Top = 1500 Width = 1545 _ExtentX = 2725 _ExtentY = 291 _Version = 393216 Appearance = 0 Scrolling = 1 End Begin MSComctlLib.ProgressBar pbrDecel Height = 165 Index = 0 Left = 60 TabIndex = 14 Top = 2340 Width = 1545 _ExtentX = 2725 _ExtentY = 291 _Version = 393216 Appearance = 0 Scrolling = 1 End Begin MSComctlLib.ProgressBar pbrSpeed Height = 165 Index = 1 Left = 60 TabIndex = 17 Top = 2850 Width = 1545 _ExtentX = 2725 _ExtentY = 291 _Version = 393216 Appearance = 0 Scrolling = 1 End Begin MSComctlLib.ProgressBar pbrAccel Height = 165 Index = 1 Left = 60 TabIndex = 20 Top = 3270 Width = 1545 _ExtentX = 2725 _ExtentY = 291 _Version = 393216 Appearance = 0 Scrolling = 1 End Begin MSComctlLib.ProgressBar pbrDecel Height = 165 Index = 1 Left = 60 TabIndex = 23 Top = 3690 Width = 1545 _ExtentX = 2725 _ExtentY = 291 _Version = 393216 Appearance = 0 Scrolling = 1 End Begin VB.Label lblErr Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BackStyle = 0 '透明 Caption = "ERROR FFFF " BeginProperty Font Name = "Arial" Size = 11.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 555 Left = 540 TabIndex = 27 Top = 3960 Width = 1065 End Begin VB.Label lblWork Alignment = 2 '中央揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "WORK 0" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Left = 0 TabIndex = 26 Top = 720 Width = 1635 End Begin VB.Label lblTool Alignment = 2 '中央揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "TOOL 0" BeginProperty Font Name = "Arial" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Left = 0 TabIndex = 25 Top = 960 Width = 1635 End Begin VB.Label lblStatic Appearance = 0 'ﾌﾗｯﾄ AutoSize = -1 'True BackColor = &H80000005& BackStyle = 0 '透明 Caption = "EXT-DECEL" ForeColor = &H80000008& Height = 180 Index = 5 Left = 60 TabIndex = 24 Top = 3510 Width = 945 End Begin VB.Label lblDecel Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "100%" ForeColor = &H80000008& Height = 435 Index = 1 Left = 0 TabIndex = 22 Top = 3480 Width = 1635 End Begin VB.Label lblStatic Appearance = 0 'ﾌﾗｯﾄ AutoSize = -1 'True BackColor = &H80000005& BackStyle = 0 '透明 Caption = "EXT-ACCEL" ForeColor = &H80000008& Height = 180 Index = 4 Left = 60 TabIndex = 21 Top = 3090 Width = 960 End Begin VB.Label lblAccel Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "100%" ForeColor = &H80000008& Height = 435 Index = 1 Left = 0 TabIndex = 19 Top = 3060 Width = 1635 End Begin VB.Label lblStatic Appearance = 0 'ﾌﾗｯﾄ AutoSize = -1 'True BackColor = &H80000005& BackStyle = 0 '透明 Caption = "EXT-SPEED" ForeColor = &H80000008& Height = 180 Index = 3 Left = 60 TabIndex = 18 Top = 2670 Width = 945 End Begin VB.Label lblSpeed Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "100%" ForeColor = &H80000008& Height = 435 Index = 1 Left = 0 TabIndex = 16 Top = 2640 Width = 1635 End Begin VB.Label lblStatic Appearance = 0 'ﾌﾗｯﾄ AutoSize = -1 'True BackColor = &H80000005& BackStyle = 0 '透明 Caption = "DECEL" ForeColor = &H80000008& Height = 180 Index = 2 Left = 60 TabIndex = 15 Top = 2160 Width = 540 End Begin VB.Label lblDecel Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "100%" ForeColor = &H80000008& Height = 435 Index = 0 Left = 0 TabIndex = 13 Top = 2130 Width = 1635 End Begin VB.Label lblStatic Appearance = 0 'ﾌﾗｯﾄ AutoSize = -1 'True BackColor = &H80000005& BackStyle = 0 '透明 Caption = "ACCEL" ForeColor = &H80000008& Height = 180 Index = 1 Left = 60 TabIndex = 12 Top = 1740 Width = 555 End Begin VB.Label lblAccel Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "100%" ForeColor = &H80000008& Height = 435 Index = 0 Left = 0 TabIndex = 10 Top = 1710 Width = 1635 End Begin VB.Label lblStatic Appearance = 0 'ﾌﾗｯﾄ AutoSize = -1 'True BackColor = &H80000005& BackStyle = 0 '透明 Caption = "SPEED" ForeColor = &H80000008& Height = 180 Index = 0 Left = 60 TabIndex = 9 Top = 1320 Width = 540 End Begin VB.Label lblSpeed Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 Caption = "100%" ForeColor = &H80000008& Height = 435 Index = 0 Left = 0 TabIndex = 7 Top = 1290 Width = 1635 End Begin VB.Label lblAuto Alignment = 2 '中央揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H0000FFFF& BorderStyle = 1 '実線 Caption = "AUTO MODE" ForeColor = &H80000008& Height = 255 Left = 30 TabIndex = 6 Top = 150 Width = 1065 End Begin VB.Label lblMotor Alignment = 2 '中央揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H0000FF00& BorderStyle = 1 '実線 Caption = "MOTOR ON" ForeColor = &H80000008& Height = 255 Left = 30 TabIndex = 5 Top = 390 Width = 1065 End Begin VB.Label lblEMG Alignment = 2 '中央揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00404040& BackStyle = 0 '透明 Caption = "EMG STOP" ForeColor = &H80000008& Height = 435 Left = 1080 TabIndex = 4 Top = 240 Width = 705 End Begin VB.Shape shpEMG BackColor = &H000000FF& BackStyle = 1 '不透明 BorderWidth = 2 Height = 555 Left = 1080 Shape = 3 '円 Top = 120 Width = 645 End Begin VB.Label lblErrBk Alignment = 1 '右揃え Appearance = 0 'ﾌﾗｯﾄ BackColor = &H00FFFFFF& BorderStyle = 1 '実線 BeginProperty Font Name = "Arial" Size = 11.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 555 Left = 0 TabIndex = 30 Top = 3960 Width = 1635 End End Begin VB.Frame fraConn Caption = "Connection" Height = 945 Left = 30 TabIndex = 0 Top = 30 Width = 1695 Begin VB.Timer tmRefresh Interval = 200 Left = 90 Top = 90 End Begin VB.CommandButton cmdConnect Caption = "&Connect" Height = 315 Left = 420 TabIndex = 2 Top = 540 Width = 1215 End Begin VB.ComboBox cmbParameter Height = 300 Left = 90 TabIndex = 1 Top = 210 Width = 1575 End Begin VB.Shape shpConn BackColor = &H00808080& BackStyle = 1 '不透明 Height = 315 Left = 60 Top = 540 Width = 345 End End Begin VB.Label lblInfo BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 8.25 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 30 TabIndex = 29 Top = 5550 Width = 1695 End End Attribute VB_Name = "frmInfo" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private caoEng As New CaoEngine Private caoCtrls As CaoControllers Private caoCtrl As CaoController Attribute caoCtrl.VB_VarHelpID = -1 Private Sub cmdConnect_Click() If caoCtrl Is Nothing Then Connect Else Disconnect End If End Sub ' ---------------------------------------------------- Private Sub Form_Load() With cmbParameter .Clear .AddItem "eth:192.168.0.1" ' <- Change this for your controller IP setting. "eth::4112 .AddItem "com:1:38400" ' <- Change this for your controller RS-232C setting. "com:::N:8:1" .ListIndex = 0 End With Disconnect Set caoEng = New CaoEngine Set caoCtrls = caoEng.Workspaces(0).Controllers End Sub ' ---------------------------------------------------- Private Sub Form_Unload(Cancel As Integer) Disconnect Set caoCtrls = Nothing Set caoEng = Nothing End Sub ' ---------------------------------------------------- Private Sub Connect() On Error GoTo ErrProc Dim sConn As String sConn = "Conn=" & cmbParameter.Text Set caoCtrl = caoCtrls.Add("", "CaoProv.DENSO.NetwoRC", "", sConn) With caoCtrl .AddVariable "@EMERGENCY_STOP" .AddVariable "@AUTO_MODE" .AddVariable "@ERROR_CODE" .AddRobot "0" With .Robots("0") .AddVariable "@SERVO_ON" .AddVariable "@CURRENT_TOOL" .AddVariable "@CURRENT_WORK" .AddVariable "@EXTSPEED" .AddVariable "@EXTACCEL" .AddVariable "@EXTDECEL" .AddVariable "@SPEED" .AddVariable "@ACCEL" .AddVariable "@DECEL" End With End With cmdConnect.Caption = "&Disconnect" shpConn.BackColor = &HFF00& tmRefresh.Enabled = True Exit Sub ErrProc: MsgBox LStr(Err.Number) + ":" + Err.Description End Sub ' ---------------------------------------------------- Private Sub Disconnect() tmRefresh.Enabled = False InitInfo If Not caoCtrl Is Nothing Then caoCtrls.Remove caoCtrl.Index Set caoCtrl = Nothing cmdConnect.Caption = "&Connect" End If shpConn.BackColor = &H808080 End Sub Private Sub InitInfo() lblInfo.Caption = "" shpEMG.BackColor = &H404040 lblAuto.BackColor = &H404040 lblMotor.BackColor = &H404040 lblErrBk.BackColor = &HFFFFFF lblErr.Caption = "" picErr.Visible = False lblTool.Caption = "TOOL" lblTool.Tag = -1 lblWork.Caption = "WORK" lblWork.Tag = -1 lblSpeed(0).Caption = "0%": pbrSpeed(0).Value = Val(lblSpeed(0).Caption) lblAccel(0).Caption = "0%": pbrAccel(0).Value = Val(lblAccel(0).Caption) lblDecel(0).Caption = "0%": pbrDecel(0).Value = Val(lblDecel(0).Caption) lblSpeed(1).Caption = "0%": pbrSpeed(1).Value = Val(lblSpeed(1).Caption) lblAccel(1).Caption = "0%": pbrAccel(1).Value = Val(lblAccel(1).Caption) lblDecel(1).Caption = "0%": pbrDecel(1).Value = Val(lblDecel(1).Caption) End Sub Private Sub tmRefresh_Timer() On Error GoTo ErrProc If caoCtrl Is Nothing Then Exit Sub Dim lVal& With caoCtrl shpEMG.BackColor = IIf(.Variables("@EMERGENCY_STOP").Value, &HFF&, &H404040) lblAuto.BackColor = IIf(.Variables("@AUTO_MODE").Value, &HFFFF&, &H404040) lVal = 0 lVal = .Variables("@ERROR_CODE").Value If lVal <> 0 Then If picErr.Visible = False Then lblErr.Caption = "ERROR " + Hex(lVal) picErr.Visible = True lblErrBk.BackColor = &HFF& End If Else If picErr.Visible = True Then lblErr.Caption = "" picErr.Visible = False lblErrBk.BackColor = &HFFFFFF End If End If With .Robots("0") lblMotor.BackColor = IIf(.Variables("@SERVO_ON").Value, &HFF00&, &H404040) lVal = 0 lVal = .Variables("@CURRENT_TOOL").Value If LLng(lblTool.Tag) <> lVal Then lblTool.Caption = "TOOL " + LStr(lVal) lblTool.Tag = lVal End If lVal = 0 lVal = .Variables("@CURRENT_WORK").Value If LLng(lblWork.Tag) <> lVal Then lblWork.Caption = "WORK " + LStr(lVal) lblWork.Tag = lVal End If lVal = 0 lVal = LLng(.Variables("@SPEED").Value) If lVal <> pbrSpeed(0).Value Then lblSpeed(0).Caption = LStr(lVal) + "%": pbrSpeed(0).Value = lVal End If lVal = 0 lVal = LLng(.Variables("@ACCEL").Value) If lVal <> pbrAccel(0).Value Then lblAccel(0).Caption = LStr(lVal) + "%": pbrAccel(0).Value = lVal End If lVal = 0 lVal = LLng(.Variables("@DECEL").Value) If lVal <> pbrDecel(0).Value Then lblDecel(0).Caption = LStr(lVal) + "%": pbrDecel(0).Value = lVal End If lVal = 0 lVal = LLng(.Variables("@EXTSPEED").Value) If lVal <> pbrSpeed(1).Value Then lblSpeed(1).Caption = LStr(lVal) + "%": pbrSpeed(1).Value = lVal End If lVal = 0 lVal = LLng(.Variables("@EXTACCEL").Value) If lVal <> pbrAccel(1).Value Then lblAccel(1).Caption = LStr(lVal) + "%": pbrAccel(1).Value = lVal End If lVal = 0 lVal = LLng(.Variables("@EXTDECEL").Value) If lVal <> pbrDecel(1).Value Then lblDecel(1).Caption = LStr(lVal) + "%": pbrDecel(1).Value = lVal End If End With End With Exit Sub ErrProc: lblInfo.Caption = LStr(Err.Number) + ":" + Err.Description Err.Clear Resume Next End Sub '----------------------------------------------------------- Public Function LLng(ByRef expression) As Long LLng = CLng(Val(expression)) End Function '----------------------------------------------------------------------------- Public Function LInt(ByRef expression) As Integer LInt = CInt(Val(expression)) End Function '----------------------------------------------------------------------------- Public Function LByte(ByRef expression) As Byte LByte = CByte(Val(expression)) End Function '----------------------------------------------------------------------------- Public Function LDbl(ByRef expression) As Double LDbl = CDbl(Val(expression)) End Function '----------------------------------------------------------------------------- Public Function LSng(ByRef expression) As Single LSng = CSng(Val(expression)) End Function '----------------------------------------------------------------------------- Public Function LBool(ByRef expression) As Boolean LBool = CBool(Val(expression)) End Function '----------------------------------------------------------- Public Function LStr(ByRef expression) As String On Error Resume Next LStr = expression LStr = LTrim$(Str(expression)) End Function