Ayuda con este codigo
Publicado por andres (1 intervención) el 11/05/2011 06:25:17
Encontre este codigo en una pagina y me causo demasiada curiosidad el que se pueda medir distancias con una web cam y un puntero laser, ademas, de saber que por visual se puede hacer este tipo de codigos, he visto el procesamiento de imagenes hecho en MATLAB y en otrs programas, lo baje y lo puse a rodar, pero no me da las diatancias como me lo plantea. Necesito ayuda para saber como funciona ya que soy nuevo programando y quisiera seguir con esto.
Aca les dejo el codigo si necesitan algo por favor dejeme un mensaje que con gusto respondere rapidamente
Private Sub exit_Click()
' sólo si está corriendo...
If (Timer1.Enabled) Then
Timer1.Enabled = False ' Detener el Timer
VideoOCX.Stop
VideoOCX.Close
End If
End
End Sub
Private Sub Start_Click() 'Inicia el control VideoOCX, reserva memoria y comienza a tomar imagen
If (Not Timer1.Enabled) Then
Start.Caption = "Stop"
' Deshabilita los mensajes de error interno en VideoOCX
VideoOCX.SetErrorMessages False
' Inicia el control
If (Not VideoOCX.Init) Then
' Falló el inicio. Muestra mensaje de error y termina
MsgBox VideoOCX.GetLastErrorString, vbOKOnly, "VideoOCX Error"
End
Else
' Reserva memoria para manejo global de imagen
capture_image = VideoOCX.GetColorImageHandle
' Imagen resultante = VideoOCX_Processed.GetColorImageHandle
Timer1.Enabled = True ' Inicia temporizador de captura
' Inicia modo de captura
If (Not VideoOCX.Start) Then
' Falló el inicio. Muestra mensaje de error y termina
MsgBox VideoOCX.GetLastErrorString, vbOKOnly, "VideoOCX Error"
End
End If
End If
Else
Start.Caption = "Start"
Timer1.Enabled = False ' Detener el Timer
VideoOCX.Stop
VideoOCX.Close
End If
End Sub
Private Sub Timer1_Timer()
' Temporizador para captura - maneja videoOCXTools
Dim matrix As Variant
Dim height, width As Integer
Dim r, c As Integer
Dim max_r, max_c As Integer
Dim max_red As Integer
Dim gain, offset As Variant
Dim h_cm As Variant
Dim range As Integer
Dim pixels_from_center As Integer
' Parámetros calibrados de pixel para conversión de distancia
gain = 0.0024259348
offset = -0.056514344
h_cm = 5.842
max_red = 0
' Capture una imagen
If (VideoOCX.Capture(capture_image)) Then
' VideoOCX.Show capture_image
' Inicialización de matriz de transformación
matrix = VideoOCX.GetMatrix(capture_image)
height = VideoOCX.GetHeight
width = VideoOCX.GetWidth
' Código para el proceso de imagen
' El punto láser estará debajo de la mitad de la imagen
For r = height / 2 - 20 To height - 1
' Nuestra configuración física está calibrada para que el punto
' del láser caiga, más o menos, en la zona central de la imagen.
' No hay que preocuparse por mirar fuera de esa columna
For c = width / 2 - 25 To width / 2 + 24
' Buscar el pixel rojo de valor más grande en la escena (láser rojo)
If (matrix(c, r, 2) > max_red) Then
max_red = matrix(c, r, 2)
max_r = r
max_c = c
End If
Next c
Next r
' Calcular la distancia del punto láser desde la mitad del cuadro
pixels_from_center = max_r - 120
' Calcular la distancia en cm en base a los parámetros de calibración
range = h_cm / Tan(pixels_from_center * gain + offset)
' Mostrar la posición del punto láser y la columna en pantalla
row_val.Caption = max_r
col_val.Caption = max_c
' Mostrar la distancia desde el objeto iluminado
range_val.Caption = range
' Dibujar una línea vertical que intersecte el blanco
For r = 0 To height - 1
matrix(max_c, r, 2) = 255
Next r
' Dibujar una línea horizontal que intersecte el blanco
For c = 0 To width - 1
matrix(c, max_r, 2) = 255
Next c
VideoOCX.ReleaseMatrixToImageHandle (capture_image)
End If
VideoOCX.Show capture_image
End Sub
Ademas de todo esto me dice que debo tener activado ActiveX VideoOCX.
Aca les dejo el codigo si necesitan algo por favor dejeme un mensaje que con gusto respondere rapidamente
Private Sub exit_Click()
' sólo si está corriendo...
If (Timer1.Enabled) Then
Timer1.Enabled = False ' Detener el Timer
VideoOCX.Stop
VideoOCX.Close
End If
End
End Sub
Private Sub Start_Click() 'Inicia el control VideoOCX, reserva memoria y comienza a tomar imagen
If (Not Timer1.Enabled) Then
Start.Caption = "Stop"
' Deshabilita los mensajes de error interno en VideoOCX
VideoOCX.SetErrorMessages False
' Inicia el control
If (Not VideoOCX.Init) Then
' Falló el inicio. Muestra mensaje de error y termina
MsgBox VideoOCX.GetLastErrorString, vbOKOnly, "VideoOCX Error"
End
Else
' Reserva memoria para manejo global de imagen
capture_image = VideoOCX.GetColorImageHandle
' Imagen resultante = VideoOCX_Processed.GetColorImageHandle
Timer1.Enabled = True ' Inicia temporizador de captura
' Inicia modo de captura
If (Not VideoOCX.Start) Then
' Falló el inicio. Muestra mensaje de error y termina
MsgBox VideoOCX.GetLastErrorString, vbOKOnly, "VideoOCX Error"
End
End If
End If
Else
Start.Caption = "Start"
Timer1.Enabled = False ' Detener el Timer
VideoOCX.Stop
VideoOCX.Close
End If
End Sub
Private Sub Timer1_Timer()
' Temporizador para captura - maneja videoOCXTools
Dim matrix As Variant
Dim height, width As Integer
Dim r, c As Integer
Dim max_r, max_c As Integer
Dim max_red As Integer
Dim gain, offset As Variant
Dim h_cm As Variant
Dim range As Integer
Dim pixels_from_center As Integer
' Parámetros calibrados de pixel para conversión de distancia
gain = 0.0024259348
offset = -0.056514344
h_cm = 5.842
max_red = 0
' Capture una imagen
If (VideoOCX.Capture(capture_image)) Then
' VideoOCX.Show capture_image
' Inicialización de matriz de transformación
matrix = VideoOCX.GetMatrix(capture_image)
height = VideoOCX.GetHeight
width = VideoOCX.GetWidth
' Código para el proceso de imagen
' El punto láser estará debajo de la mitad de la imagen
For r = height / 2 - 20 To height - 1
' Nuestra configuración física está calibrada para que el punto
' del láser caiga, más o menos, en la zona central de la imagen.
' No hay que preocuparse por mirar fuera de esa columna
For c = width / 2 - 25 To width / 2 + 24
' Buscar el pixel rojo de valor más grande en la escena (láser rojo)
If (matrix(c, r, 2) > max_red) Then
max_red = matrix(c, r, 2)
max_r = r
max_c = c
End If
Next c
Next r
' Calcular la distancia del punto láser desde la mitad del cuadro
pixels_from_center = max_r - 120
' Calcular la distancia en cm en base a los parámetros de calibración
range = h_cm / Tan(pixels_from_center * gain + offset)
' Mostrar la posición del punto láser y la columna en pantalla
row_val.Caption = max_r
col_val.Caption = max_c
' Mostrar la distancia desde el objeto iluminado
range_val.Caption = range
' Dibujar una línea vertical que intersecte el blanco
For r = 0 To height - 1
matrix(max_c, r, 2) = 255
Next r
' Dibujar una línea horizontal que intersecte el blanco
For c = 0 To width - 1
matrix(c, max_r, 2) = 255
Next c
VideoOCX.ReleaseMatrixToImageHandle (capture_image)
End If
VideoOCX.Show capture_image
End Sub
Ademas de todo esto me dice que debo tener activado ActiveX VideoOCX.
Valora esta pregunta
0