FoxPro/Visual FoxPro - Rutina para tomar foto desde una camara web

 
Vista:

Rutina para tomar foto desde una camara web

Publicado por Gilberto Larez (2 intervenciones) el 16/08/2007 14:05:12
Necesito una rutina mas sencilla de como tomar foto desde foxpro desde una camara web, tengo una pero me ha traido muchos problemas y no encuentro como solucionarlo, esta es

lnombrefoto=foto001
*'001'*
LOCAL oForm
oForm = CREATEOBJECT("Tform")
oForm.Show(1)
return

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=540 && para poner imagenes del click.
Width=340
Height=310
Autocenter=.T.
Caption="Captura de Foto del Interno"
MinButton=.F.
MaxButton=.F.
*Icon=wicoform
hWindow=0
hCapture=0
capWidth=0
capHeight=0
capOverlay=0

ADD OBJECT cmdGetFrame As CommandButton WITH Default=.T.,;
Left=10, Top=264, Height=27, Width=90, Caption="Tomar Foto",;
Enabled=.F.

Add Object cmdPreview As CommandButton With Default=.T., Visible=.F.,;
Left=100, Top=264, Height=27, Width=120, Caption="Video",;
Enabled=.F.

ADD OBJECT cmdClose As CommandButton WITH Cancel=.T.,;
Left=202, Top=264, Height=27, Width=130, Caption=" Salir "

PROCEDURE Activate
IF THIS.hWindow = 0
DECLARE INTEGER GetFocus IN user32
THIS.hWindow = GetFocus()
THIS.CreateCaptureWindow
THIS.DriverConnect
ENDIF

PROCEDURE Destroy
THIS.ReleaseCaptureWindow
*!* DO FORM entradam.scx

PROCEDURE cmdClose.Click
THIS.Destroy
ThisForm.Release

PROCEDURE cmdGetFrame.Click
ThisForm.GetFrame

PROCEDURE cmdPreview.Click
ThisForm.StartPreview

PROCEDURE GetFrame
#DEFINE WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)

LOCAL lcFile

lcFile = lnombrefoto + '.JPG'

THIS.msg(WM_CAP_GRAB_FRAME, 0,0)
THIS.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,1)

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)

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.cmdPreview.Click
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
thisform.Release
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)
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

RE:Rutina para tomar foto desde una camara web

Publicado por Arturo Garcia Casas (156 intervenciones) el 17/08/2007 02:15:59
mira yo uso una camara marca AXIS
investigando hice esta rutina y me toma la foto sin problemas
habra que ver si tu camara hace lo mismo....

nomarchi=di+me+ho+mi+".jpg"
archired1="h:\fotope\"+nomarchi && ruta de red donde se graba la foto
delete file c:\fotos\camara\*.jpg
Exeorder = "ftp -v -s:c:\fotos\FlCamFtp.txt 10.66.193.45"
Run &exeorder && ejecuta el Script de FTP para capturar la foto
newname1="c:\fotos\camara\"+nomarchi
rename c:\fotos\camara\image.jpg to &newname1
copy file &newname1 to &archired1
.image1.picture=newname1

el archivo FlCamFtp.txt tiene lo siguiente:

root
cafila01
cd tmp
cd jpg
get image.jpg c:\fotos\camara\image.jpg
bye

**************************************************************************
donde:
root : es el nombre de usuario (nivel administrador)
cafila01: es el password
*******************************************************************

espero que te sirva....
saludos desde el bello puerto de veracruz, ver. mexico
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Rutina para tomar foto desde una camara web

Publicado por linda ruby (4 intervenciones) el 01/10/2012 23:10:28
Saludos he checado tu codigo, pero me marca error, me dice que no se encuentra la variable di
este se posisiona en nomarchi=di+me+ho+mi+".jpg"
me pregunto si esta completo tu codigo o enque estoy fallando, crees poder mandarme un formulario donde se pueda apreciar el funcionamiento, te lo agradeceria mucho
saludos. espero tu respuesta
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar