jojo muy bueno
... solo q ese codigo es el q estoy probando y no me saca el color del pixel..
probe con picture.point(x,y), getpixel recorriendo la imagen con el for anidado y no hace mas q darme en todos los pixeles un mismo color el de backgound
.
te dejo lo que copypaste hasta ahora
form1
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Dim temp As Long
' botón que inicia la captura
'''''''''''''''''''''''''''''''''''''''
Private Sub Command1_Click()
Dim temp As Long
hwdc = capCreateCaptureWindow("CapWindow", ws_child Or ws_visible, _
0, 0, 320, 240, Picture1.hwnd, 0)
If (hwdc <> 0) Then
temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
temp = SendMessage(hwdc, WM_CAP_SET_SCALE, True, 0)
'esto hace que la imagen recibida por el dispositivo se ajuste
'al tamaño de la ventana de captura (justo lo que yo buscaba)
DoEvents
startcap = True
Else
MsgBox "No hay Camara Web", 48, "Error"
End If
End Sub
' botón para detener la captura
'''''''''''''''''''''''''''''''''''''''
Private Sub Command2_Click()
temp = DestroyWindow(hwdc)
If startcap = True Then
temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
DoEvents
startcap = False
End If
End Sub
' Botón que abre el dialogo de formato
''''''''''''''''''''''''''''''''''''''''''''
Private Sub Command3_Click()
If startcap = True Then
temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
DoEvents
End If
End Sub
' Mostrar dialogo de Configuracion de la WebCam
''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Command4_Click()
Dim temp As Long
If startcap = True Then
temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOCONFIG, 0&, 0&)
DoEvents
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "Iniciar"
Command2.Caption = "Detener"
Command3.Caption = "Formato"
Command4.Caption = "Configurar"
Me.Caption = "Capturador de Web Cam"
End Sub
Private Sub Form_Resize()
On Error Resume Next
Move (Screen.Width - Width) \ 29, (Screen.Height - Height) \ 29
End Sub
Private Sub Form_Unload(Cancel As Integer)
temp = DestroyWindow(hwdc)
If startcap = True Then
temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
DoEvents
startcap = False
End If
End Sub
Private Sub Timer1_Timer()
Dim x As Integer
Dim y As Integer
For x = 0 To 480 / 10
For y = 0 To 640 / 10
Me.BackColor = Picture1.Point(x, y)
Next
Next
End Sub
modulo
Option Explicit
' declaraciones Api, constantes, variables
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const ws_child = &H40000000
Public Const ws_visible = &H10000000
Public Const WM_USER = 1024
Public Const wm_cap_driver_connect = WM_USER + 10
Public Const wm_cap_set_preview = WM_USER + 50
Public Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Public Const WM_CAP_DRIVER_DISCONNECT = WM_USER + 11
Public Const WM_CAP_DLG_VIDEOFORMAT = WM_USER + 41
Public Const WM_CAP_DLG_VIDEOCONFIG = WM_USER + 42
Public Const WM_CAP_SET_SCALE = WM_USER + 53
'Api para crear la ventana de captura
Public Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
Alias "capCreateCaptureWindowA" ( _
ByVal lpszWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hwndParent As Long, _
ByVal nID As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
'Solo 16 Bits (vb2, vb3 y vb4 de 16)
'Declare Function SendMessage Lib "User" ( _
ByVal hWnd As Integer, _
ByVal wMsg As Integer, _
ByVal wParam As Integer, _
lParam As Any) As Long
'Api para crear la ventana de captura
'Declare Function capCreateCaptureWindow Lib "avicap.dll" ( _
ByVal lpszWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Integer, _
ByVal y As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hwndParent As Integer, _
ByVal nID As Integer) As Long
'Declare Function DestroyWindow Lib "User" (ByVal hndw As Integer) As Integer
Public hwdc As Long
Public startcap As Integer