TODOPIC
Lenguajes de programación para PC => Visual Basic => Mensaje iniciado por: IAO en 08 de Septiembre de 2007, 13:52:49
-
Holaaaaaaaaa:
Les comento que llevo dias intentando activar un segundo (form2) desde el primer form1.
Ayer lo hice funcionar lo mejor que pude. Pero me quedo con un detalle. No es un error,
el detalle es que no me muestra la aguja del control analógico en el segundo form.
(http://img339.imageshack.us/img339/5030/forohelpwy8.png)
Les paso el código, a ver si algún cerebro en programación, entiende algo, que no logro resolver.
He logrado que se active y desactive al finalizar el programa, que si el control paterno bla,bla,bla.
'''==========El primer Formulario
Private Sub Command1_Click() 'Recibir Datos del PIC (Botón)
''' Send Out Data
If MSComm1.PortOpen = True Then
MSComm1.Output = Chr$(&H61) 'Envía el caracter "a" al PIC para recibir Datos.
End If
End Sub
Private Sub Command2_Click() 'Boton de Reset LED´s.
Dim Bit(0 To 15) As Integer
Dim Ciclo As Integer
'''Coloca a 0, mejor dicho apaga todos los LED's.
For Ciclo = 0 To 15
Led(Ciclo).Picture = LoadPicture(App.Path + "\LG.BMP")
Bit(Ciclo) = False
Next Ciclo
End Sub
Private Sub Form_Load() 'Cuando se carga el Formulario
'''Mantiene el Formulario en primer plano no se oculta al Cambiar de Programa.
Siempre_Encima RS232MON, True
'''=========================================================
'Muestra el Formulario "FormMeter" y se hace propietario, asegura que se cierre el dialogo.
FormMeter.Show vbModeless, RS232MON
End Sub
Private Sub Option1_Click() 'Option1 que es el COM1 (h)
Text1.Text = "Esperando"
''' Fire Rx Event Every one Bytes
MSComm1.SThreshold = 0
MSComm1.RThreshold = 2 'Produce el evento de arribo de datos. 1 para 1byte ó 2 para 2byte.
''' When Inputting Data, Input 2 Bytes at a time
MSComm1.InputLen = 2 '2 Para recibir 2 bytes
''' Use COM1
MSComm1.CommPort = 1 'para COM1 ó 2 para COM2
''' 9600 baud, no parity, 8 data bits, 1 stop bit
MSComm1.Settings = "9600,N,8,1"
''' Make sure DTR line is low to prevent Stamp reset
MSComm1.DTREnable = False
''' Open the port
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
'''Cierra el Form del Medidor Analógico. Evita que quede abierto.
Unload FormMeter
End Sub
Private Sub MSComm1_OnComm()
Dim sData As String
Dim t As Integer
Dim valor As Double '''En el Pto. Paralelo era Integer (8 Bits a mostrar)
'''aquí lo pasé a Double porque el valor es más grande (16 Bits a mostrar)
'''Aunque el Integer debería ser suficiente para 16 bits le coloque Double
'''porque da un error de Desbordamiento.
Dim valor2 As Integer
Dim Bit(0 To 15) As Integer
Dim Ciclo As Integer
Dim Recorre As Byte '''Parte del Maestro BrunoF.
If Option1.Value = True Then
Select Case MSComm1.CommEvent
Case comEvReceive 'recibo 2 bytes
For t = 1 To 2
sData = sData & MSComm1.Input
Next t
Text1.Text = sData
End Select
Text2.Text = pasarHexADecimal(sData) '''Funcion que esta en el módulo
valor2 = Val("&H" & swap(sData) & "&")
Label4.Caption = (valor2 * 5) / 1023
valor = pasarHexADecimal(sData)
'''Parte donada por el Maestro BrunoF.
For Recorre = 0 To 15
If (valor And 2 ^ Recorre) = 0 Then Bit(Recorre) = 1 Else Bit(Recorre) = 0
Next
'''Controla los Led's de estado.
For Ciclo = 0 To 15 '''15 porque son 16 bits (16 LED's a visualizar)
If Bit(Ciclo) = 0 Then _
Led(Ciclo).Picture = LoadPicture(App.Path + "\LV.BMP") _
Else Led(Ciclo).Picture = LoadPicture(App.Path + "\LG.BMP")
Next Ciclo
End If
End Sub
' Para intercambiar los bytes
Function swap(dos_bytes As String) As String
Dim a As String
a = Right$(dos_bytes, 2)
a = a & Left$(dos_bytes, 2)
swap = a
End Function
'''=============El Medidor Analógico
'''=========================================================
Dim sl As Integer
Dim r1 As Double
Dim r2 As Double
Const vbPI = 3.141592654
Const Deg2Rad = vbPI / 180 'Degrees to Radians
Dim cx As Integer, cy As Integer, r As Single
Dim s As Double
'''Hechas por el Ser IAO.
Dim Mdeg As Integer
Dim sin_ As Double
Dim cos_ As Double
Dim oldcolor As Double
Dim Resp As Long
'''=========================================================
Private Sub Form_Load() 'Cuando se carga el Formulario
Siempre_Encima FormMeter, True
'''Es para hacer transparente el form.
'Resp = SetWindowLong(Me.hwnd, -20, &H20&)
'FormMeter.Refresh
VScroll1(0).Value = 0 '''Coloca a cero el Scroll.
End Sub
'''Es para el Analog Meter.
Private Sub analogmeter(Index As Integer, Mtype As Integer, Emin As Double, Emax As Double, _
Mmin As Double, Mmax As Double, Handw As Integer, Color As String, Handl As Double, _
Value As Double)
Mdeg = 270 ' degrees (0-360)
cx = Picture1(0).Width / 2
cy = (Picture1(0).Height - 2)
''' Scale the dial hand length
r = IIf(cx > cy, cy, cx) - 5
sl = r * Handl 'length of meter hand
''' Scale the Engineering Units
r1 = Emax - Emin
r2 = Mmax - Mmin
s = ((r2 / r1) * Value) + Mmin
''' Draw the dial hand
sin_ = Sin((Mdeg - s * 6) * Deg2Rad) * (r - sl) + cx
cos_ = Cos((Mdeg - s * 6) * Deg2Rad) * (r - sl) + cy
oldcolor = vbBlack
Picture1(0).ForeColor = Color
Picture1(0).DrawWidth = Handw
Picture1(0).Cls
Picture1(0).Line (cx, cy)-(sin_, cos_)
Picture1(0).ForeColor = oldcolor
End Sub
Private Sub VScroll1_Change(Index As Integer)
''' Update Meter values
Label5(0) = VScroll1(0).Value
analogmeter 0, 2, 0, 11, 0, 30, 2, vbRed, 0.1, VScroll1(0).Value
' | | | | | | |__Largo de la Aguja.
End Sub ' | | | | | |__Grosor de la aguja.
' | | | | |__
' | | | |__Posición de la aguja en cero.
' | | |__Puntos a medir, o en cuantos pasos llega a 5.
' | |__
' |__Centro de la aguja con el Formulario.
'
La pregunta es, ¿por qué la aguja no se muestra al cambiar vscroll? .
Si corro el mismo código del Reloj Analógico en un formulario aparte, funciona bien.
Si me ayudan le beso los pies. :D
Gracias anticipadamente.
Bye('_').
Nota: Si necesita todo el VBP, FRM, se los paso. Pero quiero publicarlo todo, cuando lo termine.
Mientras es más emocionante el suspenso.
-
Private Sub Option1_Click() 'Option1 que es el COM1 (h)
Text1.Text = "Esperando"
''' Fire Rx Event Every one Bytes
MSComm1.SThreshold = 0
MSComm1.RThreshold = 1
''' When Inputting Data, Input 2 Bytes at a time
MSComm1.InputLen = 2 '2 Para recibir 2 bytes
Ojo con esto...
RThreshold es el que produce el evento de arribo de datos. Si RThreshold = 1, entonces cada vez que llegue un byte, se produce el evento donde vos lees. Por lo tanto, con RThreshold= 1 no vas a leer jamas 2 bytes a la vez, excepto que decidas no leer el buffer pese a que se produzca el evento indefinidamente hasta que lo hagas.
Dim m As Double 'En el Pto. Paralelo era Integer (8 Bits) aquí lo pasé
'a Double porque el valor es más grande (16 Bits)
Un Double es una variable de 64 bits de longitud(8 bytes).
Con 2 bytes(16 bits) te alcanza. En VB una variable de 16 bits es un integer.
Entonces, lo correcto seria Dim m as integer.
If m > 32767 Then Bit(15) = 0: m = m - 32768 Else Bit(15) = 1 '0 'Invertido
If m > 16383 Then Bit(14) = 0: m = m - 16384 Else Bit(14) = 1
If m > 8191 Then Bit(13) = 0: m = m - 8192 Else Bit(13) = 1
If m > 4095 Then Bit(12) = 0: m = m - 4096 Else Bit(12) = 1
If m > 2047 Then Bit(11) = 0: m = m - 2048 Else Bit(11) = 1
If m > 1023 Then Bit(10) = 0: m = m - 1024 Else Bit(10) = 1
If m > 511 Then Bit(9) = 0: m = m - 512 Else Bit(9) = 1
If m > 255 Then Bit(8) = 0: m = m - 256 Else Bit(8) = 1
'''..............................................................................
'''Solo para entender que pasa.
'''Si m es Mayor q' 127 el Bit 7 vale 0 : Si m vale (m - 128) entonces el Bit 7 es 1
'''=========================
'''Otra forma de Entenderlo:
'''Si "m (Que es el valor)" recibe algo mayor que 127 el Bit 7 Vale 0 :
'''Si lo que recibe "m" es igual a "m" menos 128 entonces el Bit 7 = 1
If m > 127 Then Bit(7) = 0: m = m - 128 Else Bit(7) = 1 '''0 para Invertido
If m > 63 Then Bit(6) = 0: m = m - 64 Else Bit(6) = 1
If m > 31 Then Bit(5) = 0: m = m - 32 Else Bit(5) = 1
If m > 15 Then Bit(4) = 0: m = m - 16 Else Bit(4) = 1
If m > 7 Then Bit(3) = 0: m = m - 8 Else Bit(3) = 1
If m > 3 Then Bit(2) = 0: m = m - 4 Else Bit(2) = 1
If m > 1 Then Bit(1) = 0: m = m - 2 Else Bit(1) = 1
If m > 0 Then Bit(0) = 0: m = m - 1 Else Bit(0) = 1
Esto se puede simplificar a:
Dim Recorre as byte
For Recorre = 0 To 15
If (valor And 2 ^ Recorre) = 0 Then Bit(Recorre) = 1 Else Bit(Recorre) = 0
Next
Con respecto al error, realmente no entendi. ¿El problema es que no se mueve la aguja del medidor?.
Saludos.
-
Holaaaa:
Sr. BrunoF:
Gracias por las aclaratorias, voy a revisar toda su exposición con calma para hacer las modificaciones necesarias.
Por otro lado le comento que si, el problema es que la aguja no se mueve. Todo lo demás aparentemente esta bién.
Gracias nuevamente, muchas gracias. :-/
Bye('_')
-
a ver si entiendo, ¿la aguja es dibujada en un picturebox?
si as así, pon la propiedad autoredraw= true
leí en tu programa: Picture1(0).Cls, mosca en la posición donde lo colocas.
-
Hola:
Sr. PalitroqueZ.
Si. Se dibuja dentro del picturebox.
Ese código funciona bien estando como form1, pero al ejecutarlo desde otro formulario me pinta una paloma volando.
Voy a revisar lo que usted dice y le informo luego, gracias por responer.
Bye('_').
-
Holaaa:
Paliz.... te comento que está activo autoredraw= true
bueno seguiré...
Nota agregada....
Les comento que en esta sección esta el problema.
''' Draw the dial hand
sin_ = Sin((Mdeg - s * 6) * Deg2Rad) * (r - sl) + cx
cos_ = Cos((Mdeg - s * 6) * Deg2Rad) * (r - sl) + cy
oldcolor = vbBlack
Picture1(0).ForeColor = Color
Picture1(0).DrawWidth = Handw
Picture1(0).Cls
Picture1(0).Line (cx, cy)-(sin_, cos_)
Picture1(0).ForeColor = oldcolor
Particularmente pienso que esta en el sin_ y el cos_, pero no estoy seguro.
Cuando comento esas dos lineas me aparece la aguja roja, no se mueve y además
muy larga. Me imagino que debo concentrarme allí.
Seguiré intentando.
Bye('_').
-
y que pasaría si quitaras momentaneamente la línea:
Picture1(0).Cls
de la función analogmeter
-
Paliz ... por ti, fue que supe que estaba allí el problema. Porque me puse a comentar lineas y comencé
con esa. Pero se que son las dos primeras. Allí, estoy super seguro.
cuando le quito el Picture1(0).Cls en realidad queda igual, pero en caso de que funcionara,
cada vez que muevo el VScroll me quedara la aguja roja impresa, quedaría como un abanico rojo, rojito :D :D :D
Disculpa es que me dio risa la expresión, es un poco intensa aquí en Venezuela. Uno no puede ni bromear
porque salta alguien molesto de alguna de las partes.
Picture1(0)).Cls Se encarga de borrar la posición antigua de la aguja.
El ejemplo esta sacado de un autor que no recuerdo pero yo fije un anuncio en este subforo.
http://www.freevbcode.com/code/analogmeter.zip
lo que hice fue resumir a mis necesidades, pero ha sido intenso, llevo dias en esto.
Sobre todo jugando con salvar el .gif en modo transparente, haaaaaay mamá te cuento un cuento.
Tuve que recurrir a windows98 con office 97 creo, u office 95. Bueno otro cuento más.
seguiré en acción.
Bye('_').
-
¿Podes pasar los archivos?
Con el proyecto es mucho mas facil trabajar.
Gracias
-
Holaaaaa:
Sr. BrunoF:
Saludos. Dispense que no haya respondido antes, es que me levante a 1:30 am y me acoste como a las 4:00 am.
He despertado con mucho dolor de cabeza.
Si estaba pensando justamente en pasar el proyecto. Quería que fuera una sorpresa para los más nuevos, pero que más dá.
Aquí se lo coloco:[]
Voy a dejarlo como 3 días después lo quito, para ver si puedo terminar la sorpresa. :)
Le comento que usted es un: Cerebro, es el papá de VB, es lo máximo.
Ya modifiqué la parte con el bucle "For recorre" y trabaja perfecto y se ahorra lineas.
Ya corregí también la parte que me habla del Integer y el Double. Esto es un mal entendido.
No pretendia decir que Integer era 8 bits. y todo lo demás pero lo deje así:
Dim valor As Double '''En el Pto. Paralelo era Integer (8 Bits a mostrar)
'''aquí lo pasé a Double porque el valor es más grande (16 Bits a mostrar)
'''Aunque el Integer debería ser suficiente para 16 bits le coloque Double
'''porque da un error de Desbordamiento.
También lo modifique en el primer post para evitar confuciones con los más nuevos.
Bueno pienso que es todo.
Dentro del .zip esta la carpeta prumeter. Allí te coloque el medidor separadamente, para que veas
que si funciona, estando separado.
Por último me da la impresión que hay que hacer un redimencionado del screen al hacer el FormMeter.Show,
disculpa si rebuzno pero esa fue mi conclusión como a las 3:45 am :D podría ser delirio por el sueño que tenía.
Gracias, muchas gracias.
Bye('_').
-
Holaaaaa:
Amigos ya esta listo.
Debo pedir disculpas. Al copiar el form de uno a otro sitio copié solo los componentes internos del
form "FormMeter" y revisé las propiedades de cada componente copiado.
Pero las propiedad del mismo "FormMeter", nunca las revisé. Anoche pensé en revisar todas las propiedades
e inicié con la del propio formulario "FormMeter", y el problema esta allí y justamente en la parte que tiene que
ver con el "ScaleMode = 3-pixel" y ScaleHeigth = 168.
Yo me imaginaba algo con el screen y no estaba muy equivocado. Yo me preguntaba, si funciona solo ¿Por qué
no funciona cuando lo llamo desde otro form?. No funciona porque soy un animal. Pero así es como uno aprende.
Gracias Sr. BrunoF the Master.
Gracias Sr. PalitroqueZ el Heredero.
Sin ofensas, solo bromeo un poco. :-)
Bye('_')
-
me alegro entonces.
yo ayer tuve 5 min y lo mire y venia justamente a decirte que se trataba de un error en los calculos, y no en la visualizacion.
un saludo.
-
Que bueno que hallaste la solución IAO.
-
Holaaaaaaa:
Bueno con ayuda de ustedes, también.
No he terminado, todavía falta. Ahora, falta mandarle el valor al VscrollBar desde el form1, y se ha puesto un poco
infernal la cosa esta, pero ya le daré la bendición. :-/
Bye('_').