VERSION 5.00 Begin VB.Form frmMain BorderStyle = 3 '固定ﾀﾞｲｱﾛｸﾞ Caption = "Joystick Sample" ClientHeight = 5925 ClientLeft = 45 ClientTop = 435 ClientWidth = 3720 Icon = "frmMain.frx":0000 LinkTopic = "Form1" LockControls = -1 'True MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 5925 ScaleWidth = 3720 ShowInTaskbar = 0 'False StartUpPosition = 3 'Windows の既定値 Begin VB.PictureBox picFrame Appearance = 0 'ﾌﾗｯﾄ BorderStyle = 0 'なし ForeColor = &H80000008& Height = 5355 Left = 30 ScaleHeight = 5355 ScaleWidth = 3645 TabIndex = 3 Top = 540 Width = 3645 Begin VB.Frame Frame1 Caption = "Deviation :" Height = 945 Left = 0 TabIndex = 37 Top = 4320 Width = 2685 Begin VB.TextBox txtDeviation Alignment = 1 '右揃え Height = 285 IMEMode = 3 'ｵﾌ固定 Left = 930 TabIndex = 39 Text = "0.1" Top = 570 Width = 765 End Begin VB.CommandButton cmdUpdate Caption = "Set" Height = 285 Left = 1770 TabIndex = 38 Top = 570 Width = 795 End Begin VB.Label Label3 Caption = "mm (deg)" Height = 225 Left = 1800 TabIndex = 43 Top = 270 Width = 735 End Begin VB.Label Label2 Caption = "Value :" Height = 225 Left = 180 TabIndex = 42 Top = 300 Width = 675 End Begin VB.Label Label1 Caption = "Change :" Height = 285 Left = 180 TabIndex = 41 Top = 630 Width = 675 End Begin VB.Label lblDev Alignment = 1 '右揃え BorderStyle = 1 '実線 Caption = "0.1" Height = 285 Left = 930 TabIndex = 40 Top = 240 Width = 735 End End Begin VB.Timer Timer Enabled = 0 'False Interval = 10 Left = 3210 Top = 3900 End Begin VB.Frame fraJoystick Height = 675 Left = 0 TabIndex = 4 Top = -60 Width = 3645 Begin VB.TextBox txtJoystickID Alignment = 2 '中央揃え Height = 315 IMEMode = 3 'ｵﾌ固定 Left = 1920 MaxLength = 2 TabIndex = 6 Text = "1" Top = 210 Width = 675 End Begin VB.CheckBox chkJoystick Caption = "Joystick" Height = 375 Left = 120 TabIndex = 5 Top = 180 Width = 1035 End Begin VB.Shape shpJoystick BorderColor = &H00000000& FillColor = &H00E0E0E0& FillStyle = 0 '塗りつぶし Height = 255 Left = 1170 Top = 240 Width = 255 End Begin VB.Label lblJoystickID Caption = "ID : " Height = 255 Left = 1560 TabIndex = 7 Top = 270 Width = 375 End End Begin VB.ComboBox cmbManualInterporation Height = 300 ItemData = "frmMain.frx":000C Left = 1260 List = "frmMain.frx":0016 Style = 2 'ﾄﾞﾛｯﾌﾟﾀﾞｳﾝ ﾘｽﾄ TabIndex = 8 Top = 690 Width = 2385 End Begin VB.Frame fraManual Height = 3255 Left = 0 TabIndex = 9 Top = 1050 Width = 3645 Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 7 Left = 2370 TabIndex = 33 Top = 2760 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 7 Left = 390 TabIndex = 31 Top = 2760 Width = 855 End Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 6 Left = 2370 TabIndex = 30 Top = 2400 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 6 Left = 390 TabIndex = 28 Top = 2400 Width = 855 End Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 5 Left = 2370 TabIndex = 27 Top = 2040 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 5 Left = 390 TabIndex = 25 Top = 2040 Width = 855 End Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 4 Left = 2370 TabIndex = 24 Top = 1680 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 4 Left = 390 TabIndex = 22 Top = 1680 Width = 855 End Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 3 Left = 2370 TabIndex = 21 Top = 1320 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 3 Left = 390 TabIndex = 19 Top = 1320 Width = 855 End Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 2 Left = 2370 TabIndex = 18 Top = 960 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 2 Left = 390 TabIndex = 16 Top = 960 Width = 855 End Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 1 Left = 2370 TabIndex = 15 Top = 600 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 1 Left = 390 TabIndex = 13 Top = 600 Width = 855 End Begin VB.CommandButton cmdPlus Caption = "+" Height = 315 Index = 0 Left = 2370 TabIndex = 12 Top = 240 Width = 855 End Begin VB.CommandButton cmdMinus Caption = "-" Height = 315 Index = 0 Left = 390 TabIndex = 10 Top = 240 Width = 855 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J8 " Height = 195 Index = 7 Left = 1320 TabIndex = 32 Top = 2820 Width = 915 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J7 " Height = 195 Index = 6 Left = 1350 TabIndex = 29 Top = 2460 Width = 915 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J6 / RZ" Height = 195 Index = 5 Left = 1350 TabIndex = 26 Top = 2100 Width = 915 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J5 / RY" Height = 195 Index = 4 Left = 1350 TabIndex = 23 Top = 1740 Width = 915 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J4 / RX" Height = 195 Index = 3 Left = 1350 TabIndex = 20 Top = 1380 Width = 915 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J3 / Z" Height = 195 Index = 2 Left = 1350 TabIndex = 17 Top = 1020 Width = 915 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J2 / Y" Height = 195 Index = 1 Left = 1350 TabIndex = 14 Top = 660 Width = 915 End Begin VB.Label lblBtn Alignment = 2 '中央揃え Caption = "J1 / X" Height = 195 Index = 0 Left = 1350 TabIndex = 11 Top = 300 Width = 915 End End Begin VB.CommandButton cmdHelp Caption = "?" Height = 315 Left = 3270 TabIndex = 36 Top = 4950 Width = 345 End Begin VB.CheckBox chkInching Caption = "Inching" Height = 285 Left = 2760 TabIndex = 34 Top = 4410 Width = 855 End Begin VB.Label lblMove Alignment = 1 '右揃え BackStyle = 0 '透明 Caption = "Interpolation : " Height = 240 Index = 4 Left = 120 TabIndex = 35 Top = 750 Width = 1125 End End Begin VB.Frame fraConn Height = 555 Left = 30 TabIndex = 0 Top = -60 Width = 3645 Begin VB.ComboBox cboConn Height = 300 Left = 90 TabIndex = 1 Top = 180 Width = 2085 End Begin VB.CommandButton cmdConnect Caption = "&Connect" Height = 285 Left = 2220 TabIndex = 2 Top = 180 Width = 1215 End End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long ' Path Delimiter Private Const PATH_DELIMITER = "\" ' LED Private Const LED_ON = &HFF00& Private Const LED_OFF = &HC0C0C0 ' Cao Object Public m_caoEng As CaoEngine Public m_caoWs As CaoWorkspace Public WithEvents m_caoCtrl As CaoController Attribute m_caoCtrl.VB_VarHelpID = -1 Public m_caoRobo As CaoRobot Private m_CurPose(0 To 1) As CaoVariable '手動操作用変数 Private m_lManualKeys As Long Private m_lManualInterporation As Long Private m_lManualMode As Long Private m_lManualType As Long ' -1:負 1:正 Private m_lManualJoint As Long 'ジョイスティック用 Private WithEvents m_caoJoystickCtrl As CaoController Attribute m_caoJoystickCtrl.VB_VarHelpID = -1 Private m_vMyCurJnt(0 To 7) As Single Private m_vMyCurPos(0 To 6) As Single ' ------------------------------------- Private mcolConnHistory As New Collection Private Const conAppName = "JoyStick" Private Const conSection = "Settings" ' ' IniFile Private m_strIniFileName As String Private m_bInit As Boolean Private m_bInching As Boolean Private m_strDev As String ' Private Sub Form_Load() Set m_caoEng = New CaoEngine Set m_caoWs = m_caoEng.Workspaces(0) ' Read Ini m_strIniFileName = AppPath & "Connect.Ini" LoadHistory m_strDev = txtDeviation.Text lblDev.Caption = m_strDev cmbManualInterporation.ListIndex = 0 ControlEnabled False m_bInit = True End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) SaveHistory End Sub Private Sub Form_Unload(Cancel As Integer) Disconnect Set m_caoRobo = Nothing If Not m_caoCtrl Is Nothing Then m_caoWs.Controllers.Remove (m_caoCtrl.Index) Set m_caoCtrl = Nothing End If Set m_caoWs = Nothing Set m_caoEng = Nothing End Sub Private Sub ControlEnabled(bEnabled As Boolean) Dim i As Long ' Joystick chkJoystick.Enabled = bEnabled txtJoystickID.Enabled = bEnabled ' Interporation cmbManualInterporation.Enabled = bEnabled ' Minus With cmdMinus For i = .LBound To .UBound .Item(i).Enabled = bEnabled Next End With ' Plus With cmdPlus For i = .LBound To .UBound .Item(i).Enabled = bEnabled Next End With ' Deviation txtDeviation.Enabled = bEnabled cmdUpdate.Enabled = bEnabled chkInching.Enabled = bEnabled End Sub ' ---------------------------------------------------- Private Sub cmdConnect_Click() If (m_caoCtrl Is Nothing) Then Connect Else Disconnect End If End Sub ' ---------------------------------------------------- Private Sub Connect() On Error GoTo ErrProc Dim sConn As String sConn = "Conn=eth:" & cboConn.Text & ", Invisible=True, Timeout=800" Set m_caoCtrl = m_caoWs.Controllers.Add("", "CaoProv.DENSO.NetwoRC", "", sConn) With m_caoCtrl Set m_caoRobo = .AddRobot("RC7M") If (m_caoRobo Is Nothing) Then GoTo ErrProc Set m_CurPose(0) = m_caoRobo.AddVariable("@CURRENT_ANGLE") Set m_CurPose(1) = m_caoRobo.AddVariable("@CURRENT_POSITION") ' 現在値を取得 InitCurPos End With cmdConnect.Caption = "&Disconnect" ControlEnabled True AddConnHistory cboConn.Text Exit Sub ErrProc: MsgBox "Failed to Connect." End Sub ' ---------------------------------------------------- Private Sub Disconnect() If Not m_caoCtrl Is Nothing Then m_caoWs.Controllers.Remove m_caoCtrl.Index Set m_caoCtrl = Nothing cmdConnect.Caption = "&Connect" ControlEnabled False End If End Sub Private Sub cmbManualInterporation_Click() ' FormLoadが終わっているか If (m_bInit) Then ' Interporationが変更されたら現在値を再取得 If (m_lManualInterporation <> cmbManualInterporation.ListIndex + 1) Then InitCurPos End If End If End Sub Private Sub cmdHelp_Click() MsgBox "[JOINT]" & vbCrLf & _ " J : Button [] + [<-]/[->]" & vbCrLf & vbCrLf & _ "[X-Y]" & vbCrLf & _ " X: Button [1] + [<-] / [->]" & vbCrLf & _ " Y: Button [2] + [<-] / [->]" & vbCrLf & _ " Z: Button [3] + [<-] / [->]" & vbCrLf & _ " RX: Button [4] + [<-] / [->]" & vbCrLf & _ " RY: Button [5] + [<-] / [->]" & vbCrLf & _ " RZ: Button [6] + [<-] / [->]" End Sub Private Sub chkInching_Click() m_bInching = IIf((chkInching.Value = vbChecked), True, False) End Sub ' Deviation の値チェック Private Sub txtDeviation_Validate(Cancel As Boolean) Dim strVal As String strVal = txtDeviation.Text If Not (IsNumeric(strVal)) Then GoTo ErrCancel txtDeviation.Text = Val(strVal) Exit Sub ErrCancel: Cancel = True End Sub Private Sub cmdUpdate_Click() m_strDev = txtDeviation.Text lblDev.Caption = m_strDev End Sub ' ################## Manual ###################### '手動操作(ボタンのみ)　- [-] ダウン Private Sub cmdMinus_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) ' m_lManualJoint = Index m_lManualType = -1 If (m_bInching) Then Timer_Timer ' 1回ずつ Else Timer.Enabled = True ' Timer起動 End If End Sub '手動操作(ボタンのみ)　- [-] アップ Private Sub cmdMinus_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) ' Timer.Enabled = False End Sub '手動操作(ボタンのみ)　- [+] ダウン Private Sub cmdPlus_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) ' m_lManualJoint = Index m_lManualType = 1 If (m_bInching) Then Timer_Timer ' 1回ずつ Else Timer.Enabled = True ' Timer起動 End If End Sub '手動操作(ボタンのみ)　- [+] アップ Private Sub cmdPlus_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) ' Timer.Enabled = False End Sub ' Joystickのイベント Private Sub m_caoJoystickCtrl_OnMessage(ByVal pICaoMess As CAOLib.ICaoMessage) ' On Error GoTo ErrHandler Static lButtons As Long 'joint = 1, x-y = 2 m_lManualInterporation = cmbManualInterporation.ListIndex + 1 Dim dValue As Double '変化量 Dim lValue As Long '変化量 With pICaoMess Select Case .Number Case 1 '"@BUTTONS" '[8]...[2][1] 各ビットが各ボタン番号に対応する lValue = CLng(.Value) If lValue And &H200 Then 'ボタン10　　　Joint <---> X-Y cmbManualInterporation.ListIndex = IIf(cmbManualInterporation.ListIndex, 0, 1) End If lButtons = lValue Case 2, 3 '"@X","@Y" dValue = CDbl(.Value) 'X = -1.0 〜 +1.0 If .Number = 3 And m_lManualInterporation = 2 Then dValue = -dValue Debug.Print "@X/Y", dValue If dValue = 1 Then '右方向 m_lManualType = 1 If lButtons Then MoveManualCtrl m_lManualType, lButtons ElseIf dValue = -1 Then '左方向 m_lManualType = -1 If lButtons Then MoveManualCtrl m_lManualType, lButtons ElseIf dValue = 0 Then 'それ以外 m_lManualType = 0 '移動なし MoveManualCtrl m_lManualType, lButtons End If Case 6 '"@POV" ' 十字キーの方向 上->右->下->左　= 0 -> 9000 -> 18000 -> 27000 ' 押されていない状態 = 65535 lValue = CLng(.Value) Debug.Print "@POV", lValue If m_lManualInterporation = 2 Then If lValue = 9000 Or lValue = 0 Then '右 or 上 m_lManualType = 1 If lButtons Then MoveManualCtrl m_lManualType, lButtons ElseIf lValue = 27000 Or lValue = 18000 Then '左 or 下 m_lManualType = -1 If lButtons Then MoveManualCtrl m_lManualType, lButtons Else 'それ以外 m_lManualType = 0 MoveManualCtrl m_lManualType, lButtons End If Else If lValue = 9000 Or lValue = 18000 Then '右 or 下 m_lManualType = 1 If lButtons Then MoveManualCtrl m_lManualType, lButtons ElseIf lValue = 27000 Or lValue = 0 Then '左 or 上 m_lManualType = -1 If lButtons Then MoveManualCtrl m_lManualType, lButtons Else 'それ以外 m_lManualType = 0 MoveManualCtrl m_lManualType, lButtons End If End If End Select End With Exit Sub ErrHandler: MsgBox Err.Description End Sub Private Sub MoveManualCtrl(ByVal lDirection&, ByVal lValue&) Dim bMove As Boolean m_lManualInterporation = cmbManualInterporation.ListIndex + 1 bMove = False If lDirection <> 0 Then If lValue And &H1 Then m_lManualJoint = 0 bMove = True ElseIf lValue And &H2 Then m_lManualJoint = 1 bMove = True ElseIf lValue And &H4 Then m_lManualJoint = 2 bMove = True ElseIf lValue And &H8 Then m_lManualJoint = 3 bMove = True ElseIf lValue And &H10 Then m_lManualJoint = 4 bMove = True ElseIf lValue And &H20 Then m_lManualJoint = 5 bMove = True ElseIf lValue And &H40 Then m_lManualJoint = 6 If (m_lManualInterporation <> 2) Then bMove = True ElseIf lValue And &H80 Then m_lManualJoint = 7 If (m_lManualInterporation <> 2) Then bMove = True Else Timer.Enabled = False End If If (bMove) Then If (m_bInching) Then Timer_Timer Else Timer.Enabled = True End If End If Else Timer.Enabled = False End If End Sub 'Joystickの使用/未使用 Private Sub chkJoystick_Click() ' On Error GoTo ErrHandler If chkJoystick.Value = 0 Then If Not m_caoJoystickCtrl Is Nothing Then m_caoWs.Controllers.Remove m_caoJoystickCtrl.Index End If Set m_caoJoystickCtrl = Nothing shpJoystick.FillColor = &HE0E0E0 Else Dim lID As Long lID = Val(txtJoystickID.Text) txtJoystickID.Text = CStr(lID) ' create CAO objects Set m_caoJoystickCtrl = m_caoWs.AddController("JoyCtrl", "CaoProv.DENSO.Joystick", "", "ID=" & CStr(lID)) shpJoystick.FillColor = &HFF00& End If Exit Sub ErrHandler: If Not m_caoJoystickCtrl Is Nothing Then m_caoWs.Controllers.Remove m_caoJoystickCtrl.Index End If Set m_caoJoystickCtrl = Nothing chkJoystick.Value = 0 shpJoystick.FillColor = &HE0E0E0 MsgBox Err.Description End Sub ' 現在値を取得 Private Sub InitCurPos() ' CurrentAngleの位置の取得　P型なので要素数は決めうち m_vMyCurJnt(0) = CSng(m_CurPose(0)(0)) m_vMyCurJnt(1) = CSng(m_CurPose(0)(1)) m_vMyCurJnt(2) = CSng(m_CurPose(0)(2)) m_vMyCurJnt(3) = CSng(m_CurPose(0)(3)) m_vMyCurJnt(4) = CSng(m_CurPose(0)(4)) m_vMyCurJnt(5) = CSng(m_CurPose(0)(5)) m_vMyCurJnt(6) = CSng(m_CurPose(0)(6)) m_vMyCurJnt(7) = CSng(m_CurPose(0)(7)) ' CurrentPositionの位置の取得　P型なので要素数は決めうち m_vMyCurPos(0) = CSng(m_CurPose(1)(0)) m_vMyCurPos(1) = CSng(m_CurPose(1)(1)) m_vMyCurPos(2) = CSng(m_CurPose(1)(2)) m_vMyCurPos(3) = CSng(m_CurPose(1)(3)) m_vMyCurPos(4) = CSng(m_CurPose(1)(4)) m_vMyCurPos(5) = CSng(m_CurPose(1)(5)) m_vMyCurPos(6) = CSng(m_CurPose(1)(6)) End Sub ' ボタンの押し続けで，動作させるための処理 Private Sub Timer_Timer() Dim vCurPose As Variant m_lManualInterporation = cmbManualInterporation.ListIndex + 1 ' 現在値の取得 If m_lManualInterporation <> 2 Then vCurPose = m_vMyCurJnt Else vCurPose = m_vMyCurPos End If ' 現在値に移動分を加減算 If (m_lManualType > 0) Then vCurPose(m_lManualJoint) = vCurPose(m_lManualJoint) + CSng(m_strDev) Else vCurPose(m_lManualJoint) = vCurPose(m_lManualJoint) - CSng(m_strDev) End If ' 実行 On Error Resume Next If m_lManualInterporation <> 2 Then m_caoRobo.Move m_lManualInterporation, Array(vCurPose, "J", "@P") Else m_caoRobo.Move m_lManualInterporation, Array(vCurPose, "P", "@P") End If ' 現在値更新 If m_lManualInterporation <> 2 Then m_vMyCurJnt(0) = CSng(vCurPose(0)) m_vMyCurJnt(1) = CSng(vCurPose(1)) m_vMyCurJnt(2) = CSng(vCurPose(2)) m_vMyCurJnt(3) = CSng(vCurPose(3)) m_vMyCurJnt(4) = CSng(vCurPose(4)) m_vMyCurJnt(5) = CSng(vCurPose(5)) m_vMyCurJnt(6) = CSng(vCurPose(6)) m_vMyCurJnt(7) = CSng(vCurPose(7)) Else m_vMyCurPos(0) = CSng(vCurPose(0)) m_vMyCurPos(1) = CSng(vCurPose(1)) m_vMyCurPos(2) = CSng(vCurPose(2)) m_vMyCurPos(3) = CSng(vCurPose(3)) m_vMyCurPos(4) = CSng(vCurPose(4)) m_vMyCurPos(5) = CSng(vCurPose(5)) m_vMyCurPos(6) = CSng(vCurPose(6)) End If End Sub ' ##################################################################### Private Sub AddConnHistory(strConn As String) Dim intLoopCount As Integer If mcolConnHistory.Count > 0 Then For intLoopCount = 1 To mcolConnHistory.Count If StrComp(mcolConnHistory.Item(intLoopCount), strConn, vbTextCompare) = 0 Then mcolConnHistory.Remove intLoopCount Exit For End If Next intLoopCount If mcolConnHistory.Count > 0 Then mcolConnHistory.Add strConn, , 1 Else mcolConnHistory.Add strConn End If If mcolConnHistory.Count > 10 Then mcolConnHistory.Remove 11 End If Else mcolConnHistory.Add strConn End If cboConn.Clear For intLoopCount = 1 To mcolConnHistory.Count cboConn.AddItem mcolConnHistory.Item(intLoopCount) Next intLoopCount cboConn.Text = strConn End Sub Private Sub LoadHistory() Dim intLoopCount As Integer Dim strConn As String ' IP For intLoopCount = 1 To 10 strConn = vbNullString strConn = GetPrivateProfile(conAppName, "ConnHistory" & intLoopCount, strConn) If Len(strConn) > 0 Then mcolConnHistory.Add strConn End If Next intLoopCount If mcolConnHistory.Count > 0 Then For intLoopCount = 1 To mcolConnHistory.Count If Len(mcolConnHistory.Item(intLoopCount)) > 0 Then cboConn.AddItem mcolConnHistory.Item(intLoopCount) End If Next intLoopCount cboConn.Text = cboConn.List(0) Else AddConnHistory "192.168.0.1" End If ' Deviation Dim strDev As String strDev = GetPrivateProfile(conAppName, "Deviation", "0.1") txtDeviation.Text = strDev End Sub Private Sub SaveHistory() Dim intLoopCount As Integer ' IP If mcolConnHistory.Count > 0 Then For intLoopCount = 1 To mcolConnHistory.Count WritePrivateProfile conAppName, "ConnHistory" & intLoopCount, mcolConnHistory.Item(intLoopCount) Next intLoopCount End If ' Deviation WritePrivateProfile conAppName, "Deviation", txtDeviation.Text End Sub ' Read Ini API Public Function GetPrivateProfile(ByVal Section$, ByVal EntryName$, ByVal Default$) As String Dim tmp As String * 255 Dim strlen As Integer ' Windows API - Get Ini Param strlen = GetPrivateProfileString(Section, EntryName, Default, tmp, Len(tmp), m_strIniFileName) ' String Size > 0? If (strlen) Then ' INI Data GetPrivateProfile = Left$(tmp, strlen) Else ' Default GetPrivateProfile = Default End If End Function ' Write Ini API Public Function WritePrivateProfile(Section$, EntryName$, temp$) WritePrivateProfile = WritePrivateProfileString(Section, EntryName, temp, m_strIniFileName) ' IP End Function Private Function AppPath() As String AppPath = App.Path If (Right(AppPath, 1) <> PATH_DELIMITER) Then AppPath = AppPath & PATH_DELIMITER End Function