casacham
23-04-2010, 22:09:44
Hola a todos los foreros
Se ha debatido demasiado sobre como capturar una foto desde una WebCam, y la mayoria de las respuestas coinciden con la utilizacion de un componente llamado TWain que es muy dificil de encontrar sino imposible. Otros han propuesto la utilizacion de un componente de la JVCL de la paleta JEDI denominado TJAviCapture. He tenido la posibilidad de probarlo y ver que funciona en D2009 pero resulto un poco engorrosa su aplicacion y dicho componente esta desarrollado para hacer mucho mas que capturar solo una foto WebCam, por eso lo interesante de la sencillez del codigo descripto en este hilo. Solo pocos han preguntado como hacer una captura de una foto desde una WebCam sin objeto alguno. En este hilo tratare de explicar como se puede capturar una foto desde una WebCam utilizando unos comandos de la API de Windows cuyas principales funciones y procedimientos estan descriptos en este archivo WIN32S.HLP.
Por razones de practicidad vamos a encapsular todo el codigo necesario para realizar dicha tarea en una Unit.pas que nos definira un componente propio. El siguiente codigo deben colocarlo dentro de una unit.
unit Webcam;
interface
uses
Windows, Messages;
type
TWebcam = class
constructor Create(
const WindowName: String = '';
ParentWnd: Hwnd = 0;
Left: Integer = 0;
Top: Integer = 0;
Width: Integer = 0;
height: Integer = 0;
Style: Cardinal = WS_CHILD or WS_VISIBLE;
WebcamID: Integer = 0);
public
const
WM_Connect = WM_USER + 10;
WM_Disconnect = WM_USER + 11;
WM_GrabFrame = WM_USER + 60;
WM_SaveDIB = WM_USER + 25;
WM_Preview = WM_USER + 50;
WM_PreviewRate = WM_USER + 52;
WM_Configure = WM_USER + 41;
public
procedure Connect;
procedure Disconnect;
procedure GrabFrame;
procedure SaveDIB(const FileName: String = 'webcam.bmp');
procedure Preview(&on: Boolean = True);
procedure PreviewRate(Rate: Integer = 42);
procedure Configure;
private
CaptureWnd: HWnd;
end;
implementation
function capCreateCaptureWindowA(
WindowName: PChar;
dwStyle: Cardinal;
x,y,width,height: Integer;
ParentWin: HWnd;
WebcamID: Integer): Hwnd; stdcall external 'AVICAP32.dll';
{ TWebcam }
procedure TWebcam.Configure;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Configure, 0, 0);
end;
procedure TWebcam.Connect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Connect, 0, 0);
end;
constructor TWebcam.Create(const WindowName: String; ParentWnd: Hwnd; Left, Top,
Width, height: Integer; Style: Cardinal; WebcamID: Integer);
begin
CaptureWnd := capCreateCaptureWindowA(PChar(WindowName), Style, Left, Top, Width, Height,
ParentWnd, WebcamID);
end;
procedure TWebcam.Disconnect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Disconnect, 0, 0);
end;
procedure TWebcam.GrabFrame;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_GrabFrame, 0, 0);
end;
procedure TWebcam.Preview(&on: Boolean);
begin
if CaptureWnd <> 0 then
if &on then
SendMessage(CaptureWnd, WM_Preview, 1, 0)
else
SendMessage(CaptureWnd, WM_Preview, 0, 0);
end;
procedure TWebcam.PreviewRate(Rate: Integer);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_PreviewRate, Rate, 0);
end;
procedure TWebcam.SaveDIB(const FileName: String);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_SaveDIB, 0, Cardinal(PChar(FileName)));
end;
end.
Salven la unit como WebCam
Como pueden observar el codigo esta basado puramente en la API de Win, y entendemos que se trata de enviar o recibir mensajes asi que esa parte no debe darnos problemas. La funcion especifica en cuestion es la denominada capCreateCaptureWindowA, que a continuacion veremos que dice la ayuda de la API.
The capCreateCaptureWindow function creates a capture window.
HWND VFWAPI capCreateCaptureWindow(
LPCSTR lpszWindowName,
DWORD dwStyle,
int x,
int y,
int nWidth,
int nHeight,
HWND hWnd,
int nID
);
Parameters
lpszWindowName
Null-terminated string containing the name used for the capture window.
dwStyle
Window styles used for the capture window. Window styles are described with the CreateWindowEx function.
x and y
The x- and y-coordinates of the upper left corner of the capture window.
nWidth and nHeight
Width and height of the capture window.
hWnd
Handle of the parent window.
nID
Window identifier.
Return Values
Returns a handle of the capture window if successful or NULL otherwise.
A continuacion un ejemplo de como implementarla en una aplicacion desarrollada en Delphi.
Paso 1 - Creamos una nueva aplicacion
File -> New -> VCL Forms Applications - Delphi.
Paso 2 - Creamos nuestro objeto en una nueva unit
File -> New -> Unit - Delphi
Copiamos el codigo aqui descripto y luego salvamos esta Unit como WebCam
Paso 3 - Diseño de la Form1
En nuestra Form colocamos un TPanel, con las siguientes dimensiones with 640 heigh 480, una TImage y dos TButton, uno tendra en su caption Encender y el otro Tomar Foto.
Paso 4 - Codigo para hacer funcionar la captura
En el Uses agregaremos WebCam
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, Webcam;
En el evento OnCreate de nuestra Form pondremos lo siguiente.
.....
.....
.....
private
{ Private declarations }
public
{ Public declarations }
camera: TWebcam;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,
1000, 1000);
end;
Este codigo sera para el boton de encendido o apagado de la camara
procedure TForm1.Button1Click(Sender: TObject);
const
str_Connect = 'Encender la camara';
str_Disconn = 'Apagar la camara';
begin
if (Sender as TButton).Caption = str_Connect then begin
camera.Connect;
camera.Preview(true);
Camera.PreviewRate(4);
(Sender as TButton).Caption:=str_Disconn;
end
else begin
camera.Disconnect;
(Sender as TButton).Caption:=str_Connect;
end;
end;
Y este codigo para el boton de captura de la foto
procedure TForm1.Button2Click(Sender: TObject);
var
PanelDC: HDC;
begin
if not Assigned(Image1.Picture.Bitmap) then
Image1.Picture.Bitmap := TBitmap.Create
else
begin
Image1.Picture.Bitmap.Free;
Image1.picture.Bitmap := TBitmap.Create;
end;
Image1.Picture.Bitmap.Height := Panel1.Height;
Image1.Picture.Bitmap.Width := Panel1.Width;
Image1.Stretch := True;
PanelDC := GetDC(Panel1.Handle);
try
BitBlt(Image1.Picture.Bitmap.Canvas.Handle,
0,0,Panel1.Width, Panel1.Height, PanelDC, 0,0, SRCCOPY);
finally
ReleaseDC(Handle, PanelDC);
end;
end;
Aqui podemos observar que aparece una segunda funcion API de Win que hace el resto del trabajo, esta funcion es BitBlt y su explicacion es la siguiente
The BitBlt function performs a bit-block transfer of the color data corresponding to a rectangle of pixels from the specified source device context into a destination device context.
BOOL BitBlt(
HDC hdcDest, // handle to destination device context
int nXDest, // x-coordinate of destination rectangle's upper-left corner
int nYDest, // y-coordinate of destination rectangle's upper-left corner
int nWidth, // width of destination rectangle
int nHeight, // height of destination rectangle
HDC hdcSrc, // handle to source device context
int nXSrc, // x-coordinate of source rectangle's upper-left corner
int nYSrc, // y-coordinate of source rectangle's upper-left corner
DWORD dwRop // raster operation code
);
Parameters
hdcDest
Identifies the destination device context.
nXDest
Specifies the logical x-coordinate of the upper-left corner of the destination rectangle.
nYDest
Specifies the logical y-coordinate of the upper-left corner of the destination rectangle.
nWidth
Specifies the logical width of the source and destination rectangles.
nHeight
Specifies the logical height of the source and the destination rectangles.
hdcSrc
Identifies the source device context.
nXSrc
Specifies the logical x-coordinate of the upper-left corner of the source rectangle.
nYSrc
Specifies the logical y-coordinate of the upper-left corner of the source rectangle.
dwRop
Specifies a raster-operation code. These codes define how the color data for the source rectangle is to be combined with the color data for the destination rectangle to achieve the final color.
The following list shows some common raster operation codes:
Value Description
BLACKNESS Fills the destination rectangle using the color associated with index 0 in the physical palette. (This color is black for the default physical palette.)
DSTINVERT Inverts the destination rectangle.
MERGECOPY Merges the colors of the source rectangle with the specified pattern by using the Boolean AND operator.
MERGEPAINT Merges the colors of the inverted source rectangle with the colors of the destination rectangle by using the Boolean OR operator.
NOTSRCCOPY Copies the inverted source rectangle to the destination.
NOTSRCERASE Combines the colors of the source and destination rectangles by using the Boolean OR operator and then inverts the resultant color.
PATCOPY Copies the specified pattern into the destination bitmap.
PATINVERT Combines the colors of the specified pattern with the colors of the destination rectangle by using the Boolean XOR operator.
PATPAINT Combines the colors of the pattern with the colors of the inverted source rectangle by using the Boolean OR operator. The result of this operation is combined with the colors of the destination rectangle by using the Boolean OR operator.
SRCAND Combines the colors of the source and destination rectangles by using the Boolean AND operator.
SRCCOPY Copies the source rectangle directly to the destination rectangle.
SRCERASE Combines the inverted colors of the destination rectangle with the colors of the source rectangle by using the Boolean AND operator.
SRCINVERT Combines the colors of the source and destination rectangles by using the Boolean XOR operator.
SRCPAINT Combines the colors of the source and destination rectangles by using the Boolean OR operator.
WHITENESS Fills the destination rectangle using the color associated with index 1 in the physical palette. (This color is white for the default physical palette.)
Return Values
If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.
Remarks
If a rotation or shear transformation is in effect in the source device context, BitBlt returns an error. If other transformations exist in the source device context (and a matching transformation is not in effect in the destination device context), the rectangle in the destination device context is stretched, compressed, or rotated as necessary.
If the color formats of the source and destination device contexts do not match, the BitBlt function converts the source color format to match the destination format.
When an enhanced metafile is being recorded, an error occurs if the source device context identifies an enhanced-metafile device context.
Not all devices support the BitBlt function. For more information, see the RC_BITBLT raster capability entry in GetDeviceCaps.
BitBlt returns an error if the source and destination device contexts represent different devices.
Se ha debatido demasiado sobre como capturar una foto desde una WebCam, y la mayoria de las respuestas coinciden con la utilizacion de un componente llamado TWain que es muy dificil de encontrar sino imposible. Otros han propuesto la utilizacion de un componente de la JVCL de la paleta JEDI denominado TJAviCapture. He tenido la posibilidad de probarlo y ver que funciona en D2009 pero resulto un poco engorrosa su aplicacion y dicho componente esta desarrollado para hacer mucho mas que capturar solo una foto WebCam, por eso lo interesante de la sencillez del codigo descripto en este hilo. Solo pocos han preguntado como hacer una captura de una foto desde una WebCam sin objeto alguno. En este hilo tratare de explicar como se puede capturar una foto desde una WebCam utilizando unos comandos de la API de Windows cuyas principales funciones y procedimientos estan descriptos en este archivo WIN32S.HLP.
Por razones de practicidad vamos a encapsular todo el codigo necesario para realizar dicha tarea en una Unit.pas que nos definira un componente propio. El siguiente codigo deben colocarlo dentro de una unit.
unit Webcam;
interface
uses
Windows, Messages;
type
TWebcam = class
constructor Create(
const WindowName: String = '';
ParentWnd: Hwnd = 0;
Left: Integer = 0;
Top: Integer = 0;
Width: Integer = 0;
height: Integer = 0;
Style: Cardinal = WS_CHILD or WS_VISIBLE;
WebcamID: Integer = 0);
public
const
WM_Connect = WM_USER + 10;
WM_Disconnect = WM_USER + 11;
WM_GrabFrame = WM_USER + 60;
WM_SaveDIB = WM_USER + 25;
WM_Preview = WM_USER + 50;
WM_PreviewRate = WM_USER + 52;
WM_Configure = WM_USER + 41;
public
procedure Connect;
procedure Disconnect;
procedure GrabFrame;
procedure SaveDIB(const FileName: String = 'webcam.bmp');
procedure Preview(&on: Boolean = True);
procedure PreviewRate(Rate: Integer = 42);
procedure Configure;
private
CaptureWnd: HWnd;
end;
implementation
function capCreateCaptureWindowA(
WindowName: PChar;
dwStyle: Cardinal;
x,y,width,height: Integer;
ParentWin: HWnd;
WebcamID: Integer): Hwnd; stdcall external 'AVICAP32.dll';
{ TWebcam }
procedure TWebcam.Configure;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Configure, 0, 0);
end;
procedure TWebcam.Connect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Connect, 0, 0);
end;
constructor TWebcam.Create(const WindowName: String; ParentWnd: Hwnd; Left, Top,
Width, height: Integer; Style: Cardinal; WebcamID: Integer);
begin
CaptureWnd := capCreateCaptureWindowA(PChar(WindowName), Style, Left, Top, Width, Height,
ParentWnd, WebcamID);
end;
procedure TWebcam.Disconnect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Disconnect, 0, 0);
end;
procedure TWebcam.GrabFrame;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_GrabFrame, 0, 0);
end;
procedure TWebcam.Preview(&on: Boolean);
begin
if CaptureWnd <> 0 then
if &on then
SendMessage(CaptureWnd, WM_Preview, 1, 0)
else
SendMessage(CaptureWnd, WM_Preview, 0, 0);
end;
procedure TWebcam.PreviewRate(Rate: Integer);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_PreviewRate, Rate, 0);
end;
procedure TWebcam.SaveDIB(const FileName: String);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_SaveDIB, 0, Cardinal(PChar(FileName)));
end;
end.
Salven la unit como WebCam
Como pueden observar el codigo esta basado puramente en la API de Win, y entendemos que se trata de enviar o recibir mensajes asi que esa parte no debe darnos problemas. La funcion especifica en cuestion es la denominada capCreateCaptureWindowA, que a continuacion veremos que dice la ayuda de la API.
The capCreateCaptureWindow function creates a capture window.
HWND VFWAPI capCreateCaptureWindow(
LPCSTR lpszWindowName,
DWORD dwStyle,
int x,
int y,
int nWidth,
int nHeight,
HWND hWnd,
int nID
);
Parameters
lpszWindowName
Null-terminated string containing the name used for the capture window.
dwStyle
Window styles used for the capture window. Window styles are described with the CreateWindowEx function.
x and y
The x- and y-coordinates of the upper left corner of the capture window.
nWidth and nHeight
Width and height of the capture window.
hWnd
Handle of the parent window.
nID
Window identifier.
Return Values
Returns a handle of the capture window if successful or NULL otherwise.
A continuacion un ejemplo de como implementarla en una aplicacion desarrollada en Delphi.
Paso 1 - Creamos una nueva aplicacion
File -> New -> VCL Forms Applications - Delphi.
Paso 2 - Creamos nuestro objeto en una nueva unit
File -> New -> Unit - Delphi
Copiamos el codigo aqui descripto y luego salvamos esta Unit como WebCam
Paso 3 - Diseño de la Form1
En nuestra Form colocamos un TPanel, con las siguientes dimensiones with 640 heigh 480, una TImage y dos TButton, uno tendra en su caption Encender y el otro Tomar Foto.
Paso 4 - Codigo para hacer funcionar la captura
En el Uses agregaremos WebCam
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, Webcam;
En el evento OnCreate de nuestra Form pondremos lo siguiente.
.....
.....
.....
private
{ Private declarations }
public
{ Public declarations }
camera: TWebcam;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,
1000, 1000);
end;
Este codigo sera para el boton de encendido o apagado de la camara
procedure TForm1.Button1Click(Sender: TObject);
const
str_Connect = 'Encender la camara';
str_Disconn = 'Apagar la camara';
begin
if (Sender as TButton).Caption = str_Connect then begin
camera.Connect;
camera.Preview(true);
Camera.PreviewRate(4);
(Sender as TButton).Caption:=str_Disconn;
end
else begin
camera.Disconnect;
(Sender as TButton).Caption:=str_Connect;
end;
end;
Y este codigo para el boton de captura de la foto
procedure TForm1.Button2Click(Sender: TObject);
var
PanelDC: HDC;
begin
if not Assigned(Image1.Picture.Bitmap) then
Image1.Picture.Bitmap := TBitmap.Create
else
begin
Image1.Picture.Bitmap.Free;
Image1.picture.Bitmap := TBitmap.Create;
end;
Image1.Picture.Bitmap.Height := Panel1.Height;
Image1.Picture.Bitmap.Width := Panel1.Width;
Image1.Stretch := True;
PanelDC := GetDC(Panel1.Handle);
try
BitBlt(Image1.Picture.Bitmap.Canvas.Handle,
0,0,Panel1.Width, Panel1.Height, PanelDC, 0,0, SRCCOPY);
finally
ReleaseDC(Handle, PanelDC);
end;
end;
Aqui podemos observar que aparece una segunda funcion API de Win que hace el resto del trabajo, esta funcion es BitBlt y su explicacion es la siguiente
The BitBlt function performs a bit-block transfer of the color data corresponding to a rectangle of pixels from the specified source device context into a destination device context.
BOOL BitBlt(
HDC hdcDest, // handle to destination device context
int nXDest, // x-coordinate of destination rectangle's upper-left corner
int nYDest, // y-coordinate of destination rectangle's upper-left corner
int nWidth, // width of destination rectangle
int nHeight, // height of destination rectangle
HDC hdcSrc, // handle to source device context
int nXSrc, // x-coordinate of source rectangle's upper-left corner
int nYSrc, // y-coordinate of source rectangle's upper-left corner
DWORD dwRop // raster operation code
);
Parameters
hdcDest
Identifies the destination device context.
nXDest
Specifies the logical x-coordinate of the upper-left corner of the destination rectangle.
nYDest
Specifies the logical y-coordinate of the upper-left corner of the destination rectangle.
nWidth
Specifies the logical width of the source and destination rectangles.
nHeight
Specifies the logical height of the source and the destination rectangles.
hdcSrc
Identifies the source device context.
nXSrc
Specifies the logical x-coordinate of the upper-left corner of the source rectangle.
nYSrc
Specifies the logical y-coordinate of the upper-left corner of the source rectangle.
dwRop
Specifies a raster-operation code. These codes define how the color data for the source rectangle is to be combined with the color data for the destination rectangle to achieve the final color.
The following list shows some common raster operation codes:
Value Description
BLACKNESS Fills the destination rectangle using the color associated with index 0 in the physical palette. (This color is black for the default physical palette.)
DSTINVERT Inverts the destination rectangle.
MERGECOPY Merges the colors of the source rectangle with the specified pattern by using the Boolean AND operator.
MERGEPAINT Merges the colors of the inverted source rectangle with the colors of the destination rectangle by using the Boolean OR operator.
NOTSRCCOPY Copies the inverted source rectangle to the destination.
NOTSRCERASE Combines the colors of the source and destination rectangles by using the Boolean OR operator and then inverts the resultant color.
PATCOPY Copies the specified pattern into the destination bitmap.
PATINVERT Combines the colors of the specified pattern with the colors of the destination rectangle by using the Boolean XOR operator.
PATPAINT Combines the colors of the pattern with the colors of the inverted source rectangle by using the Boolean OR operator. The result of this operation is combined with the colors of the destination rectangle by using the Boolean OR operator.
SRCAND Combines the colors of the source and destination rectangles by using the Boolean AND operator.
SRCCOPY Copies the source rectangle directly to the destination rectangle.
SRCERASE Combines the inverted colors of the destination rectangle with the colors of the source rectangle by using the Boolean AND operator.
SRCINVERT Combines the colors of the source and destination rectangles by using the Boolean XOR operator.
SRCPAINT Combines the colors of the source and destination rectangles by using the Boolean OR operator.
WHITENESS Fills the destination rectangle using the color associated with index 1 in the physical palette. (This color is white for the default physical palette.)
Return Values
If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.
Remarks
If a rotation or shear transformation is in effect in the source device context, BitBlt returns an error. If other transformations exist in the source device context (and a matching transformation is not in effect in the destination device context), the rectangle in the destination device context is stretched, compressed, or rotated as necessary.
If the color formats of the source and destination device contexts do not match, the BitBlt function converts the source color format to match the destination format.
When an enhanced metafile is being recorded, an error occurs if the source device context identifies an enhanced-metafile device context.
Not all devices support the BitBlt function. For more information, see the RC_BITBLT raster capability entry in GetDeviceCaps.
BitBlt returns an error if the source and destination device contexts represent different devices.