Re: GAMBAS Almenos es basic- Puerto Serie - PIC16F628A
maigke el Lun 7 Sep 2009 - 19:39
- Código:
' Gambas class file
'Variables Globales
PUBLIC flag1 AS Boolean = FALSE
PUBLIC flag2 AS Boolean = FALSE
PUBLIC fTermine AS Boolean = FALSE ' bandera para indicar que ya acabo de mover un servo
'Variables para posicionamiento
PUBLIC S1Pos1 AS Integer PUBLIC S2Pos1 AS Integer PUBLIC S3Pos1 AS Integer PUBLIC S4Pos1 AS Integer
PUBLIC S5Pos1 AS Integer
PUBLIC S1Pos2 AS Integer PUBLIC S2Pos2 AS Integer PUBLIC S3Pos2 AS Integer PUBLIC S4Pos2 AS Integer
PUBLIC S5Pos2 AS Integer
'Variables para HOME
PUBLIC s1 AS Integer PUBLIC s2 AS Integer PUBLIC s3 AS Integer PUBLIC s4 AS Integer PUBLIC s5 AS Integer
PUBLIC vini1 AS Integer PUBLIC vfin1 AS Integer PUBLIC vini2 AS Integer PUBLIC vfin2 AS Integer PUBLIC vini3 AS Integer
PUBLIC vfin3 AS Integer PUBLIC vini4 AS Integer PUBLIC vfin4 AS Integer PUBLIC vini5 AS Integer PUBLIC vfin5 AS Integer
PUBLIC tempo AS Integer
PUBLIC SUB Form_Close()
IF ttyUSB.Status = Net.Active THEN CLOSE ttyUSB
END
'***************************Seccion para la comunicacion del puerto serial
'Esta parte es bastante modificable
PUBLIC SUB Check_Status()
ChkDSR.Value = ttyUSB.DSR
ChkDTR.Value = ttyUSB.DTR
ChkCTS.Value = ttyUSB.CTS
ChkRTS.Value = ttyUSB.RTS
ChkDCD.Value = ttyUSB.DCD
ChkRNG.Value = ttyUSB.RNG
END
PUBLIC SUB Form_Open()
cmdVelocidad.Index = cmdVelocidad.Find("115200") 'Lo que sigue no es valido separa las lineas indicadas por ';'
vini1 = 0; vfin1 = 0; vini2 = 0; vfin2 = 0; vini3 = 0; vfin3 = 0; vini4 = 0; vfin4 = 0; vini5 = 0; vfin5 = 0; sldS1.Value = 250
sldS2.Value = 250; sldS3.Value = 250; sldS4.Value = 250; sldS5.Value = 250
END
PUBLIC SUB Button1_Click()
ME.Close
END
PUBLIC SUB cmdAbreCierra_Click()
IF ttyUSB.Status = Net.Active THEN
CLOSE ttyUSB
cmdAbreCierra.Text = "Abre"
ELSE
'Linea de parametros
ttyUSB.PortName = txtPortText.Text
ttyUSB.Speed = cmdVelocidad.Text
ttyUSB.Parity = cmbParidad.Index
ttyUSB.DataBits = cmbDataBits.Text
ttyUSB.FlowControl = cmbControlFlujo.Index
ttyUSB.StopBits = cmbBitParo.Text
ttyUSB.Open()
Check_Status()
TextArea1.Text = "Puerto Abierto : " & ttyUSB.PortName & " Ajustes : " &
ttyUSB.Speed & " , " & ttyUSB.Parity & " , " & ttyUSB.DataBits & " , " &
ttyUSB.StopBits & " , " & Chr(13) & Chr(10)
cmdAbreCierra.Text = "Cierra"
ENDIF
END
'Funcion para leer puerto serial RS232
PUBLIC SUB ttyUSB_Read()
DIM s AS String
IF TabStrip1.Text = "Configuracion" THEN
READ #ttyUSB, s, Lof(ttyUSB)
TextArea1.Text = TextArea1.Text & s
ELSE IF TabStrip1.Text = "Servo 1" THEN
READ #ttyUSB, s, Lof(ttyUSB)
TextArea2.Text = TextArea2.Text & s
ELSE IF TabStrip1.text = "Servo 2" THEN
READ #ttyUSB, s, Lof(ttyUSB)
TextArea3.Text = TextArea3.Text & s
ELSE IF TabStrip1.Text = "Servo 3" THEN
READ #ttyUSB, s, Lof(ttyUSB)
TextArea4.Text = TextArea4.text & s
ELSE IF TabStrip1.Text = "Servo 4" THEN
READ #ttyusb, s, Lof(ttyUSB)
TextArea5.Text = TextArea5.text & s
ELSE IF TabStrip1.Text = "Servo 5" THEN
READ #ttyUSB, s, Lof(ttyUSB)
TextArea6.Text = TextArea6.Text & s
ENDIF
END
PUBLIC SUB ttyUSB_RNGChange(ival AS Boolean)
ChkRNG.Value = ival
END
PUBLIC SUB ttyUSB_DTRChange(ival AS Boolean)
ChkDTR.Value = ival
END
PUBLIC SUB ttyUSB_DSRChange(ival AS Boolean)
ChkDSR.Value = ival
END
PUBLIC SUB ttyUSB_CTSChange(ival AS Boolean)
ChkCTS.Value = ival
END
PUBLIC SUB ttyUSB_DCDChange(ival AS Boolean)
ChkDCD.Value = ival
END
PUBLIC SUB ttyUSB_RTSChange(ival AS Boolean)
ChkRTS.Value = ival
END
PUBLIC SUB ChkDTR_Click()
ttyUSB.DTR = ChkDTR.Value
Check_Status
END
PUBLIC SUB ChkRTS_Click()
ttyUSB.RTS = ChkRTS.Value
Check_Status
END
PUBLIC SUB cmbControlFlujo_Click()
ttyUSB.FlowControl = cmbControlFlujo.Index
END- Esta parte es la que envia los datos a los
seisservos upps, ¿de cuál fumé? si son solo 5
- Código:
'************************************************************************************************
PUBLIC SUB cmdAtras_Click()
IF ttyUSB.Status = Net.Inactive THEN
Message("Primero abre el Puerto")
ELSE
PRINT #ttyUSB, "a"
ToolButton2.Background = &FF0000&
ToolButton2.Text = "A"
WAIT 0.3 'Este retardo es para el parpadeo, entre colores, pero no tiene mucho caso
ToolButton2.BackColor = &00FF00&
ToolButton2.Text = ""
ENDIF
END
PUBLIC SUB cmdAdelante_Click()
IF ttyUSB.Status = Net.Inactive THEN
Message("Primero abre el puerto")
ELSE
PRINT #ttyUSB, "11"
ToolButton1.Background = &FF0000&
ToolButton1.Text = "1"
WAIT 0.3
ToolButton1.Background = &00FF00&
ToolButton1.text = ""
ENDIF
END
'**************************************************************************
'Control del primer servo
'Para el envio de datos, fue probada la tarjeta con varios valores
'en el tiempo medido por osciloscopio, cuando la tarjeta es reiniciada
'con escala de 0.5ms por division, el tiempo en alto esta establecido a 1500ms
'tomado este valor como referencia, el slider y el spinbox, tienen el valor de
'250 de forma inicial, ya fueron medidos los tiempos de forma repetida, para
'verificar la presición del numero de datos enviados a la tarjeta.
PUBLIC SUB spnboxS1_Change()
DIM maximo AS Integer
DIM i AS Integer
sldS1.Value = spnboxS1.Value
vfin1 = spnboxS1.Value
tempo = 0
tempo = Abs(vfin1 - vini1)
'TextArea2.Text = "Vini1=" & vini1 & " Vfin1= " & vfin1 & " ciclo= " & tempo
'wait 1
IF (vfin1 - vini1) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "AAA"
ToolButton2.Background = &FF0000&
ToolButton2.Text = "A"
WAIT 0.1 'Este retardo es importante, ya que la tarjeta no responde muy rápido
ToolButton2.BackColor = &00FF00&
ToolButton2.Text = ""
NEXT
maximo = 0
ELSE
ENDIF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "111"
ToolButton1.Background = &FF0000&
ToolButton1.Text = "1"
WAIT 0.1
ToolButton1.Background = &00FF00&
ToolButton1.text = ""
NEXT
maximo = 0
ELSE
ENDIF
ENDIF
vini1 = vfin1
tempo = 0
fTermine = TRUE
END
'**********************************************************************************
PUBLIC SUB sldS1_Change()
DIM maximo AS Integer
DIM i AS Integer
spnboxS1.Value = sldS1.Value
vfin1 = spnboxS1.Value
tempo = 0
tempo = Abs(vfin1 - vini1)
'TextArea2.Text = "Vini1=" & vini1 & " Vfin1= " & vfin1 & " ciclo= " & tempo
'WAIT 1
IF (vfin1 - vini1) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "A"
ToolButton2.Background = &FF0000&
ToolButton2.Text = "A"
WAIT 0.1
ToolButton2.BackColor = &00FF00&
ToolButton2.Text = ""
NEXT
maximo = 0
ELSE
ENDIF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "1"
ToolButton1.Background = &FF0000&
ToolButton1.Text = "1"
WAIT 0.1
ToolButton1.Background = &00FF00&
ToolButton1.text = ""
NEXT
maximo = 0
ELSE
ENDIF
ENDIF
vini1 = vfin1
tempo = 0
fTermine = TRUE
END
'***********************************************************************************
'Control del segundo servo
PUBLIC SUB spnboxS2_Change()
DIM maximo AS Integer
DIM i AS Integer
sldS2.Value = spnboxS2.Value
vfin2 = spnboxS2.Value
tempo = 0
tempo = Abs(vfin2 - vini2)
'Usese solo en caso de que olvide el cable de comicacion como a mi me paso :(
'TextArea3.Text = "Vini2=" & vini2 & " Vfin2= " & vfin2 & " ciclo= " & tempo
' WAIT 1
IF (vfin2 - vini2) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "B"
ToolButton3.Background = &FF0000&
ToolButton3.Text = "B"
WAIT 0.1 'Este retardo es importante, ya que la tarjeta no responde muy rápido
ToolButton4.BackColor = &00FF00&
ToolButton4.Text = ""
NEXT
maximo = 0
ELSE
ENDIF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "2"
ToolButton1.Background = &FF0000&
ToolButton1.Text = "2"
WAIT 0.1
ToolButton1.Background = &00FF00&
ToolButton1.text = ""
NEXT
maximo = 0
ELSE
ENDIF
ENDIF
vini2 = vfin2
tempo = 0
END
'**********************************************************************************
PUBLIC SUB sldS2_Change()
DIM maximo AS Integer
DIM i AS Integer
spnboxS2.Value = sldS2.Value
vfin2 = spnboxS2.Value
tempo = 0
tempo = Abs(vfin2 - vini2)
IF (vfin2 - vini2) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "B"
ToolButton2.Background = &FF0000&
ToolButton2.Text = "B"
WAIT 0.1
ToolButton2.BackColor = &00FF00&
ToolButton2.Text = ""
NEXT
maximo = 0
ELSE
ENDIF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "1"
ToolButton2.Background = &FF0000&
ToolButton2.Text = "1"
WAIT 0.1
ToolButton2.Background = &00FF00&
ToolButton2.text = ""
NEXT
maximo = 0
ELSE
ENDIF
ENDIF
vini2 = vfin2
tempo = 0
fTermine = TRUE
END
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Control del tercer servo
PUBLIC SUB spnboxS3_Change()
DIM maximo AS Integer
DIM i AS Integer
sldS3.value = spnboxS3.Value
vfin3 = spnboxS3.Value
tempo = 0
tempo = Abs(vfin3 - vini3)
IF (vfin3 - vini3) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "C"
ToolButton5.BackColor = &FF0000&
ToolButton5.Text = "C"
WAIT 0.1
ToolButton5.BackColor = &00FF00&
ToolButton5.Text = ""
NEXT
maximo = 0
ELSE
END IF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "3"
ToolButton6.BackColor = &FF0000&
ToolButton6.Text = "3"
WAIT 0.1
ToolButton6.BackColor = &00FF00&
ToolButton6.Text = ""
NEXT
maximo = 0
ENDIF
END IF
vini3 = vfin3
tempo = 0
fTermine = TRUE
END
PUBLIC SUB sldS3_Change()
DIM maximo AS Integer
DIM i AS Integer
spnboxS3.value = sldS3.Value
vfin3 = sldS3.Value
tempo = 0
tempo = Abs(vfin3 - vini3)
IF (vfin3 - vini3) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "C"
ToolButton5.BackColor = &FF0000&
ToolButton5.Text = "C"
WAIT 0.1
ToolButton5.BackColor = &00FF00&
ToolButton5.Text = ""
NEXT
maximo = 0
ELSE
END IF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "3"
ToolButton6.BackColor = &FF0000&
ToolButton6.Text = "3"
WAIT 0.1
ToolButton6.BackColor = &00FF00&
ToolButton6.Text = ""
NEXT
maximo = 0
ENDIF
END IF
vini3 = vfin3
tempo = 0
fTermine = TRUE
END
'***********************************************************************************************************
'Control del 4to servo
PUBLIC SUB spnboxS4_Change()
DIM maximo AS Integer
DIM i AS Integer
sldS4.value = spnboxS4.Value
vfin4 = spnboxS4.Value
tempo = 0
tempo = Abs(vfin4 - vini4)
IF (vfin4 - vini4) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "D"
ToolButton7.BackColor = &FF0000&
ToolButton7.Text = "D"
WAIT 0.1
ToolButton7.BackColor = &00FF00&
ToolButton7.Text = ""
NEXT
maximo = 0
ELSE
END IF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "4"
ToolButton8.BackColor = &FF0000&
ToolButton8.Text = "4"
WAIT 0.1
ToolButton8.BackColor = &00FF00&
ToolButton8.Text = ""
NEXT
maximo = 0
ENDIF
END IF
vini4 = vfin4
tempo = 0
fTermine = TRUE
END
PUBLIC SUB sldS4_Change()
DIM maximo AS Integer
DIM i AS Integer
spnboxS4.value = sldS4.Value
vfin4 = sldS4.Value
tempo = 0
tempo = Abs(vfin4 - vini4)
IF (vfin4 - vini4) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "D"
ToolButton7.BackColor = &FF0000&
ToolButton7.Text = "D"
WAIT 0.1
ToolButton7.BackColor = &00FF00&
ToolButton7.Text = ""
NEXT
maximo = 0
ELSE
END IF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "4"
ToolButton8.BackColor = &FF0000&
ToolButton8.Text = "4"
WAIT 0.1
ToolButton8.BackColor = &00FF00&
ToolButton8.Text = ""
NEXT
maximo = 0
ENDIF
END IF
vini4 = vfin4
tempo = 0
fTermine = TRUE
END
'***********************************************************************************************************
'control Servo 5
PUBLIC SUB spnboxS5_Change()
DIM maximo AS Integer
DIM i AS Integer
sldS5.value = spnboxS5.Value
vfin5 = spnboxS5.Value
tempo = 0
tempo = Abs(vfin5 - vini5)
IF (vfin5 - vini5) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "E"
ToolButton9.BackColor = &FF0000&
ToolButton9.Text = "E"
WAIT 0.1
ToolButton9.BackColor = &00FF00&
ToolButton9.Text = ""
NEXT
maximo = 0
ELSE
END IF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "5"
ToolButton10.BackColor = &FF0000&
ToolButton10.Text = "5"
WAIT 0.1
ToolButton10.BackColor = &00FF00&
ToolButton10.Text = ""
NEXT
maximo = 0
ENDIF
END IF
vini5 = vfin5
tempo = 0
fTermine = TRUE
END
PUBLIC SUB sldS5_Change()
DIM maximo AS Integer
DIM i AS Integer
spnboxS5.value = sldS5.Value
vfin5 = sldS5.Value
tempo = 0
tempo = Abs(vfin5 - vini5)
IF (vfin5 - vini5) < 0 THEN
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "E"
ToolButton9.BackColor = &FF0000&
ToolButton9.Text = "E"
WAIT 0.1
ToolButton9.BackColor = &00FF00&
ToolButton9.Text = ""
NEXT
maximo = 0
ELSE
END IF
ELSE
IF ttyUSB.Status = Net.Active THEN
maximo = tempo
FOR i = 1 TO maximo
PRINT #ttyUSB, "5"
ToolButton10.BackColor = &FF0000&
ToolButton10.Text = "5"
WAIT 0.1
ToolButton10.BackColor = &00FF00&
ToolButton10.Text = ""
NEXT
maximo = 0
ENDIF
END IF
vini5 = vfin5
tempo = 0
fTermine = TRUE
END
'***********************************************************************************************************- La última parte del código borra los textareas y manda a posicionar al servo, aqui hay una parte importante con un ciclo while - wend, y tiene mucho que ver la bandera que puse en cada seccion de movimiento de servos, ya que sin esta bandera no se saldría de dicho ciclo.
- Código:
'Area de borrados de textAreas, cada text area solo contendra la info necesaria para su propio servo
PUBLIC SUB cmdBorrar_Click()
TextArea2.Text = ""
END
PUBLIC SUB Button2_Click()
TextArea3.Text = ""
END
PUBLIC SUB Button3_Click()
TextArea4.Text = ""
END
PUBLIC SUB Button4_Click()
TextArea5.Text = ""
END
PUBLIC SUB Button5_Click()
TextArea6.Text = ""
END
'Rutina de grabar las posiciones de los servos
PUBLIC SUB cmdGrabar_Click()
IF flag1 = FALSE AND flag2 = FALSE THEN
cmdGrabar.Text = "Grabar"
S1Pos1 = spnboxS1.Value
S2Pos1 = spnboxS2.Value
S3Pos1 = spnboxS3.Value
S4Pos1 = spnboxS4.Value
S5Pos1 = spnboxS5.Value
flag1 = TRUE
ELSE IF flag1 = TRUE AND flag2 = FALSE THEN
S1Pos2 = spnboxS1.Value
S2Pos2 = spnboxS2.Value
S3Pos2 = spnboxS3.Value
S4Pos2 = spnboxS4.Value
S5Pos2 = spnboxS5.Value
flag2 = TRUE
ELSE
Message.Error("Solo dos posiciones")
cmdGrabar.Text = "Borra"
S1Pos1 = 0
S1Pos2 = 0
S2Pos1 = 0
S2Pos2 = 0
S3Pos1 = 0
S3Pos2 = 0
S4Pos1 = 0
S4Pos2 = 0
S5Pos1 = 0
S5Pos2 = 0
flag1 = FALSE
flag2 = FALSE
END IF
END
PUBLIC SUB cmdHome_Click()
s1 = spnboxS1.Value
s2 = spnboxS2.Value
s3 = spnboxS3.Value
s4 = spnboxS4.Value
s5 = spnboxS5.Value
TextArea1.text = "Home ha sido selecionado con las siguientes
posiciones " & s1 & " " & s2 & " " & s3 & " "
& s4 & " " & s5
'TabStrip1.Action =
END
PUBLIC SUB ToolButton11_Click()
'Ir a home
'Colocamos una bandera que se llama fTermine que nos indica si un ciclo de envio de datos ya termino
' ahora preguntamos si los valores del spinbox y del valor dado como home son iguales
' esto pasa si un eje no lo mueves desde un inicio, en caso de ser cierto, pues entonces
' no hace nada, ya que si no se pone el if por alguna razon entra en un bucle infinito
' si los valores actuales del spinbox y de la pos de home no son iguales,
' mandamos a modificar ahora el valor del spinbox, enviando los correspondientes
' a través del puerto serial
fTermine = FALSE
IF (spnboxS1.Value <> s1) THEN
spnboxS1.Value = s1
WHILE fTermine = FALSE
WEND
END IF
fTermine = FALSE
IF (spnboxS2.Value <> s2) THEN
spnboxS2.Value = s2
WHILE fTermine = FALSE
WEND
END IF
fTermine = FALSE
IF (spnboxS3.Value <> s3) THEN
spnboxS3.Value = s3
WHILE fTermine = FALSE
WEND
END IF
fTermine = FALSE
IF (spnboxS4.Value <> s4) THEN
spnboxS4.Value = s4
WHILE fTermine = FALSE
WEND
END IF
fTermine = FALSE
IF (spnboxS5.Value <> s5) THEN
spnboxS5.Value = s5
WHILE fTermine = FALSE
WEND
END IF
'Ir a la posicion 1
'Ir a la posicion 2
'Regresar a home
END