Introduction: Arduino & Visual Basic 6 (Light Controller)

By

This instructable is something like a tutorial for new VB users. It shows how to create a parser base VB6 program to interact with Arduino circuit. Basically, interaction is in the form of serial communication via the USB port. This is my practice after learning VB6 for 2 weeks and hopefully this post can help other newbies in VB6 to see additional options of interfacing this program.

Step 1: Arduino

First of all, the process of coding should start from the lowest level programming platform and in this case, is the Arduino UNO.
We must make sure that the Arduino should be able to perform the task of lighting up the LEDs connected. I limited the outputs to six pins because i wanted use the PWM function. The schematic shown above is made from Fritzing Software (Autoroute Option Available)

I would like to compliment pwillard as i used some of this parse codes fromhttp://www.arduino.cc/cgi-bin/yabb2/YaBB.pl?num=1293046321 on his "Live For Speed" Racing Simulator. His string manipulation tactic is amazing and just what i needed. I have attached my Arduino Code and feel free to ask if there are any complications. I am also a new learner and just wanted to share what i have achieved so far with Arduino.


Attachments

Step 2: Visual Basic 6.0 (Part 1)

The second step would be starting to code the VB program. I code some functions as class as this would enable me to create dll. The first class would read text files and store them into an array inside the program. I found the code in "Programming Visual Basic 6.0" manual. This function allows me to load pre-programmed commands into the program to run.

Program Code

Public Function FileToArray(ByVal filename As String) As String
On Error GoTo Error

Dim items() As String, i As Integer
' Read the file's contents, and split it into an array of strings.(Exit here if any error occurs.)
items() = Strings.Split(ReadTextFileContents(filename), vbCrLf)

For i = LBound(items()) To UBound(items())
FileToArray = FileToArray & vbCrLf & items(i)
Next

MsgBox "Commands successfully loaded!"

Exit Function
Error:
MsgBox "Error in FileToArray: " & Err.Description
End Function

'read entire context in a file
Public Function ReadTextFileContents(filename As String) As String

Dim fnum As Integer, isOpen As Boolean
On Error GoTo Error_Handler ' Get the next free file number.
fnum = FreeFile()
Open filename For Input As #fnum ' If execution flow got here, the file has been open without error.
isOpen = True ' Read the entire contents in one single operation.
ReadTextFileContents = Input(LOF(fnum), fnum) ' Intentionally flow into the error handler to close the file.

Error_Handler: ' Raise the error (if any), but first close the file.
If isOpen Then Close #fnum
If Err Then Err.Raise Err.Number, , Err.Description

End Function
_____________________________________________________________________________________________
After that, i found the program to load inbox messages from Gmail (http://www.j4mie.org/2008/02/15/how-to-make-a-physical-gmail-notifier/ ). I applied this function to enable loading commands from your Gmail inbox to run the Light Controller.

Program Code

Option Explicit
Private m_TheFile As String, m_TheSection As Variant
Private Username As String, Password As String, iTemp() As String
Private pForm As Form, pTimer As Timer, ptxtBox As TextBox, pInet As Inet

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

Public Sub initGmailAccount(TheFile As String, TheSection As Variant, fForm As Variant, fTimer As Variant, ftxtBox As Variant, fInet As Variant)
On Error GoTo ERRR

m_TheFile = TheFile
m_TheSection = TheSection
Set pForm = fForm: Set pTimer = fTimer: Set ptxtBox = ftxtBox: Set pInet = fInet

Log "INI: " & m_TheFile & vbCrLf & "Section: " & m_TheSection

pTimer.Enabled = False 'stop the timer!
pTimer.Interval = SimpleGet("interval") * 1000 'set the timer!
pTimer.Enabled = True 'start the timer!
Log "Interval: " & pTimer.Interval / 1000 & " seconds"

Username = SimpleGet("username")
Log "Username: " & Username

Password = SimpleGet("password")
Log "Password: **********"
Log "Settings Loaded..."

Exit Sub
ERRR:
Log "Error in LoadSettings: " & Err.Description
Resume Next
End Sub


Public Function CheckMail(ByVal ToTextFile As String) As Boolean
On Error GoTo ERRR 'error handling. a must.

Dim STRTemp As String 'in "strtemp" we put the whole web page
Dim mailCount As String, mailTitle As String, mailSummary As String

STRTemp = pInet.OpenURL("https://" & Username & ":" & Password & "@mail.google.com/gmail/feed/atom")
STRTemp = UCase(STRTemp)
mailCount = Right(STRTemp, Len(STRTemp) - InStr(1, STRTemp, "FULLCOUNT") - 9)
mailCount = Left(mailCount, InStr(1, mailCount, "<") - 1)
mailTitle = Right(STRTemp, Len(STRTemp) - InStr(1, STRTemp, "TITLE>L") - 5)
mailTitle = Left(mailTitle, InStr(1, mailTitle, "<") - 1)

If StrComp(mailTitle = "LIGHTCONTROL", vbTextCompare) = 0 & mailCount = "1" Then
mailSummary = Right(STRTemp, Len(STRTemp) - InStr(1, STRTemp, "SUMMARY") - 7)
mailSummary = Left(mailSummary, InStr(1, mailSummary, "<") - 1)

'load message into public variable
iTemp() = Strings.Split(mailSummary, ";")

'save mail data into a textfile
Open ToTextFile For Output As #1
Dim i As Integer
For i = LBound(iTemp()) To UBound(iTemp())
Print #1, iTemp(i)
Next
Close #1
CheckMail = True

Else
Log "Mail not available!!!"
CheckMail = False
End If

Exit Function
ERRR:
Log "Error in CheckMail: " & Err.Description
Resume Next
End Function


Public Sub Log(Text As String)
On Error GoTo ERRR
ptxtBox.Text = Text & vbCrLf & ptxtBox.Text
Exit Sub
ERRR:
MsgBox "Error while logging: " & Err.Description
Resume Next
End Sub


Public Function SimpleGet(VarName As String) As String
Static sLocalBuffer As String * 500
Dim l As Integer

l = GetPrivateProfileString(m_TheSection, VarName, vbNullString, sLocalBuffer, 500, m_TheFile)
SimpleGet = Left$(sLocalBuffer, l)

End Function

Public Sub SimplePut(TheItem As Variant, TheVal As Variant)

Call WritePrivateProfileString(m_TheSection, CStr(TheItem), CStr(TheVal), m_TheFile)
'Flush buffer
Call WritePrivateProfileString(0, 0&, 0&, m_TheFile)

End Sub

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



Step 4: Visual Basic 6.0 (form)



The final part would be to create the User Interface.
I made the interface simple so i could show what VB can do easily. Interfaces are subjective structures. You should consider the user; whether he/she is right or left handed and their personal preferences. There are no perfect Interfaces but there are suitable ones. I wanted to attach the ZIP file but have no idea how to so i linked it here @http://www.esnips.com/doc/bc349cad-d350-47f7-ac81-d74d2474238f/Light and http://www.esnips.com/doc/8c1807ca-bc5c-4348-a420-33c3e396e610/VBLight

Form

Private temptxt As String, i As Long, Ext As Boolean
Private Command() As String
Private pauseLocation As Long

Private Sub cmdCheck_Click()
Key = 0
Parse.StringSort (txtCode.Text)
txtCode.SelStart = 0
txtCode.SelLength = Len(txtCode.Text)
txtCode.SetFocus
End Sub

Private Sub cmdExit_Click()
End
End Sub

Private Sub cmdLoadFile_Click()
temptxt = File.FileToArray(App.Path & "\ProgramCode.txt")
txtLoadCode.Text = temptxt & vbCrLf & txtLoadCode.Text
Command() = Strings.Split(temptxt, vbCrLf)
i = 1
End Sub

Private Sub cmdLoadGmail_Click()
Dim FileName As String
FileName = App.Path & "\ProgramFromMail.txt"
Key = 0
txtLoadCode.Text = "Loading Code from Gmail..." & vbCrLf & txtLoadCode.Text
If Gmail.CheckMail(FileName) Then
temptxt = File.FileToArray(FileName)
temptxt = Replace(temptxt, "CT" & vbCrLf, "CT")
txtLoadCode.Text = temptxt & vbCrLf & txtLoadCode.Text
Command() = Strings.Split(temptxt, vbCrLf)
i = 1
End If
End Sub

Private Sub cmdLoop_Click()
Key = 0: Ext = False
For i = 1 To UBound(Command())
DoEvents
Parse.StringSort (Command(i))
If Key = 1 Then Exit For 'if command has error, skip future commands
If Ext Then Exit For
If i = UBound(Command()) - 1 Then i = 1 'reset i to loop & skip disconnect command
Next
End Sub

Private Sub cmdRefresh_Click()
Gmail.initGmailAccount App.Path & "\Gmail.ini", "general", frmServo, Timer1, txtLoadCode, Inet1
End Sub

Private Sub cmdRun_Click()
Key = 0
For i = 1 To UBound(Command())
DoEvents
Parse.StringSort (Command(i))
If Key = 1 Then Exit For
If Ext Then Exit For
Next
End Sub

Private Sub cmdPause_Click()
pauseLocation = i + 1 'save paused location
Do
DoEvents
Loop
End Sub

Private Sub cmdResume_Click()
For i = pauseLocation To UBound(Command())
DoEvents
Parse.StringSort (Command(i))
If Key = 1 Then Exit For 'if command has error, skip future commands
If Ext Then Exit For
If i = UBound(Command()) - 1 Then i = 1 'reset i to loop & skip disconnect command
Next
End Sub

Private Sub cmdSingle_Click()
Key = 0
If i > UBound(Command()) Then
i = 1
End If
Parse.StringSort (Command(i))

If Key = 1 Then
MsgBox "Line " & i & " Command Error!"
End If
i = i + 1 'increment index to play next line
End Sub

Private Sub cmdStopProgram_Click()
Ext = True
End Sub


Private Sub Form_Load()
Parse.Init_Parser App.Path & "\ComportSettings.ini", "general", MSComm1, txtFeedback, txtStatus
Gmail.initGmailAccount App.Path & "\Gmail.ini", "general", frmTestCode, Timer1, txtLoadCode, Inet1
End Sub


Module

Public Parse As New cLightParser
Public File As New cReadTextFile
Public Gmail As New cReadGmail
Public Light As New cLightFunction
Public Key As Integer