Webcam con Delphi ( III )

Continuando con el proyecto de manejo de una webcam con Delphi os presento el procedimiento para detener la grabación de una secuencia de video:



Tenéis que crear un tButton llamado "PararVideo" y en el evento Onclick teclear lo siguiente:



PROCEDURE TForm1.PararVideoClick(Sender: TObject);

BEGIN

IF ventana <> 0 THEN

BEGIN

SendMessage(ventana, WM_CAP_STOP, 0, 0);

END;

END;







UNIT WEBCAM

============

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.

=================

EJEMPLO DE USO

===============

en el evento OnCreate:

... 

  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;

ENCENDIDO Y 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; 

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;

Webcam con Delphi ( II )

A continuación os muestro nuevas utilidades para usar una webcam con Delphi.



ALMACENAR UNA SECUENCIA DE VIDEO

Nuevos componentes del form:



tSaveDialog,Definición de propiedades:

- Name = Guardar



tButtonDefinición de propiedades:

- Name = BtnAlmacenarVideo

- Caption = AlmacenarVideo



En el Evento Onclic del tButton poner

PROCEDURE TForm1.BtnAlmacenarVideoClick(Sender: TObject);
BEGIN
   IF Ventana <> 0 THEN
   BEGIN
      Guardar.Filter := 'Fichero AVI (*.avi)*.avi';
      Guardar.DefaultExt := 'avi';
      Guardar.FileName := 'FicheroAvi';
      IF Guardar.Execute THEN
      BEGIN
         SendMessage(Ventana, WM_CAP_FILE_SET_CAPTURE_FILEA, 0,
            Longint(pchar(Guardar.Filename)));
         SendMessage(Ventana, WM_CAP_SEQUENCE, 0, 0);
      END;
   END;
END;

GUARDAR UNA FOTO DE LA VENTANA DE CAPTURA

Añadir un tButton



tButtonDefinición de propiedades:

- Name = BtnGuardarImagen

- Caption = Guardar Imagen



Código del Botón

PROCEDURE TForm1.BtnGuardarImagenClick(Sender: TObject); 
BEGIN
IF Ventana <> 0 THEN
BEGIN
Guardar.FileName := 'Captura de la imagen';
Guardar.DefaultExt := 'bmp';
Guardar.Filter := 'Fichero Bitmap (*.bmp)*.bmp';
IF Guardar.Execute THEN
SendMessage(Ventana, WM_CAP_SAVEDIB, 0,
longint(pchar(Guardar.FileName)));
END;
END;

Webcam con Delphi (I)

A continuación os presento el software que os permitirá manejar vuestra Webcam con Delphi.



Primeramente tenéis que instalar en vuestro sistema el software "Microsoft Video for Windows SDK " que contiene la librería Avicap32.dll.

Dentro de las funciones que contiene utilizaremos "capCreateCaptureWindowA" para inicializar el driver y capturar la imagen.

Después para manejar la ventana de captura tendremos que usar la función "SendMessage" lo que facilita y simplifica muchísimo el trabajo a los programadores.

Ahora vamos con el programa:



Como variables globales añadimos:



Ventana: hwnd; //Handle de la ventana de captura



En la sección "const" escribimos:





WM_CAP_START = WM_USER;

WM_CAP_STOP = WM_CAP_START + 68;

WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;

WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;

WM_CAP_SAVEDIB = WM_CAP_START + 25;

WM_CAP_GRAB_FRAME = WM_CAP_START + 60;

WM_CAP_SEQUENCE = WM_CAP_START + 62;

WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;

WM_CAP_EDIT_COPY = WM_CAP_START + 30;

WM_CAP_SET_PREVIEW = WM_CAP_START + 50;

WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;





En la sección "implementation":





FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; STDCALL EXTERNAL 'AVICAP32.DLL';





Es la llamada a la librería externa Avicap32.dll



Elementos de la interface:



-Botón "iniciar" (Al pulsarlo empezará la captura de la imagen procedente de la Webcam)



-Botón "detener" (Para parar la captura de la imagen)



-Control de Imagen "tImage" (lo llamaremos "Image1")

El código que se incluirá dentro de los botones es el siguiente:



Botón "Iniciar"

PROCEDURE TForm1.Button1Click(Sender: TObject);
BEGIN
  Ventana := capCreateCaptureWindowA('Ventana de captura',
     WS_CHILD OR WS_VISIBLE, image1.Left, image1.Top, image1.Width,
     image1.Height, form1.Handle, 0);
  IF Ventana <> 0 THEN
  BEGIN
     TRY
        SendMessage(Ventana, WM_CAP_DRIVER_CONNECT, 0, 0);
        SendMessage(Ventana, WM_CAP_SET_PREVIEWRATE, 40, 0);
        SendMessage(Ventana, WM_CAP_SET_PREVIEW, 1, 0);
     EXCEPT
        RAISE;
     END;
  END
  ELSE
  BEGIN
     MessageDlg('Error al conectar Webcam', mtError, [mbok], 0);
  END;
END;

Botón "Detener"

PROCEDURE TForm1.Button2Click(Sender: TObject);
BEGIN
  IF Ventana <> 0 THEN
  BEGIN
     SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
     Ventana := 0;
  END;
END;

En el evento Onclose deberemos hacer una llamada al procedimiento incluido en el botón "Detener".

Y eso es todo por ahora, en posteriores artículos iremos añadiendo más utilidades.