Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » FoxPro/Visual FoxPro » Capturar una imagen con camara web -- me da pantalla negra

FoxPro/Visual FoxPro - Capturar una imagen con camara web -- me da pantalla negra

Volver
Nuevo Tema
<<>>
 
Vista:

Capturar una imagen con camara web -- me da pantalla negra

Publicado por es_binario (757 intervenciones) el 30/01/2013 16:25:34
Quiero capturar una imagen de la web-cam, tengo una rutina que encontre en este mismo foro, y todo va bien, me pide que seleccione la camara web, pero se queda la pantalla en negro y no permite ni capturar ni grabar...

este es el codigo.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
Local oForm
oForm = Createobject("Tform")
oForm.Show(1)
* end of main
 
Define Class Tform As Form
#Define WM_CAP_START 0x0400

#Define WM_CAP_DRIVER_CONNECT (WM_CAP_START+10)

#Define WM_CAP_DRIVER_DISCONNECT (WM_CAP_START+11)

#Define WM_CAP_DRIVER_GET_CAPS (WM_CAP_START+14)

#Define WM_CAP_SET_PREVIEW (WM_CAP_START+50)

#Define WM_CAP_SET_OVERLAY (WM_CAP_START+51)

#Define WM_CAP_SET_PREVIEWRATE (WM_CAP_START+52)

#Define WM_CAP_GET_STATUS (WM_CAP_START+54)

#Define WM_CAP_GRAB_FRAME (WM_CAP_START+60)

 
Width=500
Height=400
AutoCenter=.T.
Caption="Using Video Capture"
MinButton=.F.
MaxButton=.F.
hWindow=0
hCapture=0
capWidth=0
capHeight=0
capOverlay=0
 
Add Object cmdGetFrame As CommandButton With Default=.T.,;
Left=15, Top=264, Height=27, Width=90, Caption="Get Frame",;
Enabled=.F.
 
Add Object cmdPreview As CommandButton With Default=.T.,;
Left=106, Top=264, Height=27, Width=100, Caption="Preview Video",;
Enabled=.F.
 
Add Object cmdClose As CommandButton With Cancel=.T.,;
Left=250, Top=264, Height=27, Width=70, Caption="Close"
 
Procedure Activate
If This.hWindow = 0
Declare Integer GetFocus In user32
This.hWindow = GetFocus()
This.CreateCaptureWindow
This.DriverConnect
Endif
 
Procedure Destroy
This.ReleaseCaptureWindow
 
Procedure cmdClose.Click
Thisform.Release
 
Procedure cmdGetFrame.Click
Thisform.GetFrame
 
Procedure cmdPreview.Click
Thisform.StartPreview
 
Procedure GetFrame
This.msg(WM_CAP_GRAB_FRAME, 0,0)
 
Procedure CreateCaptureWindow
#Define WS_CHILD 0x40000000

#Define WS_VISIBLE 0x10000000

 
Declare Integer capCreateCaptureWindow In avicap32;
STRING lpszWindowName, Long dwStyle,;
INTEGER x, Integer Y,;
INTEGER nWidth, Integer nHeight,;
INTEGER hParent, Integer nID
 
This.hCapture = capCreateCaptureWindow("", WS_CHILD+WS_VISIBLE, 10,8,320,240, This.hWindow, 1)
 
#DEFINE WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)

 
LOCAL lcFile
lcFile = "c:\sample.bmp"
 
THIS.msg(WM_CAP_GRAB_FRAME, 0,0)
THIS.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,1)
 
Procedure DriverConnect
This.msg(WM_CAP_DRIVER_CONNECT, 0,0)
 
If This.IsCaptureConnected()
This.GetCaptureDimensions
Store .T. To This.cmdGetFrame.Enabled, THIS.cmdPreview.Enabled
This.Caption = This.Caption + ": connected, " + lTRIM(Str(This.capWidth)) + "x" + LTRIM(Str(This.capHeight))
Else
This.Caption = This.Caption + ": failed to connect"
EndIf
 
Procedure DriverDisconnect
This.msg(WM_CAP_DRIVER_DISCONNECT, 0,0)
 
Procedure ReleaseCaptureWindow
If This.hCapture <> 0
This.DriverDisconnect
Declare Integer DestroyWindow In user32 Integer HWnd
= DestroyWindow(This.hCapture)
This.hCapture = 0
Endif
 
Procedure msg(msg, wParam, Lparam, nMode)
If This.hCapture = 0
Return
Endif
 
If Vartype(nMode) <> "N" Or nMode=0
Declare Integer SendMessage In user32;
INTEGER HWnd, Integer Msg,;
INTEGER wParam, Integer Lparam
= SendMessage(This.hCapture, msg, wParam, Lparam)
Else
Declare Integer SendMessage In user32;
INTEGER HWnd, Integer Msg,;
INTEGER wParam, String @Lparam
= SendMessage(This.hCapture, msg, wParam, @Lparam)
Endif
 
Function IsCaptureConnected
* analyzing fCaptureInitialized member of the CAPDRIVERCAPS structure
#Define CAPDRIVERCAPS_SIZE 44

Local cBuffer, nResult
cBuffer = Repli(Chr(0),CAPDRIVERCAPS_SIZE)
This.msg(WM_CAP_DRIVER_GET_CAPS, Len(cBuffer), @cBuffer, 1)
This.capOverlay = buf2dword(Substr(cBuffer,5,4))
nResult = Asc(Substr(cBuffer, 21,1))
Return (nResult<>0)
 
Procedure GetCaptureDimensions
* reading uiImageWidth and uiImageHeight members
* of the CAPSTATUS structure
#Define CAPSTATUS_SIZE 76

Local cBuffer
cBuffer = Repli(Chr(0), CAPSTATUS_SIZE)
This.msg(WM_CAP_GET_STATUS, Len(cBuffer), @cBuffer, 1)
This.capWidth = buf2dword(Substr(cBuffer,1,4))
This.capHeight = buf2dword(Substr(cBuffer,5,4))
 
Procedure StartPreview
This.msg(WM_CAP_SET_PREVIEWRATE, 30,0)
This.msg(WM_CAP_SET_PREVIEW, 1,0)
If This.capOverlay <> 0
This.msg(WM_CAP_SET_OVERLAY, 1,0)
Endif
 
Procedure StopPreview
This.msg(WM_CAP_SET_PREVIEW, 0,0)
Enddefine
 
Function buf2dword(lcBuffer)
Return Asc(Substr(lcBuffer, 1,1)) + ;
BitLShift(Asc(Substr(lcBuffer, 2,1)), 8) +;
BitLShift(Asc(Substr(lcBuffer, 3,1)), 16) +;
BitLShift(Asc(Substr(lcBuffer, 4,1)), 24)


tal vez por ahi alguien tenga la solucion...

gracias.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder