Capturar Imagen WebCam Avanzado

[casacham]

Capturar Imagen WebCam Avanzado - Direct X
Hace un tiempo publique un truco basado en una función de la API de Windows capCreateCaptureWindow para hacer capturas de imágenes de la WebCam. Para ver esta publicación pueden remitirse a este link http://www.clubdelphi.com/foros/show...756#post361756 .
Si bien funciona sin problemas para la mayorías de las cámaras, con algunas no lo hace. Compartir como lo resolví es el motivo principal para realizar esta publicación. Sin mas dilaciones los invito a seguir los pasos que aquí presento. Esta basado en la implementacion de DirectX 9.0, de forma sencilla y practica.

PASO 1
Descargar este archivo: Esta ubicado en http://terawiki.clubdelphi.com/Imagenes/ y se llama WebCamDirectX.zip.

PASO 2
Crear una carpeta WebCamPic para guardar nuestro proyecto

PASO 3
Los archivos contenidos en WebCamDirectX.zip extraerlos en WebCamPic, la carpeta DirectX se creara automáticamente .

Link de descarga http://terawiki.clubdelphi.com/Image...CamDirectX.zip

PASO 4
Crear en Delphi un nuevo proyecto FILE -> New -> VCL Forms Application - Delphi
Guardar como Unit1 y darle el nombre al proyecto (.DPR) que sea de su agrado. Yo lo llame WebCamPicII.DPR

PASO 5 - Colocando componentes en el Form1
En el Form1 colocaremos dos componentes TImage uno a la derecha y otro a la izquierda, siendo las medidas recomendables para ambos iguales: with:=260 - height:=300. Al de la izquierda llamaremos ImageCamera y al de la derecha ImagePhoto.
El TImage ImageCamera se utiliza para proyectar el vídeo y ImagePhoto para hacer una captura (tomar una foto) de lo que ve la cámara.

Agregar los siguientes componentes en el Form1 y los nombraremos como aquí sugiero, sin ser esto obligatorio
Un TComboBox llamado CB_ListaCamaras, se utiliza para listar el nombre de todas la cámaras conectadas a nuestra pc, en caso de ser una contendrá un único items con su nombre.
Colocar 4 TButton, llamarlos de la siguiente manera: EncenderCamara, DetenerCamara, Configure y TomarFoto

PASO 6 - Incorporando units
Incorporar todas las units que descargamos a nuestro proyecto: Project -> Add to Project... Shift+F11. Ellas son:
Carpeta WebCamPic
VFrames.pas - VSample.pas
Carpeta WebCamPic\DirectX
DXTypes.pas - DirectSound.pas - DirectShow9.pas - DirectDraw.pas - Direct3D9.pas

PASO 7 - Escribiendo el codigo
Agregar en el uses de nuestra Form1 VFrames y Vcl.Imaging.jpeg

Código Delphi [-]
interface

uses
  Winapi.Windows,.........,
  VFrames,           // Unidad especial que utiliza DIRECT X
  Vcl.Imaging.jpeg;

Declarar la siguiente variable fVideoImage

Código Delphi [-]
  private
    { Private declarations }
    fVideoImage : TVideoImage;

En el evento OnCreate colocar el siguiente código

Código Delphi [-]
procedure FormCreate(Sender: TObject);
var
  DeviceList : TStringList;
begin
  fVideoImage:=TVideoImage.Create;

   // Buscando camaras conectadas
  DeviceList := TStringList.Create;
  fVideoImage.GetListOfDevices(DeviceList);

  IF DeviceList.Count < 1 then begin
      ShowMessage('NO HAY CÁMARAS CONECTADAS - NO SE PUEDE TOMAR UNA FOTO');
      DeviceList.DisposeOf;
      exit;
  end else begin
      // If at least one camera has been found.
      with CB_ListaCamaras do begin
           Items.Clear;
           Items.Assign(DeviceList);
           ItemIndex := 0;
           DeviceList.DisposeOf;
      end;
  end;
end;

Codificando el OnClick para el boton EncenderCamara

Código Delphi [-]
procedure EncenderCamaraClick(Sender: TObject);
begin
  fVideoImage.SetDisplayCanvas(ImageCamera.Canvas);
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;

  fVideoImage.VideoStart(CB_ListaCamaras.Items[CB_ListaCamaras.itemindex]);

  CB_ListaCamaras.Enabled:=False;
  Screen.Cursor := crDefault;
end;

Codificando el OnClick para el boton Configure

Código Delphi [-]
procedure ConfigureClick(Sender: TObject);
begin
  FVideoImage.ShowProperty_Stream;
end;

Codificando el OnClick para el boton DetenerCamara

Código Delphi [-]
procedure DetenerCamaraClick(Sender: TObject);
begin
  FVideoImage.VideoStop;
  CB_ListaCamaras.Enabled:=True;
end;

Codificando el OnClick para el boton TomarFoto

Código Delphi [-]
procedure TomarFotoClick(Sender: TObject);
var
  PanelDC: HDC;
  Xwidth,Yheight: Integer;
begin
  Xwidth :=ImageCamera.Width;
  Yheight:=ImageCamera.Height;

  if not Assigned(ImagePhoto.Picture.Bitmap) then
    ImagePhoto.Picture.Bitmap := TBitmap.Create
  else
  begin
    ImagePhoto.Picture.Bitmap.DisposeOf;
    ImagePhoto.picture.Bitmap := TBitmap.Create;
  end;
  ImagePhoto.Picture.Bitmap.Height := Yheight;
  ImagePhoto.Picture.Bitmap.Width  := Xwidth;;

  PanelDC := GetDC(PanelCamara.Handle);
  try
    BitBlt(ImagePhoto.Picture.Bitmap.Canvas.Handle,
           0,0,Xwidth, Yheight, PanelDC, 0,0, SRCCOPY);
  finally
    ReleaseDC(Handle, PanelDC);
  end;

  ImagePhoto.Stretch := True;
  ImagePhoto.Proportional:=True;
end;

Consideraciones finales
Una vez que logramos capturar una instantánea del vídeo que corre como streaming en el TImage ImageCamera en el TImage ImagePhoto, podemos dar rienda suelta a nuestra creatividad para hacer uso de esa imagen adquirida. La misma puede ser almacenada en un campo Blob de una base de datos, o bien podemos guardarla como un archivo. Las posibilidades a partir de este punto ya no tienen limite mas que la propia imaginación de que uso se le quiere dar a este truco. Expreso mis deseo que les sea de utilidad a todos los interesados y sus comentarios serán bienvenidos para mejorar este humilde aporte.

[casacham]

No es necesario tener instalados componentes JEDI

[casacham]

Los archivos están en la terawiki, tuve que subirlos allí para poder compartirlos

[[ElKurgan]]

Gracias por compartir

Un saludo

[Casimiro Notevi]

Empezado por casacham

Los archivos están en la terawiki, tuve que subirlos allí para poder compartirlos

¿Dónde están y con qué nombre?

[Casimiro Notevi]

Empezado por Casimiro Notevi

¿Dónde están y con qué nombre?

Ya lo he visto

[alquimista]

Se que tiene unos años el post. Pero me he puesto a usar la webcam con DirectX después de tener una app hecha de hace años con avicap32 y no funcionar en todas las cámaras.
He implementado lo que comentáis arriba, creo que falta un Tpanel en el código y me funciona para todas las cámaras, pero he observado un problema.
He hecho un programa que pide tener un texto con el nombre de la foto en un edit. Si no hay nombre muestra un MessageBox.
Al mostrar dicho mensaje la webcam congela la imagen y hasta que no pulse Aceptar se descongela. Me ocurre con cualquier mensaje incluso con MessageDlg, etc.

He probado otro ejemplo por la web y ocurre igual. En avicap32 no me pasa.
He probado a poner Application.ProcessMessages; pero no funciona.
¿Me podéis sugerir algo?

[Casimiro Notevi]

Crea un hilo con tu pregunta en el foro adecuado, este es el de trucos.

[alquimista]

gracias por avisar