[Resolved] VB6 with Uno serialprint to text box

[robtillaart]

goes in the right direction:

Code: [Select]


//send data to serial port for debugging/read data at the PC                       
      Serial.print("A,");
      Serial.println(sensorValue);
      Serial.print("B,");
      Serial.println(speedstartValue);
      Serial.print("C,");
      Serial.println(speedcurveValue);
      Serial.print("D,");
      Serial.println(brakeValue);
      Serial.print("E,");
      Serial.println(brakecurveValue);
      Serial.print("F,");
      Serial.println(sensorMin);
      Serial.print("G,");
      Serial.println(sensorMax);
      Serial.print("H,");
      Serial.println(modelName);


this generates something like

A,100
B,120
C,130
etc

Your VB application recognizes the char and map this to the right text field.

Something like this is needed to parse (VB is too long ago)

Code: [Select]


intPos = InStr(strBuffer, vbCrLf)
If intPos <> 0 Then
  Dim C as Char
  Dim Value as String

  C = strBuffer[0];  'or is it 1 in VB?
  Value = Right$(strBuffer, 2)   'skip the separator

  Select Case(C)
  case A: TextSensorValue.Text = Value
  case B: ...  etc
  End Select
EndIf


[backbone]

Rob,

Are those C or other language?

Code: [Select]

Dim C as Char
C = strBuffer[0];

Paco

[backbone]

Rob,

I managed to distill the value into strValue
The code could be simplified? but it works for me.
I also have the newString containing the letter and seperator with value.
Stuck on the case select.
Watched several sample of case select but cant put my finger on it.

Paco

Code: [Select]



Private Sub MSComm1_OnComm()
Dim boComplete As Boolean
Dim intPos As Integer
Dim strValue As String
Dim strInput As String
Dim str() As String
Static strBuffer As String
Dim lngPos As Long
Dim lngPos2 As Long
Dim newString As String
Dim lngLen As Long


 
  With MSComm1
    'test for incoming event
    Select Case .CommEvent
        Case comEvReceive ' Something to receive
            strInput = .Input
            'strBuffer = strBuffer & strInput  'Receive it and add to our static Buffer
            strBuffer = strInput  'Receive it and add to our static Buffer
            Do
                '
                ' Check if there's a complete record in the Buffer
                ' NOTE: This code assumes that the sender terminates
                ' each record with a Carriage Return Line Feed Pair
                ' If this is not the case then change vbCrLf below
                ' to whatever the terminator is
                '
               
               intPos = InStr(strBuffer, vbCrLf)
               If intPos <> 0 Then

               lngPos = InStr(strBuffer, vbCrLf) 'catch position number of first CRLF in the buffer
               If lngPos > 0 Then newString = Left$(strBuffer, lngPos - 1) 'If the position is larger then 0 remove all rigth fromt the CRLF
               lngPos2 = InStr(newString, ",") 'catch position number of the comma in the string
               lngLen = Len(newString) 'measure length of string
               If lngPos2 > 0 Then strValue = Right$(newString, (lngLen - 2)) 'remove the letter and the : from the string
               
               Select Case (newString)
               'Case A: TextSensorValue.Text = strValue
               'Case B: TextStartSpeedValue.Text = strValue
               End Select
                                             
                    str = Split(strInput, vbTab) 'debug line
                    Text9.Text = strInput 'debug line
                   
                    ' Check if there's anything else in the Buffer
                    '
                    If intPos + 1 < Len(strBuffer) Then
                        '
                        ' Yes, move it to the front of the Buffer
                        ' and go round the loop again
                        '
                        strBuffer = Mid(strBuffer, intPos + 2)
                    Else
                        '
                        ' Nothing left in the Buffer
                        ' Flush it and signal to exit the loop
                        '
                        strBuffer = ""
                        boComplete = True
                    End If
                Else
                    '
                    ' Haven't got a complete record yet
                    ' exit the loop and wait for the next
                    ' comEvReceive event
                    '
                    boComplete = True
                End If

[backbone]

Have been trying to get the select case to work but I did not succeed with the sample showed by rob.
Workaround made by if statement.
Might be rubbish code but I got it to work.
Now all the text boxes are filled with values.

Code: [Select]

Option Explicit

Private Sub MSComm1_OnComm()
Dim boComplete As Boolean
Dim intPos As Integer
Dim strValue As String
Dim strInput As String
Dim str() As String
Static strBuffer As String
Dim lngPos As Long
Dim lngPos2 As Long
Dim newString As String
Dim lngLen As Long
Dim strCase As String

 With MSComm1
   'test for incoming event
   Select Case .CommEvent
       Case comEvReceive ' Something to receive
           strInput = .Input
           strBuffer = strBuffer & strInput  'Receive it and add to our static Buffer
           Do
               '
               ' Check if there's a complete record in the Buffer
               ' NOTE: This code assumes that the sender terminates
               ' each record with a Carriage Return Line Feed Pair
               ' If this is not the case then change vbCrLf below
               ' to whatever the terminator is
               '
               
              intPos = InStr(strBuffer, vbCrLf)
              If intPos <> 0 Then

              lngPos = InStr(strBuffer, vbCrLf) 'catch position number of first CRLF in the buffer
              If lngPos > 0 Then newString = Left$(strBuffer, lngPos - 1) 'If the position is larger then 0 remove all rigth fromt the CRLF
              lngPos2 = InStr(newString, ",") 'catch position number of the comma in the string
              lngLen = Len(newString) 'measure length of string
              If lngPos2 > 0 Then strValue = Right$(newString, (lngLen - 2)) 'remove the letter and the : from the string
              strCase = Left$(newString, 1)
             
              If strCase = "A" Then TextSensorValue.Text = strValue
              If strCase = "B" Then TextStartSpeedValue.Text = strValue
              If strCase = "C" Then TextSpeedCurveValue.Text = strValue
              If strCase = "D" Then TextBrakeValue.Text = strValue
              If strCase = "E" Then TextBrakeCurveValue.Text = strValue
              If strCase = "F" Then TextSensorMinValue.Text = strValue
              If strCase = "G" Then TextSensorMaxValue.Text = strValue
              If strCase = "H" Then TextModelNumberValue.Text = strValue
                                             
                                       
                   ' Check if there's anything else in the Buffer
                   '
                   If intPos + 1 < Len(strBuffer) Then
                       '
                       ' Yes, move it to the front of the Buffer
                       ' and go round the loop again
                       '
                       strBuffer = Mid(strBuffer, intPos + 2)
                   Else
                       '
                       ' Nothing left in the Buffer
                       ' Flush it and signal to exit the loop
                       '
                       strBuffer = ""
                       boComplete = True
                   End If
               Else
                   '
                   ' Haven't got a complete record yet
                   ' exit the loop and wait for the next
                   ' comEvReceive event
                   '
                   boComplete = True
               End If
           Loop Until boComplete = True
       End Select
 End With 'MSComm1

 
End Sub


[PaulS]

Code: [Select]

              lngPos = InStr(strBuffer, vbCrLf) 'catch position number of first CRLF in the buffer
              If lngPos > 0 Then newString = Left$(strBuffer, lngPos - 1) 'If the position is larger then 0 remove all rigth fromt the CRLF
              lngPos2 = InStr(newString, ",") 'catch position number of the comma in the string
              lngLen = Len(newString) 'measure length of string
              If lngPos2 > 0 Then strValue = Right$(newString, (lngLen - 2)) 'remove the letter and the : from the string
You never modify newString to remove the comma and the stuff that follows it, so newString will still contain something like "A,24" which is not 'A'.

The code in the next post DOES create a new variable that is the stuff before the comma, so a switch/case would work.

[backbone]

Paul,

Thanks for reading and once again for the lessons sofar.

Now I reread again I had a typo and an explanation ommision in that last 2 code lines.

Code: [Select]

       lngPos = InStr(strBuffer, vbCrLf) 'catch position number of first CRLF in the buffer
               If lngPos > 0 Then newString = Left$(strBuffer, lngPos - 1) 'If the position is larger then 0 remove all rigth fromt the CRLF
               lngPos2 = InStr(newString, ",") 'catch position number of the comma in the string
               lngLen = Len(newString) 'measure length of string
               If lngPos2 > 0 Then strValue = Right$(newString, (lngLen - 2)) 'remove the letter and the "," from the string
               strCase = Left$(newString, 1) 'leave the data only in this string

Ran into an other issue for which I am looking for simple if statement trapping for the first few loops the buffer is filled.
As the value in strCase now sometimes are not only byte values (from 0 to 255) but like "A,0B1" for the first loops I like to make a
if statement that checks if ther are only byte values in strValue otherwise skip.
something like this:

Code: [Select]

If ((strValue <0) and (>255)) Then
               strValue = vbNullString
               Else
            'RUN code
end if

But the check for 0 to 255 should be in BYTE mode?

Paco

[PaulS]

Code: [Select]

If ((strValue <0) and (>255)) Then
Something is missing here, and something is wrong. If the missing piece is strValue in the parentheses after the and, then the statement would be:

Code: [Select]

If ((strValue <0) and (strValue >255)) Then
There are not two many values that are less than 0 and greater than 255 at the same time.

[backbone]

Paul again my fault.

Your correct.

Code: [Select]

If ((strValue <0) and (strValue >255)) Then

I kow it is not correct in code but did not know how to describe it in code .
So in words what I tried to accomplish:
If the value inside strValue is not a chrachter from 0 to 255 and nothing else like comma, letters or other charchaters then.........

Paco

[robtillaart]

you can describe what it is

If (strValue = X )

or

if ((strValue <0) OR (strValue >255)) Then  ..

IIRC strValue can never be smaller than 0 in VB but I'm not sure my knowledge of VB is rather ...eh... basic

[backbone]

Had some help from an other  VB forum to get things done.
The VB code is below.
Now need to work on the code to send the data back to the UNO if it is changed in the PC control panel.
So the display on the UNO displays the same data as the PC control panel and vice versa.

Code: [Select]

Private Sub MSComm1_OnComm()
Static strBuffer As String
Static boSync As Boolean
Dim strData As String
Dim strRec As String
Dim intPos As Integer
Dim boComplete As Boolean
With MSComm1
   Select Case .CommEvent
       Case comEvReceive
           strData = .Input
           strBuffer = strBuffer & strData
           Do
               intPos = InStr(strBuffer, vbCrLf)
               If intPos > 0 Then
                   strRec = Mid$(strBuffer, 1, intPos - 1)
                   '
                   ' Have we synchronised yet ?
                   '
                   If Not boSync Then
                       '
                       ' Ignore everything until a "A" record is received
                       ' Once it has been, then set the synchronised flag
                       ' and start processing
                       '
                       If Mid$(strRec, 1, 1) = "A" Then
                           boSync = True
                           Call ProcessRecord(strRec)
                       End If
                   Else
                       '
                       ' We are synchronised so process the data received
                       '
                       Call ProcessRecord(strRec)
                       Label12.Caption = "Syncronized"
                       Label12.ForeColor = vbBlack
                   End If
                   If Len(strBuffer) > intPos + 1 Then
                       strBuffer = Mid(strBuffer, intPos + 2)
                   Else
                       strBuffer = ""
                       boComplete = True
                   End If
               Else
                   boComplete = True
               End If
           Loop Until boComplete = True
   End Select
End With
End Sub

Private Sub ProcessRecord(strRec As String)
'
' StrRec is expected to be:
' Single Alphabetic character between A and K (inclusive, excluding I)
' followed by a comma
' followed by a number between 0 and 255 (inclusive)
' eg
' A,120
'
Dim strParts() As String
Dim strValue As String
Dim intI As Integer
Dim boError As Boolean
intI = 1
'
' Ignore null records
'
If strRec <> vbNullString Then
   strParts = Split(strRec, ",")
   '
   ' Check that there's two values
   '
   If UBound(strParts) = 1 Then
       '
       ' Check that the second value is numeric
       '
       Do
           If Mid$(strParts(1), intI, 1) < "0" Or Mid$(strParts(1), intI, 1) > "9" Then
               boError = True
           Else
               intI = intI + 1
           End If
       Loop Until boError Or intI > Len(strParts(1))
       If Not boError Then
           '
           ' Second value is numeric check it's in the correct range
           '
           If CInt(strParts(1)) >= 0 And CInt(strParts(1)) <= 1024 Then
               strValue = strParts(1)
               '
               ' Set the appropriate TextBox to the value sent
               '
               Select Case strParts(0)
                   Case "A"
                       TextSensorValue.Text = strValue
                   Case "B"
                       TextStartSpeedValue.Text = strValue
                   Case "C"
                       TextSpeedCurveValue.Text = strValue
                   Case "D"
                       TextBrakeValue.Text = strValue
                   Case "E"
                       TextBrakeCurveValue.Text = strValue
                   Case "F"
                       TextSensorMinValue.Text = strValue
                   Case "G"
                       TextSensorMaxValue.Text = strValue
                   Case "H"
                       TextModelNumberValue.Text = strValue
                   Case "J"
                       TextSpeedValue.Text = strValue
                   Case "K"
                       TextDeathBandValue.Text = strValue
                   Case Else
                       '
                       ' Unrecognised Letter
                       '
                       Debug.Print "Invalid Code Received: " & strRec, , "Process Record"
               End Select
           Else
               '
               ' Value is out of range
               '
               Debug.Print "Value Received is out of range: " & strRec, , "Process Record"
           End If
       Else
           '
           ' Value is non-numeric
           '
           Debug.Print "Non-Numeric Value Received: " & strRec, , "Process Record"
       End If
   Else
       '
       ' Less than or more than two items in the data
       '
       'MsgBox "Invalid Record Format: " & strRec, , "Process Record"
       Debug.Print "Invalid Record Format: " & strRec, , "Process Record"
   End If
End If
'send the data to a progressbar
ARProgressBar1.Value = TextSpeedValue.Text
ARProgressBar2.Value = TextStartSpeedValue.Text
ARProgressBar3.Value = TextSpeedCurveValue.Text
ARProgressBar4.Value = TextBrakeValue.Text
ARProgressBar5.Value = TextBrakeCurveValue.Text
ARProgressBar6.Value = TextSensorValue.Text
End Sub

[robtillaart]

Thanks for posting this working code !