Step 3: Visual Basic 6.0 (Part 2)
After the basic classes, I coded the parser function to limit user input and it would communicate with the function that sends data to the Arduino. I used parser so that I could load commands from other sources and I can change the program sequence anytime just by changing the text file. This technique is very helpful in the long run. Blinking sequences need not be recoded in VB to change the display pattern. My parser code is shown below:
Program Code
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'to use sleep(xxxx)
Private lSide As String, rSide As String
Private File As String, Section As String, Comm As MsComm, txtFeedback As TextBox, txtStatus As TextBox
Public Sub Init_Parser(FileName As String, FileSection As String, CommPort As Variant, txtBoxFeedback As Variant, statusBox As Variant)
File = FileName
Section = FileSection
Set Comm = CommPort
Set txtFeedback = txtBoxFeedback
Set txtStatus = statusBox
End Sub
Public Sub StringSort(ByVal item As String)
If Len(item) >= 20 Then 'random limitation to check if command is wrong
Log "File Code Error: Too Long"
Exit Sub
End If 'limit the strings length to check for error file
item = Trim(item)
If InStr(item, " ") = 0 Then 'if there is no space in code
lSide = item: rSide = vbNullString
Else
lSide = Left(item, InStr(item, " ") - 1)
rSide = Right(item, Len(item) - InStr(item, " "))
End If
Commander
End Sub
Public Sub Commander()
Dim fCommand As String
On Error GoTo Error
fCommand = Left(lSide, 2)
Select Case fCommand 'library
Case "CO"
txtStatus.Text = "Connecting Light..." & vbCrLf & txtStatus.Text
Light.InitLightController File, Section, Comm, txtFeedback
Case "CT"
txtStatus.Text = "Disconnecting Light..." & vbCrLf & txtStatus.Text
Light.ExitLight
Case "LH"
txtStatus.Text = "Setting Active Lights..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "LI"
txtStatus.Text = "Setting Light Intensity..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "LO"
txtStatus.Text = "Configuring Lights..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "RE"
txtStatus.Text = "Lights Reset..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "DE"
txtStatus.Text = "Delay In Process..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case Else
GoTo Error
End Select
txtStatus.Text = lSide & " " & rSide & " : Executed..." & vbCrLf & txtStatus.Text
Exit Sub
Error:
Log "File Code Error: Syntax " & lSide & " " & rSide & " Not Valid"
Key = 1
End Sub
'***************************************************************************************
'pop up message box to display error
'***************************************************************************************
Public Sub Log(Text As String)
On Error GoTo Error
MsgBox Text & Err.Description
Exit Sub
Error:
MsgBox "Error while logging: " & Err.Description + vbCritical
Resume Next
End Sub
_______________________________________________________________________________________________________
The Variant datatype is used instead of MSComm or textbox because these properties could not be passed into a dll. The right way to do it is to declare as type Variant and then set the variable name as a private object after. Another function I used to allow direct communication of VB6 and Arduino is the "light function" class. When any data is sent to the Arduino, the program will wait for an echo from Arduino. This technique is used as an adaptation of simple handshaking protocol in serial communication between the laptop and the Arduino. If an echo is not sensed, the timeout counter will fire and pop out a message box to alert the user about the problem.
Program Code
Private Command As String, TextLength As Long, TimeOut As Long
Private File_Name As String, File_Section As String
Private MComm As MsComm, tBox As TextBox
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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
Public Sub InitLightController(PortSettingFileName As String, FileSection As String, MsComm As Variant, txtFeedback As Variant)
File_Name = PortSettingFileName
File_Section = FileSection
Set MComm = MsComm
Set tBox = txtFeedback
TimeOut = 200000
'Output loaded COMPORT settings
Log "File: " & File_Name & vbCrLf & "Section: " & File_Section
'Open ComPort and connect with Arduino
With MComm
If .PortOpen Then .PortOpen = False 'close and set the com port number
.CommPort = SimpleGet("comport")
.Settings = SimpleGet("settings")
.EOFEnable = True
Log "Com Port: " & .CommPort & vbCrLf & "Settings: " & .Settings
End With
SendData ("CO")
End Sub
Public Sub SendData(ByVal Commandx As String)
On Error GoTo Error
Command = Commandx
'check command first
Command = Trim(Command) 'get rid of extra spaces at the side
If (InStr(Command, " ") <> 0) Or (Len(Command) > 10) Then 'command should not be longer than 10 char or contain spaces
GoTo Error 'do not send if command format is wrong
End If
Dim i As Integer, Char As String
For i = 1 To 2 'because length of ecpected character is 2 only
Char = Mid(Command, i, 1)
If (Char >= "A" And Char <= "Z") Then 'do nothing if first 2 characters are alphabets
Else
GoTo Error
End If
Next i
'automatically skip for commands without integers CO,CT,RE
For i = 3 To Len(Command) 'make sure the rest of the command are integers
Char = Mid(Command, i, 1)
If (Char >= "0" And Char <= "9") Then 'do nothing if remaining characters are numerals
Else
GoTo Error
End If
Next i
TextLength = Len(Command) 'set expected textlength echo
With MComm
.DTREnable = False
.RTSEnable = False 'disable request to send signal
If .PortOpen = False Then .PortOpen = True 'Open port
.Output = Commandx 'Send Text
.RThreshold = TextLength 'Save Sent String Length
End With 'leave port open to wait for echo signal to proceed
OnComm 'wait for echo reply from Arduino
Exit Sub
Error:
If (Err.Description) Then
MsgBox Err.Description
Else
MsgBox "Invalid Command!"
End If
End Sub
Private Sub Log(Text As String)
On Error GoTo ERRR
tBox.Text = Text & vbCrLf & tBox.Text
Exit Sub
ERRR:
MsgBox "Error while logging: " & Err.Description
Resume Next
End Sub
'Manual OnComm Function to detect echo of sent data
Private Sub OnComm()
Dim InString As String, Count As Long
Do
DoEvents
Sleep (1)
If Count > TimeOut Then
MsgBox "Time Out Reached!!!" & vbCrLf & "No Reply from Arduino!"
Exit Sub
End If
Loop Until MComm.CommEvent = comEvReceive And MComm.InBufferCount >= TextLength
Sleep (5)
' Retrieve all available data.
MComm.InputLen = 0
' Check for data.
If MComm.InBufferCount > 0 Then ' Read data.
InString = MComm.Input
'check if received data is as expected
If InStr(InString, Command) > 0 Then 'if command is an echo
Else
GoTo Error
End If
If Len(InString) > 0 Then 'Output echo onto textbox
tBox.Text = InString & tBox.Text
End If
End If
If MComm.PortOpen Then MComm.PortOpen = False 'close port after receiving reply
Exit Sub
Error:
If (Err.Description) Then
MsgBox Err.Description
Else
MsgBox "Receiving Function Error!"
End If
End Sub
Public Sub ExitLight()
SendData ("RE")
SendData ("CT")
If MComm.PortOpen Then MComm.PortOpen = False 'If port is open, close if before exit
End Sub
Public Function SimpleGet(VarName As String) As String
Static sLocalBuffer As String * 500
Dim l As Integer
l = GetPrivateProfileString(File_Section, VarName, vbNullString, sLocalBuffer, 500, File_Name)
SimpleGet = Left$(sLocalBuffer, l)
End Function
Program Code
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'to use sleep(xxxx)
Private lSide As String, rSide As String
Private File As String, Section As String, Comm As MsComm, txtFeedback As TextBox, txtStatus As TextBox
Public Sub Init_Parser(FileName As String, FileSection As String, CommPort As Variant, txtBoxFeedback As Variant, statusBox As Variant)
File = FileName
Section = FileSection
Set Comm = CommPort
Set txtFeedback = txtBoxFeedback
Set txtStatus = statusBox
End Sub
Public Sub StringSort(ByVal item As String)
If Len(item) >= 20 Then 'random limitation to check if command is wrong
Log "File Code Error: Too Long"
Exit Sub
End If 'limit the strings length to check for error file
item = Trim(item)
If InStr(item, " ") = 0 Then 'if there is no space in code
lSide = item: rSide = vbNullString
Else
lSide = Left(item, InStr(item, " ") - 1)
rSide = Right(item, Len(item) - InStr(item, " "))
End If
Commander
End Sub
Public Sub Commander()
Dim fCommand As String
On Error GoTo Error
fCommand = Left(lSide, 2)
Select Case fCommand 'library
Case "CO"
txtStatus.Text = "Connecting Light..." & vbCrLf & txtStatus.Text
Light.InitLightController File, Section, Comm, txtFeedback
Case "CT"
txtStatus.Text = "Disconnecting Light..." & vbCrLf & txtStatus.Text
Light.ExitLight
Case "LH"
txtStatus.Text = "Setting Active Lights..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "LI"
txtStatus.Text = "Setting Light Intensity..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "LO"
txtStatus.Text = "Configuring Lights..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "RE"
txtStatus.Text = "Lights Reset..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case "DE"
txtStatus.Text = "Delay In Process..." & vbCrLf & txtStatus.Text
Light.SendData lSide
Case Else
GoTo Error
End Select
txtStatus.Text = lSide & " " & rSide & " : Executed..." & vbCrLf & txtStatus.Text
Exit Sub
Error:
Log "File Code Error: Syntax " & lSide & " " & rSide & " Not Valid"
Key = 1
End Sub
'***************************************************************************************
'pop up message box to display error
'***************************************************************************************
Public Sub Log(Text As String)
On Error GoTo Error
MsgBox Text & Err.Description
Exit Sub
Error:
MsgBox "Error while logging: " & Err.Description + vbCritical
Resume Next
End Sub
_______________________________________________________________________________________________________
The Variant datatype is used instead of MSComm or textbox because these properties could not be passed into a dll. The right way to do it is to declare as type Variant and then set the variable name as a private object after. Another function I used to allow direct communication of VB6 and Arduino is the "light function" class. When any data is sent to the Arduino, the program will wait for an echo from Arduino. This technique is used as an adaptation of simple handshaking protocol in serial communication between the laptop and the Arduino. If an echo is not sensed, the timeout counter will fire and pop out a message box to alert the user about the problem.
Program Code
Private Command As String, TextLength As Long, TimeOut As Long
Private File_Name As String, File_Section As String
Private MComm As MsComm, tBox As TextBox
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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
Public Sub InitLightController(PortSettingFileName As String, FileSection As String, MsComm As Variant, txtFeedback As Variant)
File_Name = PortSettingFileName
File_Section = FileSection
Set MComm = MsComm
Set tBox = txtFeedback
TimeOut = 200000
'Output loaded COMPORT settings
Log "File: " & File_Name & vbCrLf & "Section: " & File_Section
'Open ComPort and connect with Arduino
With MComm
If .PortOpen Then .PortOpen = False 'close and set the com port number
.CommPort = SimpleGet("comport")
.Settings = SimpleGet("settings")
.EOFEnable = True
Log "Com Port: " & .CommPort & vbCrLf & "Settings: " & .Settings
End With
SendData ("CO")
End Sub
Public Sub SendData(ByVal Commandx As String)
On Error GoTo Error
Command = Commandx
'check command first
Command = Trim(Command) 'get rid of extra spaces at the side
If (InStr(Command, " ") <> 0) Or (Len(Command) > 10) Then 'command should not be longer than 10 char or contain spaces
GoTo Error 'do not send if command format is wrong
End If
Dim i As Integer, Char As String
For i = 1 To 2 'because length of ecpected character is 2 only
Char = Mid(Command, i, 1)
If (Char >= "A" And Char <= "Z") Then 'do nothing if first 2 characters are alphabets
Else
GoTo Error
End If
Next i
'automatically skip for commands without integers CO,CT,RE
For i = 3 To Len(Command) 'make sure the rest of the command are integers
Char = Mid(Command, i, 1)
If (Char >= "0" And Char <= "9") Then 'do nothing if remaining characters are numerals
Else
GoTo Error
End If
Next i
TextLength = Len(Command) 'set expected textlength echo
With MComm
.DTREnable = False
.RTSEnable = False 'disable request to send signal
If .PortOpen = False Then .PortOpen = True 'Open port
.Output = Commandx 'Send Text
.RThreshold = TextLength 'Save Sent String Length
End With 'leave port open to wait for echo signal to proceed
OnComm 'wait for echo reply from Arduino
Exit Sub
Error:
If (Err.Description) Then
MsgBox Err.Description
Else
MsgBox "Invalid Command!"
End If
End Sub
Private Sub Log(Text As String)
On Error GoTo ERRR
tBox.Text = Text & vbCrLf & tBox.Text
Exit Sub
ERRR:
MsgBox "Error while logging: " & Err.Description
Resume Next
End Sub
'Manual OnComm Function to detect echo of sent data
Private Sub OnComm()
Dim InString As String, Count As Long
Do
DoEvents
Sleep (1)
If Count > TimeOut Then
MsgBox "Time Out Reached!!!" & vbCrLf & "No Reply from Arduino!"
Exit Sub
End If
Loop Until MComm.CommEvent = comEvReceive And MComm.InBufferCount >= TextLength
Sleep (5)
' Retrieve all available data.
MComm.InputLen = 0
' Check for data.
If MComm.InBufferCount > 0 Then ' Read data.
InString = MComm.Input
'check if received data is as expected
If InStr(InString, Command) > 0 Then 'if command is an echo
Else
GoTo Error
End If
If Len(InString) > 0 Then 'Output echo onto textbox
tBox.Text = InString & tBox.Text
End If
End If
If MComm.PortOpen Then MComm.PortOpen = False 'close port after receiving reply
Exit Sub
Error:
If (Err.Description) Then
MsgBox Err.Description
Else
MsgBox "Receiving Function Error!"
End If
End Sub
Public Sub ExitLight()
SendData ("RE")
SendData ("CT")
If MComm.PortOpen Then MComm.PortOpen = False 'If port is open, close if before exit
End Sub
Public Function SimpleGet(VarName As String) As String
Static sLocalBuffer As String * 500
Dim l As Integer
l = GetPrivateProfileString(File_Section, VarName, vbNullString, sLocalBuffer, 500, File_Name)
SimpleGet = Left$(sLocalBuffer, l)
End Function
Remove these ads by
Signing UpFlag this comment as:
Not NiceInappropriateSpam
Visit Our Store »
Go Pro Today »
