Usar webcam en windows 8 con visualfoxpro?

[Mikel Lara]

Hola a todos.

Estoy desarrollando una aplicacion para tablets con windows 8 y webcam integrada (trasera y delantera). Estoy intentando usar la webcam para la toma de imagenes desde mi programa pero no me veo capaz. He usado algun que otro ocx pero no me carga la cam en la tablet. La siguiente solucion que se me ha ocurrido es la de usar la propia aplicacion de camara que trae por defecto en windows 8 pero no he sido capaz de encontrar ayuda al respecto para foxpro. Solamente encuentro para visual basic, javascript y C. (http://msdn.microsoft.com/en-us/library/windows/apps/windows.media.capture.cameracaptureui.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1)

Alguno ha realizado algo similar? Muchisimas gracias

[Daniel Sánchez]

Has probado este código para tomar una foto

** Programa Camara.prg

** Toma una foto de un dispositivo de imagen conectado y previamente instalado en la PC

** los parámetros son el nombre del archivo y una variable booleana para saber si la foto fué tomada

Parameters _archivo, _tomada

Local oForm

oForm = Createobject("Tform")

oForm.Show(1)

** declarando el formulario

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)

** medidas del formulario

    Width=500

    Height=450

    AutoCenter=.T.

    Caption="Tomar Fotos de Pacientes"

    MinButton=.F.

    MaxButton=.F.

    ShowTips=.T.

    ShowWindow=1

    WindowType=1

    Icon="sun.ico"

    hWindow=0

    hCapture=0

    capWidth=0

    capHeight=0

    capOverlay=0

** botones del formulario

    Add Object cmdGetFrame As CommandButton With Default=.T.,;

        Left=10, Top=415, Height=33, Width=95, Caption="Tomar \<Foto",;

        Enabled=.F., FontBold=.T., ToolTipText="Tomar la Fotografía del Paciente"

    Add Object cmdPreview As CommandButton With Default=.T.,;

        Left=195, Top=415, Height=33, Width=95, Caption="\<Ajustar",;

        Enabled=.F., FontBold=.T., ToolTipText="Ajustar la Cámara para la Foto"

    Add Object cmdClose As CommandButton With Cancel=.T.,;

        Left=395, Top=415, Height=33, Width=95, Caption="\<Salir",;

        Fontbold=.T., ToolTipText="Cerrar Cámara."

    Procedure Activate

    If This.hWindow = 0

        Declare Integer GetFocus In user32

        This.hWindow = GetFocus()

        This.CreateCaptureWindow

        This.DriverConnect

    Endif

    Procedure Destroy

    This.ReleaseCaptureWindow

** codgio de los botones

    Procedure cmdClose.Click

    Thisform.Release

    Procedure cmdGetFrame.Click

    _tomada = .t.

    Thisform.GetFrame

    Procedure cmdPreview.Click

    Thisform.StartPreview

    Procedure GetFrame   && lee la imagen

    This.msg(WM_CAP_GRAB_FRAME, 0,0)

    #Define WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)

    Local lcFile

    lcFile = "" && nombre del archivo en donde se guardara la foto

    lcFile = Lower(Alltrim(_archivo)) && en minúscula, para tener coerencia

    This.msg(WM_CAP_GRAB_FRAME, 0,0)

    This.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,1)

    lcmess = "Almacenando Fotografia de : "+_archivo

    Wait lcmess Window At Srows()/2,(Scols()/2 - (Len(lcmess)/2))Nowait

    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

** ventana del preview de la foto

    This.hCapture = capCreateCaptureWindow("",;

        WS_CHILD+WS_VISIBLE,;

        10,8,480,400, This.hWindow, 1) && coordenadas y,x ... y luego resolucion

    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 + ": Cámara Conectada, " +;

            LTRIM(Str(This.capWidth)) + "x" +;

            LTRIM(Str(This.capHeight))

    Else

        This.Caption = This.Caption + "  [**ERROR***]  No hay Conexión"

    Endif

    Procedure DriverDisconnect

    This.msg(WM_CAP_DRIVER_DISCONNECT, 0,0)

** cierra la ventana de captura

    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

* verificando fCaptureInitialized en la estructura CAPDRIVERCAPS

    #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) && retorna la foto si el valor es <>0

    Procedure GetCaptureDimensions

* leyendo uiImageWidth y uiImageHeight de la estructura CAPSTATUS

    #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)

*!*    para implementar el codigo anterior en el metodo GetFrame

*!*    el archivo generado des un bmp

#Define WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)

Local lcFile

lcFile = "" && nombre del archivo

lcFile = Lower(_archivo) &&_archivo = se pasa por parametros 

This.msg(WM_CAP_GRAB_FRAME, 0,0)

This.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,1)

******

--
Daniel Sánchez Escobar
Investigación y Desarrollo
Reset Software & Sistemas
Móvil +051-949398047
Trujillo - Perú

[Mikel Lara]

Muchas gracias por contestar.

Si, este es el codigo inicial que probé y me funciona en mi portatil con windows 8. Pero en las tablets no hay manera de que funcione.

[Daniel Sánchez]

Lo que ocurre que en los lenguajes .Net microsoft en su framework ya lo ha encapsulado en una clase o espacio de nombre donde tiene programada la llamada a los dll del SO, por eso al cambiar de sistema operativo cambias dichas llamadas pero como esta en un framework no realizas cambios en tu programación ya que el framework de SO W7 con el del SO del Tablet no cambian solo ha cambiado las llamadas internas en la clase así que para el programador no hay cambios visibles y funciona perfectamente en ambos entornos, cosa que con vfp no ocurre debemos realizar llamadas diferentes a las dll correspondientes en W7 como en un SO de la tablet o dispositivo móvil.

Saludos