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, Vcl.Imaging.jpeg;
Declarar la siguiente variable
fVideoImage
Código Delphi
[-] private
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;
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
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.