TODOPIC
Lenguajes de programación para PC => Visual Basic => Mensaje iniciado por: delpiero en 03 de Mayo de 2010, 18:01:00
-
Buen dia compañeros, disculpen si este post no va aqui, pero he estado luchando para transmitir y recibir datos desde el Pic hacia la computadora y desde la computadora hacia el pic, quisiera si me pudieran ayudar con un ejemplo sencillo, ya que yo solo necesito enviar por ejemplo una simple palabra como "activar", desde ya les agradezco su ayuda, asi mismo las velocidades que se deben manejar para este ejercicio, los baudios, etc. GRACIAS compañeros el pic que yo estoy usando es el PIC16F88
-
Hola delpiero, prueba con este ejemplo, recuerda que debes utilizar el IC RS232, lo puede comunicar con el hyperterminal o crea una pequeña interfase en visual.
saludos.
-
en que lenguage te quieres comunicar con el pic asm basic c
-
Gracias compañeros por su ayuda, pues me quiero conectar con el pic por medio de Basic, para una pequeña interfaz en visual basic, bueno no se si deba usar el IC rs232 porque fijense que se me olvido que solo lo quiero implementar en una distancia corta (tal vez lo mas 1/2 metro), bueno creo que no necesitaria el IC rs232 verdad?? bueno compañeros les agradezco su ayuda, espero sus respuestas GRACIAS GRACIAS
-
gracias Diego E. lo probare y luego te comento, y gracias tambien a Chrisbaf por su colaboracion GRACIAS GRACIAS
-
Hola buen dia Diego E. fijate que probe tu ejemplo y si funciona, pero disculpa la molestia sera que podria dar un ejemplo de lo mismo, solo que usando basic para el pic y la interfaz en visual basic, gracias Diego y disculpa tanta molestia GRACIAS GRACIAS
-
acá tenés un código fuente muy muy simple en VB6 y un código del pic en C muy simple, entendible y portable a otro lenguaje:
curso de picC (http://www.todopic.com.ar/foros/index.php?topic=27748.0)
al final del hilo está la aplicación VB en cuestión...
-
en esta pagina encontraras un programa que te saca bytes por el puerto USB. http://www.lvr.com/
El programa se llama "generich hid".
Luego exsisten conversores USB-232 o puedes programar el pic directamente desde visual con un "expandio usb", pero eso ya es mas complicado. COn el USB-232 puedes configurar el pic para una comunicacion serie. Todo esto lo encontraras en la pagina web de HEXWAX.
-
Yo lo hice asi... y ademas lo GRAFICA!!! Espero te sirva. Atte. Alekspm
1.Iniciar Microsoft Visual Basic 6.0
2.Crear un nuevo proyecto EXE standar (Form1) con las siguientes propiedades:
Appearance= 1 - 3D
AutoRedraw= True
BackColor= H80000004
BorderStyle= 1 – Fixed Single
Caption= Monitor AN-0 del PIC 16F73-1/SP
Icon= (asigne uno)
StartUpPosition= 2 – CenterScreen
3.En el formulario padre, agregar dos etiquetas con la siguientes propiedades:
label1, BackColor= H80000009, Caption= Dato de 8 bits:
label2, BackColor= H80000009, Caption= Voltaje aplicado al pin 2:
4.Agregar dos cuadros de texto con las siguientes propiedades:
text1, Locked= True, Text= (vacio)
text2, Locked= True, Text= (vacio)
5.Agregar el control AvtiveX MSComm
El formulario debe parecerse al siguiente, puede cambiar según el gusto del desarrollador.
6.De dos clicks sobre el formulario padre, y al aparecer el examinador de código, escriba:
Dim MatrizY(150), MatrizY2(150) As Integer
Dim Contador, Aux As Integer
Dim CordX, CordY As Integer
Dim Recibe As String
Private Sub Form_Load()
Contador = 0
CurrentX = 1000
CurrentY = 5000
CordX = 250 'Inicio de la grafica original 1000
CordY = 5550
'Comprueba que el puerto este cerrado para poder abrirlo
If MSComm1.PortOpen = False Then
MSComm1.Settings = "2400, N, 8, 1" 'BPS, Parity, Bits, Stop
MSComm1.Handshaking = comNone 'Sin protocolo. Vea Ayuda: MSComm
MSComm1.InputMode = 0 '0: Datos recuperados como texto. 1: en binario
MSComm1.RThreshold = 1 'Cada cuantos bytes recibidos se genera un evento
MSComm1.InputLen = 1 'Cuantos bytes se extraen al leer el puerto
MSComm1.PortOpen = True 'Abre el puerto seleccionado
End If
End Sub
Private Sub MSComm1_OnComm()
'MSComm1.CommEvent = 2 (CommEvReceive); No. de caracteres RThreshold recibido.
'Este evento se genera continuamente hasta que se usa la propiedad Input para
'quitar datos del búfer de recepción.
If MSComm1.CommEvent = 2 Then
'El dato que llega por el puerto se guarda en "Recibe"
Recibe = MSComm1.Input 'El dato se recibe en bytes
MatrizY(149) = Asc(Recibe) 'Convierte el byte (11111111= FF) Recibe en ASCII
'El ASCII de recibe lo resta a 255 para hacer positiva la grafica
Aux = 255 - Asc(Recibe)
End If
If Contador = 149 Then
MatrizY(149) = 255 - Asc(Recibe)
MatrizY(149) = (MatrizY(149) * 10) + 3000
MatrizY2(149) = MatrizY(149)
For Contador = 0 To 148
MatrizY2(Contador) = MatrizY(Contador + 1)
Next
For Contador = 0 To 149
MatrizY(Contador) = MatrizY2(Contador)
Next
Cls
CordX = 250
For Contador = 0 To 147
Line (CordX, MatrizY2(Contador)) - (CordX + 20, MatrizY2(Contador + 1))
CordX = CordX + 20
Next
End If
'El 10 es para aumentar la escala del Aux
'El 3000 es para ajustar el setpoint de la grafica
Line (CordX, CordY) - (CordX + 20, (Aux * 10) + 3000)
CordY = (Aux * 10) + 3000
CordX = CurrentX
MatrizY(Contador) = CordY
Contador = Contador + 1
'Muestra el dato en formato de 8 bits (255= 11111111)
Text1.Text = Asc(Recibe)
'Convierte los 8 bits en voltaje. El (5/255) es el factor de resolución del PIC
Text2.Text = Asc(Recibe) * (5 / 255)
End Sub
Private Sub Form_UnLoad(Cancel As Integer)
If MSComm1.PortOpen Then
'Cierra el puerto utilizado
MSComm1.PortOpen = False
End If
End 'Termina el programa
End Sub
-
saludos a todos, bueno la duda mia es con relacion a lo antes expuesto por ustedes. Pues tengo un problema necesito leer los datos que me muestra hyperterminal y llevarlos de forma organizada a una hoja de excel, he introducido unos macros genericos que encontre en la red y los estuve probando pero no me muestra sube nada a excel, cuando intento correr el macro solo me da error de debug, no se lo que pasa agradececria de antemanos sus sugerencias y comentarios. Gracias. Aqui estan los codigos que he utlizado para leer el puerto.
Private Sub MSComm1_OnComm()
Select Case MScomm1.CommEvent
Case comEventBreak ' A Break was received.
Case comEventCDTO ' CD (RLSD) Timeout.
Case comEventCTSTO ' CTS Timeout.
Case comEventDSRTO ' DSR Timeout.
Case comEventFrame ' Framing Error.
Case comEventOverrun ' Data Lost.
Case comEventRxOver ' Receive buffer overflow.
Case comEventRxParity ' Parity Error.
Case comEventTxFull ' Transmit buffer full.
Case comEventDCB ' Unexpected error retrieving DCB]
' Events
Case comEvCD ' Change in the CD line.
Case comEvCTS ' Change in the CTS line.
Case comEvDSR ' Change in the DSR line.
Case comEvRing ' Change in the Ring Indicator.
Case comEvReceive ' Received RThreshold # of chars.
'Sets the global mstinbuff to = what is received by the commm control
mstInBuff = mstInBuff & MScomm1.Input
'Resets the variable used to count the lack of response to 0 so that
'counting restarts.
mdblReceived = 0
End Select
End Sub
Sub CDO_Send_Selection_Body()
Dim LastRow As Long
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
If WorksheetFunction.CountA(Cells) > 0 Then
LastRow = Cells.Find(What:="*", After:=[C1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
Set sh = Sheets("DataLog") '<<< Change
Set Source = sh.Range("A" & LastRow & ":C" & LastRow) '<<< Change
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "neurin.rodriguez@hospira.com"
.CC = ""
.BCC = ""
.From = """Sistema de Alarmas"" <neurin.rodriguez@hospira.com>"
.Subject = " "
.HTMLBody = vbCr & vbCr & "[" & Format(sh.Range("B" & LastRow).Value, "HH:MM AM/PM") & "] EVENTO: " & sh.Range("C" & LastRow).Value 'RangetoHTML(sh, rng)
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Sub CDO_Send_ActiveSheet_Body_Without_Pictures()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
Set rng = Sheets("DataLog").UsedRange
'Set rng = Sheets("DataLog").Range("A4:C" & LastRow).SpecialCells(xlCellTypeVisible)
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Sheet1.Email1.Value
.CC = Sheet1.Email2.Value
.BCC = ""
.Subject = "Reporte de Alarmas para: " & Format(Range("A4").Value, "MM/DD/YYYY")
.HTMLBody = RangetoHTML(rng)
.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 19-Aug-2006
Dim TempFile As String
Dim Nwb As Workbook
Dim fso As Object
Dim ts As Object
sh.Copy
Set Nwb = ActiveWorkbook
With Nwb.Sheets(1)
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
TempFile = Environ$("tempII") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
On Error Resume Next
Kill TempFile
fso.deletefolder Left(TempFile, Len(TempFile) - 4) & "*", True
On Error GoTo 0
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
End Function
Option Explicit
-
Hola amigos por favor si me podrían ayudar tengo un problema con vb 2008, lo que pasa es que necesito verificar que cuando yo le mande la orden desde vb al pic este empiece un timer de 2ms ya que si en 2ms no llega ningun dato me tiene que salr error, pero no lo consigo mas o menos tengo esto:
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If contador <> 0 Then
MsgBox("bien")
Timer1.Enabled = False
Else
MsgBox("mal")
MsgBox(contador)
Timer1.Enabled = False
End If
End Sub
Private Sub SerialPort1_DataReceived(ByVal sender As System.Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
contador += 1
a(l) = SerialPort1.ReadByte 'guardo los 4 bytes que llegan en un vector
l += 1
If l = 4 Then
SerialPort1.Close()
l = 0
End If
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
SerialPort1.Write(textbox1.text)
Timer1.Enabled = True
End Sub
E
-
Perdon se me corto el mensaje, me falto decir que el problema es que yo le mando a aumentar un contador cada que entra a la subrutita de recir datos pero en el timer nunca lee ese contador y es como que se queda en timer y no sale de ahi y me sale full ventanitas con el mensaje mal, a pesar de que mando a apagar el timer.
Les agradecería mucho si alguien me ayuda, gracias
Saludos!