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.
'''==============================================================
'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 TurdGracias a èl y unas modificaciones pude lograr este engendro.
'''============================================================================
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....
