TODOPIC
Lenguajes de programación para PC => Visual Basic => Mensaje iniciado por: IAO en 15 de Enero de 2009, 18:53:19
-
Holaaaaa:
Hice un pequeño programa en VB6 para recibir datos del osciloscopio HPS40.
Pienso que puede funcionar con cualquier equipo que mande formato ASCII.
Me dió muchos problemas....,
Solo les comentaré que tenía que activar el RTS del puerto serial en el programa de VB6.
Por ese detalle del RTS, no me recibía nada. Todo lo demás estaba bien.
Bueno espero le sea de ayuda a alguien.
Código VB6 recibiendo datos HPS40 Scope (http://www.box.net/shared/lp89o3rrdg)
Otra cosa más, el recibe la info en sentido inverso, -1.543 al recibir es 345.1- Jajaja que locura...
debo corregir eso. No sé como, pero en unos días lo acomodo.
Bye('_')......
-
A mí me vendrá muy bien IAO (cuando sea capaz de encontrar tiempo para volver a usar el osciloscopio). Muchas gracias.
-
Por cierto, ¿sabes que aquí http://www.velleman.be/be/en/download/files/ tienes el software para el velleman incluida la librería vb-run verdad?
-
Holaaaa:
Sr. jfmateos2:
Como está, bueno espero que bien. Sabía que tú y otro compañero que compró uno, podría necesitarlo
en algún momento.
Si, yo bajé esos programas pero quería hacer algo diferente. Cuando lo termine lo publico aquí mismo.
Ni te imaginas lo que pasé para poder ver el código ascii en el TextBox. :)
Fue una odisea como la novela de Omero. :D
Mejoralo cuando puedas ese código es todo tuyo. Cuando estaba trabajando me recordaba de ustedes y decía
ellos lo pueden llegar a necesitarlo también. :-/.
-
Por otra parte, hice las pruebas hace un rato con un Multimetro Digital: Marca UNI-T, Modelo: UT70B,
cambié unas cositas y listo, 8 meses intentandolo y hoy ya recibo la data ascii.
Lo que cambié en el M.Digital fue esto:
......
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
........
Me parece que sr. flacoclau tiene uno parecido, espero le pueda servir también.
Les comento que todo el truco está en el DTREnable y RTSEnable, fijense que
en el de HPS40 está configurado diferente.
Bueno es todo......
Con todo cariño para ustedes, por un feliz año nuevo Jojojojojo
Bye('_').....
Repito: Pienso que puede funcionar con cualquier equipo que mande formato ASCII.
Solo hay que saber jugar con RTS y DTR.
-
Holaaaaa:
Ya logré recibir la data en forma correcta, no invertida. Era una tontería.
En el código donde aparece
Text1.Text = sData & Text1.Text & vbCrLf
Cambielo por esto:
Text1.Text = Text1.Text & sData '& vbCrLf
Ahora recibe los datos en forma adecuada. 123.35 --> 123.35 al recibir en VB6.
Es válido tanto para el D.Multimeter como para el Osciloscopio.
Bye('_').....
-
Holaaaaa:
Es una tonteria, pero quería que vieran como va quedando..Falta pero pronto terminaré.
(http://img144.imageshack.us/img144/6001/captura5ec6.jpg) (http://imageshack.us)
(http://img144.imageshack.us/img144/captura5ec6.jpg/1/w676.png) (http://g.imageshack.us/img144/captura5ec6.jpg/1/)
Bye('_')....
-
Hola IAO!!!
Como a Jfmateos me va a venir muy bien!!
Muchas gracias!!!!
¿Has probado a unir el RTS y el CTS en el conector?
Normalmente, si lo haces, engañas al puerto y no tienes que implementar el RTS.
Lo dicho, muchísimas gracias
-
Holaaa:
Hola compañero Slalen:
Es un gusto que les pueda servir en su momento. De verdad no he probado y ni sabía
lo de unir RTS con CTS, pero le prometo que realizaré pruebas a ver que tal.
Mientras menos código hay. pienso que es mejor. :D.
Ya voy a comenzar la parte de los gráficos en el picture y pensé que estaba cubierto,
pero ayer me dí cuenta que la cosa se me va a poner bien pelua.
Ya veremos...hay que esperar un poco.
Bye('_')....
-
Holaaaaaa:
Okey después de meses ya terminé este programita ayer.
Es muy básico, pero funciona. Se requiere más conocimientos para dejarlo fino, fino.
Está funcionando, pueden modificarlo a su gusto. Es todo suyo
Dentro del Zip hay un Documento en word. Para entenderlo un poco mejor.
Fuente del Programa VB6.... (http://www.box.net/shared/7mcbn6pxb3)
Aquí una captura del Programa....
Captura programa Graficando.... (http://img269.imageshack.us/img269/9067/capture3igi.png)
Espero les guste.
Saludos
-
Muchas gracias IAO, me vendrá muy bien porque creo que el programa que venía con el osciloscopio sólo permitía capturar un número de muestras limitado.
Gracias por compartirlo.
-
Hola jfmateos2.....
Si solo quieres recibir datos y tomarlos o copiarlos desde un TexBox, usa este programa:
Recepción Modo Binario (http://www.box.net/shared/37bunr3g5m)
Solo tienes que parar o detener tu mismo la comunicación con el botón Stop.
El HPS40 debe estar modo Binary. Funciona bien.
Aquí esta un programa hecho por un ruso en delphi7, es mejor que original de Velleman.
Te lo recomiendo ampliamente.....
HPS40 Ruso (http://74.125.115.132/translate_c?hl=ru&sl=ru&tl=en&u=http://www.hardlock.org.ua/download/file.php%3Fjump%3D30&prev=hp&rurl=translate.google.ru&usg=ALkJrhhpRMo5GfCv-kEnTuX093s30Qb5Jg)
Esta es la página del Ruso, dale un vistazo con el traductor de google..le adaptó un USB al propio osciloscopio.
Pagina Web del Ruso HardLock (http://www.hardlock.org.ua/soft/hps40/index.html)
Bueno, espero te sea de utilidad......
-
Grande Ruben, y como repiten por aquí: Gracias por compartirlo con todos. :-/ :-/
-
muchas gracias!!
Acabo de volver de marruecos y dentro de un rato me voy a salamanca, hasta septiembre no podré probarlo :(
-
Me parece que sr. flacoclau tiene uno parecido, espero le pueda servir también.
Gracias Iao por acordarte, pero el mío no tiene puerto :(
Saludos amigo!!
-
Hola....
Bueno PalitroqueZ.... Aqui andamos para darnos una manita.... Esto no es nada pero me dió batalla.
Ese MsComm de VB6 es medio diabólico. Te comento que más abajo coloco el link de uno que hice en FreeBasic,
super sencillo, sin tanto perolero que usa el VB6 y trabaja bien. Te invito a que veas el código.
A Jfmateos2 y Slalen, aparte del fuente hay un ejecutable. Pero si dudais de mi, pueden bajarse
el FreeBasic, compilarlo y modificarlo a su gusto. Es tan sencillo que me gusta más que el de VB6.
De verdad quedé mas enamorado de FreeBasic. Lo adoro.
flacoclau lo lamento, pero lo tenia en mis pensamientos cuando pase la información para el Multimetro UNI-T.
Bueno para otros más servirá.
Aqui está el link para el fuente y ejecutable.
Fuente Ejecutable (http://www.box.net/shared/dsgl65rqz3)
Una captura de una de las tantas pruebas, en etapa de desarrollo, no se había finalizado.
(http://img33.imageshack.us/img33/9495/capture4i.jpg)
Espero les sea de utilidad.....Aunque sino les es útil, por lo menos se aprende algo nuevo....
Saludos a todos, se les quiere..... Bye('_')....
-
Muchas gracias IAO!!!
Tengo muchas ganas de probarlo!!!
El día 1 vuelvo a madrid, a ver si el 2 como tarde lo pruebo :mrgreen:
-
Hola..
Hice unas mejoras a esos programitas hechos en FreeBasic. La forma de onda que se dibuja permanece en una
ventana y no sale fuera de ella.
Ya les paso los fuentes.
Si no les sirve para nada, por lo menos el còdigo ayuda para entender cosas. Recuerden que està elaborado
con FreeBasic deberìa correr con linux tambièn, cabiando solo la parte de la entrada COM..
Este fue el primero que hice y està mejorado.
(http://img814.imageshack.us/img814/3779/ivhps401t.th.jpg) (http://imageshack.us/photo/my-images/814/ivhps401t.jpg/)
'''==============================================================
'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
Este llevo 4 o 5 dias terminandolo, tome muchas ideas del programa de un tal sr Turd Link sr Turd (http://www.freebasic.net/forum/viewtopic.php?t=13416&highlight=picaxe)
Gracias a èl y unas modificaciones pude lograr este engendro.
(http://img14.imageshack.us/img14/4812/ivhps401bg.th.jpg) (http://imageshack.us/photo/my-images/14/ivhps401bg.jpg/)
'''============================================================================
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
Espero les pueda servir de algo. Aunque sea de referencia para algùn otro proyecto.
El segundo ejemplo es màs dificil la parte del còdigo.... pero quedo bonito.
Saludos para todos....
-
error
Puede algùn moderador eliminar esta publicaciòn que esta inutil
-
HOla IAO,
Que bonito resultado. Felicitaciones se ve muy bien!.
Interesante la plataforma freeBASIC, no la conocía.
-
Gracias sr LABmouse...
Sabes que me decidì estudiar Java y mientras leìa de aquì y de allà, me recorde de este programa
y me diò una puntada por mejorarlo.
Bueno creo que valiò la pena el esfuerzo. Ahora intentarè hacerlo en java, porque VB6 no quiero utilizarlo màs.
Y no quiero usar la plataforma .NET.
Bueno, saludos igual para todos....
-
Hola....
Solo quería agregar que mejoré el programa de VB6, funciona mejor y tiene menos código.
Le quité montón de lineas que eran inútiles en realidad.
Le quité los timer que me tenían loco y eran estorbo y quité otras cosas que me fastidiaban. :)
Si alguna persona quiere revisar el código para tener ideas de como hacer algo en
su proyecto, aquí esta el link con la actualización..
Dentro del Zip hay un Documento en word. Para entenderlo un poco mejor.
Fuente actualizadoVB6 (http://www.box.net/shared/7mcbn6pxb3)
Saludos para todos... :)