VB6+HPS40+RS232+Code Example (Now Java)

Instruments Handheld Oscilloscopes
1

Hiiiii to all…

I made a program in VB6. It receives data from the HPS40.
It is a very basic program.
Soon I will finish one more complex.

Is very hard to begin without an example.
I hope can understand and enjoy this small program.
My English is very poor and I cannot explain well.

For all the users of HPS40 and others models.

'''=========================================================
''' Originally created to donate all People.
''' Spanish Date: 14-01-2009
''' Up Date: 15-01-2009
'''=========================================================

'''TextBox Font Courier 10
Option Explicit
'''=========================================================

Private Sub Form_Load()
Option1.Value = True
End Sub

Private Sub Option1_Click()    'Option1 COM1(h)
    Text1.Text = "Waiting"
'''Fire Rx Event Every one Bytes
    MSComm1.SThreshold = 0
'''Produce el evento de arribo de datos.
    MSComm1.RThreshold = 2
'''When Inputting Data, Input 2 Bytes at a time
    MSComm1.InputLen = 1
    MSComm1.InputMode = 0  '''Mode texto

    MSComm1.CommPort = 1 '''COM1
'''Make sure DTR line is low to prevent Stamp reset
    MSComm1.DTREnable = False
'''Make sure RTS line is Up ---> Very Important
    MSComm1.RTSEnable = True '''<----- If not True don´t work.
    MSComm1.Settings = "57600,N,8,1"
    MSComm1.PortOpen = True
End Sub

Private Sub Form_Terminate()    '''Cuando se finaliza el Formulario
    If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
    End If
       
    End
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
    End If
End Sub

Private Sub MSComm1_OnComm()
    Dim sData As String

    If Option1.Value = True Then
        Select Case MSComm1.CommEvent
            Case comEvReceive
            
            '''Recibe y lo almacena en sData.
            sData = MSComm1.Input
            '''Muestra en el TextBox(negro) lo recibido y almacenado en sData.
            Text1.Text = Text1.Text & sData '& vbCrLf 

            'Text1.Text = sData & Text1.Text & vbCrLf   '<---No good
        End Select
        
    End If
    
End Sub

I will return

Here .Zip VB6 program…ASCII RECEIVE
http://www.box.net/shared/lp89o3rrdg

Bye(’_’)…

2

Hiiii again:

I tested with a DMM (excuses nonVelleman). Of another Manufacturer.
I modified the code here:

    MSComm1.CommPort = 1 'para COM1 ó 2 para COM2
'''Make sure DTR line is UP
    MSComm1.DTREnable = True  '''<----- If not True don´t work.
'''Make sure RTS line is Up ---> Very Important
    MSComm1.RTSEnable = False '''<----- If not False don´t work.
    MSComm1.Settings = "2400,o,7,1"
    MSComm1.PortOpen = True

The program worked well.
All the reception problem is about RTSEnable and DTREnable.
I hope you can understand.

Bye(’_’)…

3

Hellooo…

The program receives the inverted data.
Text1.Text = sData & Text1.Text & vbCrLf <-----inverted data (no good)

Please Change.
Text1.Text = Text1.Text & sData '& vbCrLf <------Ok data
This change works better.

I hope you can understand.
Bye(’_’)…

4

Helloooo:

I’m working in my new proyect. Look it here.

I hope finish soon. Is very hard to me. :smiley:

Bye(’_’)…

5

Hi to all…

I am a man with luck.
I made an adaptation of this program for the HPS40.
This program works in binary way.
It’s very simple and the project is not finished.
I do not know if it(VB6) receives in way REALTIME SAMPLES or ALL SAMPLES.
I share this program, to other people can understand the communication HPS40 with VB6.
http://www.box.net/shared/37bunr3g5m

If your HPS40 it’s in HOLD mode, the VB6 program not receive anything. (Trigger in RUN mode)
Set the HPS40 to Binary Transmit. <—Very Important

I hope you can understan me…
I see you soon…

6

Hello to all…

I finalized I-V Curve Tracer program in VB6.
Look here:
http://img269.imageshack.us/img269/9067/capture3igi.png

It is a very basic program. Here the source in VB6 and word document.
http://www.box.net/shared/7mcbn6pxb3

I hope you can understand me.
Thanks to Mr. HardLock russian man.

By the moments is all. Bye…

[color=#FF0000]Edit__08-24-09__New program[/color]
I made a FreeBasic “I-V Curve Tracer” program. More small and more simple.
The VB 6.0 is very complex program to make a simple graph. Look source file.
If you don’t have FreeBasic here the code and .exe file.
http://www.box.net/shared/dsgl65rqz3

Look here capture FreeBasic program.

See you soon…

7

I’m sure a lot of other users will have use for your code and applications, well done

8

Hello all people…

I improve the programs writed in FreeBasic and VB6(no .NET).

First.
Single FreeBasic Program Improved.
Look this capture…

Code source.

'''==============================================================
'Compilar asì, es un ejemplo de como compilarlo.
'fbc -s gui HPS40_Binary.bas 
'''==============================================================
Declare Sub Graphing()
Declare Sub Sample1()
Declare Sub Sample2()
Declare Sub Change_Wait()
Declare Sub Menu()
Declare Sub Set_XY()

Declare Sub ClippingArea()
Declare Sub RevertScreen()


Dim Shared buffer1(200) As UByte
Dim Shared buffer2(200) As UByte
Dim i As Integer

Dim Shared As Single v1, v2, v3, v4, v5 ', v6
'''Set to Size Scale Small Grafic
'v1 = -600 : v2 = 7.5 : v3 = 1 : v4 = 1200 : v5 = 7.5  '''Normal
'v1 = -100 : v2 = 6.5 : v3 = 2 : v4 = 1100 : v5 = 6.5  '''Small
v1 = 60 : v2 = 2 : v3 = 1 : v4 = 450 : v5 = 2          '''Tiny 


screenres 640,480,8,2
Color 15

Menu()


'''==============================================================
'''Sub Rutines
'''==============================================================
Sub Menu()
Dim c As String

Color 15

Erase buffer1,buffer2
CLS : CLOSE

    Locate 1, 25 :Print : Color 11   
    Locate 2, 25 :Print "Test Input SERIAL From HPS40" : Color 15  
    Locate 3, 25 :Print "----------------------------"
    Locate 4, 25 :Print "| I-V Curve Plotter Menu   |"
    Locate 5, 25 :Print "----------------------------"
    Locate 6, 31 :Print "1 to Take Sample"
    Locate 7, 31 :Print "2 to Graph Scale"
    Locate 8, 31 :Print "3 to Exit"
    Locate 9, 25 :Print
    'Locate 9, 20 :Input "Enter Your Choice: ", choice  
    'If choice = 1 Then Sample1()
    
''''Define clipping area
ClippingArea()
''''Revert to screen coordinates & Remove the clipping area
RevertScreen()

Do  
    c = Inkey$
    If c = "1" Then Sample1()
    If c = "2" Then Set_XY()
    If c = "3" Then End    
     'If i = "?" Then help()    
Loop 'Until choice = 2 : End
'Loop Until Inkey = "q" : End  'Chr(27) : End
End Sub


'''OPEN COM PORT One first samples
'''==============================================================
Sub Sample1()
OPEN Com ("COM1:57600,N,8,1,CD,CS,DS,OP,BIN") FOR Binary AS #1
Get #1,,buffer1()    'Read the port as a file, place the characters in "buffer()"
'For i = 15 To 115
    'Var1 = buffer1(i)  '- 128 '* -1 
    'Print buffer1(i),
    'Print Var1         '* -1  
'Next i
Close #1

Change_Wait()
Sample2()
Graphing()
Menu()
End Sub

'''Wait for Change Test Leads
'''==============================================================
Sub Change_Wait()
    Color 12
    Locate 11, 25 :Print "Change Test Leads  " 
    Sleep 3000
    Locate 12, 25 :Print "Take Sample2       "
    Sleep 1000
End Sub

'''OPEN COM PORT One second samples
'''==============================================================
Sub Sample2()
OPEN Com ("COM1:57600,N,8,1,CD,CS,DS,OP,BIN") FOR Binary AS #2
Get #2,,buffer2()    'Read the port as a file, place the characters in "buffer()"
'For i = 15 To 115
    'Var2 = buffer2(i)  '- 128 '* -1 
    'Print buffer2(i),
    'Print Var2         '* -1  
'Next i
Close #2
End Sub

'''Graph Sample1 and Sample2
'''==============================================================
Sub Graphing()


Dim As Integer i
Dim As Single x1, y1 , x, y
Color 2 '11 '2
'screenset 0,0

''''Define clipping area
ClippingArea()

FOR i = 15 TO 115    '
    x1 = buffer1(i)  'Var1    
    y1 = buffer2(i)  'Var2    
        

'''Con Variables, para mejor configuración.
    x = v1 + (v2 * x1) / v3    
    y = v4 - (v5 * y1) '/ v6     

    If i = 15 or i > 115 Then
       Pset(x,y)
    Else
       Line -(x,y)  '''Grafica los Datos
    End If



'''Find out which data was not on the screen
'If (x<0) Or (x>640) Or (y<0) Or (y>480) Then Print i, x, y

NEXT i

''''Revert to screen coordinates & Remove the clipping area
RevertScreen()


Color  12
Locate 11, 25 :Print "Ending Graph       "
Locate 12, 25 :Print "                   "
Color  15
Sleep
Locate 11, 25 :Print "                   "
Locate 12, 25 :Print "                   "

End Sub

'''==============================================================
Sub Set_XY()
Dim s As String  

    Color 12
    Locate 9, 25  :Print "Select Number 4, 5, 6      "
    Color 10
    Locate 10, 25 :Print "4 Size Scale Tiny   Grafic " 
    Locate 11, 25 :Print "5 Size Scale Small  Grafic "
    Locate 12, 25 :Print "6 Size Scale Normal Grafic "  

Do  
    s = Inkey$ 
    If s = "4" Then v1 = 60 : v2 = 2 : v3 = 1 : v4 = 450 : v5 = 2 : Exit Do
    If s = "5" Then v1 = -120 : v2 = 6.5 : v3 = 2 : v4 = 1000 : v5 = 6.5 : Exit Do
    If s = "6" Then v1 = -700 : v2 = 7.5 : v3 = 1 : v4 = 1100 : v5 = 7.5 : Exit Do
Loop
    Locate 9, 25 :Print "                           "
    Locate 10,25 :Print "                           "
    Locate 11,25 :Print "                           "
    Locate 12,25 :Print "                           "
 
Menu()
End Sub


'''============================================================================
Sub ClippingArea()
Dim As Integer x, y

'''Define clipping area
Line (14,100)-(625,470),17,bf
View  (18,105)-(620,465)
cls

'''Estas son las lineas dentro del box. Donde se muestra el Gráfico.
'''Horizontales
For y = 1 To 565 Step 50
     Line (1, y)-(600, y), 17
Next y
'''Verticales
For x = 1 To 795 Step 50
     Line (x, 1)-(x, 350), 17
Next x

'''Linea vertical y tramos horizontales peq.
'    Line (300, 1)-(300, 350), 3,bf
'    For y = 1 To 475 Step 50 '0.5
'        Line (295, y)-(305, y), 3
'    Next y
'''Linea horizontal y tramos verticales peq.
'   Line (1,150)-(600,150), 3,bf
'    For x = 1 To 795 Step 50 '0.5
'       Line (x, 145)-(x, 155), 3
'    Next x

End Sub

'''============================================================================
Sub RevertScreen()
'''Revert to screen coordinates
Window       

'''Remove the clipping area
View Screen 

End Sub

Second.
New FreeBasic Program. I was Inspired by Mr. Turd program.
http://www.freebasic.net/forum/viewtopic.php?t=13416&highlight=picaxe
Look this capture…

Code source.

'''============================================================================
Dim As Integer x, y, buttons, i, ii, Blue1, Blue2, Red1, Red2, Green1, Green2, graphpos, scale
'dim as double 
Dim As String s, text, filename, logtime, temp, device_name, Blues, Reds, Greens

Declare Sub checkport(filenumber As Integer, delay As Double)
Declare Sub bttn(x As Integer, y As Integer, s As String)
Declare Sub buttonup(x As Integer, y As Integer, s As Integer)
Declare Sub buttondown(x As Integer, y As Integer, s As Integer)
Declare Sub inbox(x As Integer, y As Integer, w As Integer, h As Integer)
Declare Sub clearbox(x As Integer, y As Integer)
Declare Sub label(x As Integer, y As Integer, s As String)
declare function sliderh(x as integer, y as integer, w as integer) as integer
'''============================================================================

Declare Sub Graphing()
Declare Sub Sample1()
Declare Sub Sample2()
Declare Sub Change_Wait()
Declare Sub ClippingArea()
Declare Sub RevertScreen()


Dim Shared buffer1(200) As UByte
Dim Shared buffer2(200) As UByte


Dim Shared As Single v1, v2, v3, v4, v5 ', v6

'''============================================================================
screenres 800,600 '800,335
Color  25,19 ' 0, 15 '
Cls

'Color 0,15  '<----
bttn (555, 14, "START")          'Button #1
bttn (619, 14, "STOP")           'Button #2
bttn (675, 14, "CLEAR")          'Button #3
bttn (739, 14, "EXIT")           'Button #4
'inbox (51, 14, 163, 26)         'In/Out box #1 Graph Scale
'inbox (275, 14, 51, 26)         'In/Out box #2
'Locate 4, 37: Color 0,15: Print "mins"
inbox (403, 14, 131, 26)         'In/Out box #3 '''Device Name
Locate 4, 52: Color 25,19 '0,15

#IFDEF __FB_LINUX__
        Print "/dev/ttyS0"
        device_name = "/dev/ttyS0"
#ENDIF
#IFDEF __FB_WIN32__
        Print "Ver_COM1" '''Aqui coloca etiqueta en el BOX
        device_name = "COM1"
#ENDIF
#IFDEF __FB_DOS__
        Print "COM1"
        device_name = "COM1"
#ENDIF

i = sliderh (55, 14, 35)        'Slider #1
scale = 1
'''Set to Size Scale Tiny Grafic
'v1 = -600 : v2 = 7.5 : v3 = 1 : v4 = 1200 : v5 = 7.5
v1 = 100 : v2 = 2 : v3 = 1 : v4 = 450 : v5 = 2

'''Este es el Box donde se muestran los gráficos.
inbox (11, 100, 771, 485)        'In/Out box #4 Graph View
label (11, 16, "Graph")          'Label #1
label (11, 32, "Scale")          'Label #2
'label (235, 16, "LOG")          'Label #3
'label (235, 32, "TIME")         'Label #4
label (347, 16, "DEVICE")        'Label #5
label (347, 32, "NAME")          'Label #6

''''Define clipping area
ClippingArea()
''''Revert to screen coordinates & Remove the clipping area
RevertScreen()


Do
        Do While buttons < 1
                getmouse (x, y, , buttons)
                locate 1, 1: color 4, 19: print using "###:###"; x; y
                s = Inkey$
                If s = Chr(255) & "k" Or s = Chr(27) Then End
                Sleep 10
        Loop

'''BUTTONS======================================================================
'''START
        If x > 555 And x < 609 And y > 14 And y < 44 Then
                buttondown (558, 43, 50)

'                #IFDEF __FB_LINUX__
'                        if device_name = "" then device_name = "/dev/ttyS0"
'                        shell "stty -F " & device_name & " speed 4800"
'                        Open Com device_name & ":4800,n,8,1,CD,CS,DS,RS,BIN" For Binary As #2
'                #ENDIF
'
'                #IFDEF __FB_WIN32__
'                        if device_name = "" then device_name = "COM1"
'                        'Open Com "COM1:4800,n,8,1,cs0,cd0,ds0,rs" As #2
'                        'OPEN Com ("COM1:57600,N,8,1,CD,CS,DS,OP,BIN") FOR Binary AS #2 '''HPS40
'                        Open Com device_name & ":4800,n,8,1,CD,CS,DS,RS,BIN" For Binary As #2
'                #ENDIF
'                
'                #IFDEF __FB_DOS__
'                        if device_name = "" then device_name = "COM1"
'                        Open Com device_name & ":4800,n,8,1,CD,CS,DS,RS,BIN" For Binary As #2
'                #ENDIF

                '''Inicia Captura.
                Sample1()

                Close #2 : Close #3


'''STOP
        Elseif x > 619 And x < 665 And y > 14 And y < 44 Then
                buttondown (622, 43, 42)
                
'''CLEAR
        Elseif x > 675 And x < 729 And y > 14 And y < 44 Then
        cleargraph:
                buttondown (678, 43, 50)
                'clearbox (14, 57)
                'graphpos = 14
                clearbox (12, 100)
                inbox (11, 100, 771, 485)        '''Redibuja el Box del Graph View
                
                ''''Define clipping area
                ClippingArea()
                ''''Revert to screen coordinates & Remove the clipping area
                RevertScreen()

                Close #2 : Close #3
                
                
'''EXIT
        Elseif x > 739 And x < 785 And y > 14 And y < 44 Then
                buttondown (742, 43, 42)
                
                Close #2 : Close #3
                
                End



'''IN/OUT BOXES===================================================
'''Box #1
                
'''Box #2
                
'''Box #3
        Elseif x > 403 And x < 538 And y > 14 And y < 43 Then
                clearbox (406, 17)
                Close #2
                Locate 4, 52: Color 25,19: Print "_"        'place the curser
                device_name = ""        'clear the text variable
                Do        'loop until enter or Esc is pressed or the X is clicked
                        getmouse (x, y, , buttons)
                        If buttons > 0 And x < 403 Or buttons > 0 And x > 538 Or buttons > 0 And y < 14 Or buttons > 0 And y > 43 Then Exit Do
                                s = Inkey$        'get a key press
                                If s = Chr(255) & "k" Or s = Chr(27) Then End        'end if Esc is pressed or the X is clicked
                                If s = Chr(13) Then Exit Do                          'exit the box if enter is pressed
                                If s = Chr(8) And Len(device_name) > 0 Then
                                        clearbox (406, 17)
                                        device_name = Left(device_name, Len(device_name) - 1)
                                        Locate 4, 52: Color 25,19: Print device_name & "_"
                                End If
                                If s > "" And Len(device_name) < 15 And s <> Chr(8) Then        'allow only 9 characters
                                        clearbox (406, 17)
                                        device_name = device_name + s
                                        Locate 4, 52: Color 25,19: Print device_name & "_"
                                End If
                                Sleep 20
                Loop
                clearbox (406, 17)
                inbox (403, 14, 131, 26)         '''Redibuja el Box del Device Name
                Locate 4, 52: Color 25,19: Print device_name
                'locate 4, 52: color 0,15: input "", device_name

'''Box #4
        Elseif x > 11 And x < 786 And y > 54 And y < 371 Then
                'clearbox (14, 57)
                'locate 9, 3: color 0,15: print "???"
        'End If

     

'''sliderh #1
        Elseif x > 55 and x < 92 and y > 19 and y < 39 then
                i = sliderh (55, 14, 35)
                scale = 1 + i /1 '1 - i / 1
                'locate 1, 1: color 0, 15: print using "###"; scale
                locate 4,13: color 4,19: print using "###"; scale 'scale 
                If scale = 1 Then v1 = 100 : v2 = 2 : v3 = 1 : v4 = 450 : v5 = 2 : locate 5,14: color 4,19: print "Tiny   "
                If scale = 2 Then v1 = -100 : v2 = 6.5 : v3 = 2 : v4 = 1100 : v5 = 6.5 : locate 5,14: color 4,19: print "Small  "
                If scale = 3 Then v1 = -600 : v2 = 7.5 : v3 = 1 : v4 = 1200 : v5 = 7.5 : locate 5,14: color 4,19: print "Normal "
                
        End if

        Sleep 10
        getmouse (x, y, , buttons)
        Do While x > 1 And buttons > 0: getmouse (x, y, , buttons): Sleep 10: Loop
        buttonup (556,39,50)
        buttonup (620,39,42)
        buttonup (676,39,50)
        buttonup (740,39,42)

Loop    '''Final del Do

'''============================================================================
Sub checkport(filenumber As Integer, delay As Double)
Dim t As Double
t = Timer
While Loc(filenumber) = 0
    If Timer - t > delay Then
        Exit While
    End If
        Sleep 1
Wend
End Sub

'''============================================================================
Sub bttn(x As Integer, y As Integer, s As String)
        Dim As Integer w
        w = Len(s) * 8 + 10
        Draw String (x + 8, y + 10), s
        Draw "C0 BM" & x & "," & y & "D26 R D R D R" & w & "U R U R U26 L U L U L" & w & "D L D L C7 BM" & x + 1 & "," & y + 1 & "BD26 BR BD BR BD R" & w & "U R U R U26 C0"
End Sub

'''============================================================================
Sub buttonup(x As Integer, y As Integer, w As Integer)
        Draw "C15 BM" & x & "," & y & "U24 R U R U R" & w - 2 & "C7 BM" & x + 2 & "," & y + 4 & "R" & w & "U R U R U26"
End Sub

'''============================================================================
Sub buttondown(x As Integer, y As Integer, w As Integer)
        Draw "C15 BM" & x & "," & y & " R " & w & " U R U R U26 C7 BM" & x - 2 & "," & y - 4 & " U24 R U R U R" & w - 2
End Sub

'''============================================================================
Sub inbox(x As Integer, y As Integer, w As Integer, h As Integer)
        Draw "C0 BM" & x & "," & y & " D" & h & " R D R D R" & w & " U R U R U" & h & " L U L U L" & w & " D L D L C7 BM" & x + 1 & "," & y + 1 & " D" & h - 2 & " R D R D R" & w - 2 & " U R U R U" & h - 2 & " L U L U L" & w - 2 & "D L D"
End Sub

'''============================================================================
Sub clearbox(x As Integer, y As Integer)
        Draw "BM" & x & "," & y & "P19,0 C0" '''Canbia Relleno color con lo que tenga Pn
End Sub

'''============================================================================
Sub label(x As Integer, y As Integer, s As String)
        Draw String (x, y), s, 0 '''Color negro etiqueta
End Sub


'''OPEN COM PORT One first samples
'''==============================================================
Sub Sample1()
OPEN Com ("COM1:57600,N,8,1,CD,CS,DS,OP,BIN") FOR Binary AS #2
Get #2,,buffer1()    'Read the port as a file, place the characters in "buffer()"
Close #2

Change_Wait()
Sample2()
Graphing()
End Sub

'''Wait for Change Test Leads
'''==============================================================
Sub Change_Wait()
Color 12
Locate 11, 40 :Print "Change Test Leads  " 
Sleep 3000
Locate 12, 40 :Print "Take Sample2       "
Sleep 1000
Locate 11, 40 :Print "Ending Graph       "
Locate 12, 40 :Print "                   "
End Sub

'''OPEN COM PORT One second samples
'''==============================================================
Sub Sample2()
OPEN Com ("COM1:57600,N,8,1,CD,CS,DS,OP,BIN") FOR Binary AS #3
Get #3,,buffer2()    'Read the port as a file, place the characters in "buffer()"
Close #3
End Sub

'''Graph Sample1 and Sample2
'''==============================================================
Sub Graphing()

Dim As Integer j
Dim As Single xx1, yy1 , x1, y1
Color 2
'screenset 0,0
'Screen 19 

'''Define clipping area
ClippingArea()


FOR j = 15 TO 115      '
     xx1 = buffer1(j)  'Var1
     yy1 = buffer2(j)  'Var2
     
     x1 = v1 + (v2 * xx1) / v3
     y1 = v4 - (v5 * yy1) '/ v6
     
     If j = 15 or j > 115 Then
         Pset(x1,y1)
     Else
         Line -(x1,y1)  '''Grafica los Datos
     End If
     
NEXT j
'Sleep


'''Revert to screen coordinates & Remove the clipping area
RevertScreen()


End Sub

'''============================================================================
Sub ClippingArea()
Dim As Integer x, y

'''Define clipping area
Line (14,100)-(782,585),17,bf
View  (18,105)-(778,580)
cls

'''Estas son las lineas dentro del box #4. Donde se muestra el Gráfico.
'''Horizontales
For y = 1 To 565 Step 50
     Line (1, y)-(750, y), 17
Next y
'''Verticales
For x = 1 To 795 Step 50
     Line (x, 1)-(x, 475), 17
Next x

'''Linea vertical y tramos horizontales peq.
    Line (350, 1)-(350, 475), 3,bf
    For y = 1 To 500 Step 50 '0.5
        Line (335, y)-(365, y), 3
    Next y
'''Linea horizontal y tramos verticales peq.
   Line (1,200)-(750,200), 3,bf
    For x = 1 To 795 Step 50 '0.5
       Line (x, 185)-(x, 215), 3
    Next x

End Sub

'''============================================================================
Sub RevertScreen()
'''Revert to screen coordinates
Window       

'''Remove the clipping area
View Screen 

End Sub


'''============================================================================
function sliderh(x as integer, y as integer, w as integer) as integer
        dim as integer buttons, y1, x1
        draw "C0 BM" & x + 0 & "," & y + 3 & " D20 R" & w + 4 & " U20 L" & w + 4 & " C7 BM" & x + 1 & "," & y + 4 & " D18 R" & w + 2 & " U18  L" & w + 2
        do
                screenlock
                getmouse (x1, y1, , buttons)
                if x1 < x + 10 then x1 = x + 10
                draw"C0 BM" & x + 0 & "," & y + 3 & " D20 R" & w + 4 & " U20 L" & w + 4 & " C7 BM" & x + 1 & "," & y + 4 & " D18 R" & w + 2 & " U18  L" & w + 2
                if x1 > x + w - 6 then x1 = x + w - 6
                draw "BM" & x + 2 & "," & y + 6 & "P19,7"
                draw "BM" & x + 2 & "," & y + 6 & "P19,0 C0 BM" & x + 0 & "," & y + 3 & " D20 R" & w + 4 & " U20 L" & w + 4 & " C7 BM" & x + 1 & "," & y + 4 & " D18 R" & w + 2 & " U18  L" & w + 2
                circle (x1, y + 13), 8,0
                draw "BM" & x1 & "," & y + 13 & "P7,0 C0"
                screenunlock
                sleep 10
        loop while x > 1 and buttons > 0
        return 2 * (x1 - x - 10) / (w - 16)
end function

You can use those source code to understand, and make your program…
VB6 and Java in next post…

I hope you can understand…

9

Ok.

I improve the VB6 (no .NET) source code.
You can download sorce code in the post #6

Here is the new code, old source code very confuse. Now more easy to understand.

'''-----------------------------------------------------------------------------------------

Option Explicit

Dim H(150) As Single
Dim V(150) As Single

Private Sub Command1_Click()        '''Boton Stop

'''Detener la comunicación
 Option1.Value = False              '''Coloca Desactivado Com1 con el BotónOption1
 If MSComm1.PortOpen = True Then
  MSComm1.PortOpen = False
 End If

'''Borrar el contenido de TextBox
Text1.Text = "": Text2.Text = ""
'''Borrar el contenido de la Variables
Erase H(): Erase V()

Picture1.Cls
Call DibujaEntorno
Picture1.CurrentX = 0
Picture1.CurrentY = 0
         
End Sub

Private Sub Command2_Click()        '''Horzontal and Vertical Boton

Picture1.Cls
Call DibujaEntorno
Picture1.CurrentX = 0
Picture1.CurrentY = 0

'''Borrar el contenido de TextBox
Text1.Text = "": Text2.Text = ""

Option1.Value = True               '''Coloca Activado Com1 con el BotónOption1
 If MSComm1.PortOpen = False Then
  MSComm1.PortOpen = True
 End If

'''Toma las Muestras a Graficar.
Call Samples

End Sub

Private Sub Samples()        '''Horzontal and Vertical Boton
Dim Arr() As Byte
Dim i As Integer '

'''Borrar el contenido de la Variables
Erase H(): Erase V(): Erase Arr()

'''First Sample (Horinzontal)
'''-----------------------------------------------------------------------------------------
If MSComm1.CommEvent = comEvReceive And MSComm1.InBufferCount > 0 Then  'Arr = MSComm1.Input '(0)
   
   Arr = MSComm1.Input                       '''Move the new data to a temporary array
    For i = 15 To 114 'NumNewPoints - 1
             
       Text1.Text = Text1.Text & (Arr(i) - 128) & vbNewLine
       
       H(i) = (Arr(i) - 128)
        
    Next i
 End If
 
  MSComm1.InBufferCount = 0


'''Wait a Moment to Change Test Lead
'''-----------------------------------------------------------------------------------------
Call Change_TestLead

'''Second Sample (Vertical)
'''-----------------------------------------------------------------------------------------
Erase Arr()

If MSComm1.CommEvent = comEvReceive And MSComm1.InBufferCount > 0 Then
   
   Arr = MSComm1.Input                      '''Move the new data to a temporary array
    For i = 15 To 114  'NumNewPoints - 1
   
       Text2.Text = Text2.Text & (Arr(i) - 128) & vbNewLine
       
       V(i) = (Arr(i) - 128)

    Next i
End If


'''A moment to refresh
'''-----------------------------------------------------------------------------------------
Call Wait_a_Moment

'''Make Graph
'''-----------------------------------------------------------------------------------------
Call Graphing

End Sub

Private Sub Form_Load()

Call DibujaEntorno

Label1.Caption = "Wait an Action "
Label1.ForeColor = vbBlue

End Sub

Private Sub Option1_Click()

    Const Blocksize = 1 '5               '''number of samples after which the chart shall be updated
    MSComm1.RThreshold = Blocksize       '''fire event if the input buffer contains at least Blocksize new samples
    MSComm1.InputMode = comInputModeBinary
    MSComm1.InBufferSize = 512 ' 256 ' 1024

    MSComm1.CommPort = 1                '''open the serial port
    '''Make sure DTR line is low to prevent Stamp reset
    MSComm1.DTREnable = False
    '''Make sure RTS line is Up'''<----- Very Important
    MSComm1.RTSEnable = True   '''<----- If not True don´t work.

    MSComm1.Settings = "57600,N,8,1"
    MSComm1.PortOpen = True

End Sub

Private Sub Change_TestLead()
Dim PauseTime, Start
PauseTime = 5 '7
  Start = Timer
  Do While Timer <= Start + PauseTime
   Label1.Caption = "Change Test Leads : " & Math.Round((Start + PauseTime + 0.5) - Timer)
   DoEvents
  Loop
End Sub

Private Sub Wait_a_Moment()
Dim PauseTime, Start
PauseTime = 1
Label1.Caption = "Wait a Moment: "
Label1.ForeColor = vbRed
  
  Start = Timer
  Do While Timer <= Start + PauseTime
   Label1.Caption = "Wait a Moment : " & Math.Round((Start + PauseTime + 0.5) - Timer)
   DoEvents
  Loop
Label1.Caption = "Wait an Action "
Label1.ForeColor = vbBlue
End Sub

Private Sub Graphing()
Dim t As Integer

Picture1.DrawWidth = 1
 For t = 0 To UBound(H)
   Picture1.Line -(-H(t) / (HorzVal * 10), -V(t) / (VertVal * 10)), vbRed
   'Picture1.Line -(-H(t) / 50, -V(t) / 50), vbRed
 Next t

End Sub

Private Sub DibujaEntorno(Optional borrar As Boolean = True)
    
    Dim x1 As Single, Y1 As Single, X2 As Single, Y2 As Single
       
    x1 = -2.02   'start X
    X2 = 2.02    'end X
    Y1 = 2.02    'start y
    Y2 = -2.02   'end y

    Picture1.DrawWidth = 2
    Picture1.AutoRedraw = True
    Picture1.Scale (x1, Y1)-(X2, Y2)
    Me.Show
    
    '''Linea horizontal y tramos verticales
    Picture1.Line (x1, 0)-(X2, 0), vbBlack
    For x1 = -4 To 4 Step 0.5
        Picture1.Line (x1, -0.1)-(x1, 0.1), vbBlack
    Next x1
    
    '''Linea vertical y tramos horizontales
    Picture1.Line (0, Y1)-(0, Y2), vbBlack
    For Y1 = -4 To 4 Step 0.5
        Picture1.Line (-0.1, Y1)-(0.1, Y1), vbBlack
    Next Y1
    
End Sub

Private Sub Form_Terminate()            '''Cuando se finaliza el Formulario
 If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
 End If
 End
End Sub

Private Sub Form_Unload(Cancel As Integer)
 If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
 End If
End Sub

[color=#0000FF][size=180]Java very Single Program[/size][/color]
I make a single program in Java. You can modifi to work in Linux and Mac, it’s not difficult.

This program help you to undertand howto Java see rs232 and graph.
Look here capture.

I use: “IDE Neat Beans 7.01”, libraries: rxtx and JfreeChart, other two no remenber, open they are in the Proyect.
You can download java netbean proyect here.
box.net/shared/1njb4ueyf810nd4fguhf

Some comment it’s in spanish.
If I wrong excuse me, I like help only.

Happy day to all nice people, and ugly people… :slight_smile: :slight_smile: