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;
 
Links relacionados

Webcam con Delphi ( I )


Webcam con Delphi ( II )

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

tButton
Definició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

tButton
Definició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;



Artículos relacionados

Webcam con Delphi ( I )

Webcam con Delphi ( III )

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.

Links relacionados
Webcam con Delphi ( II )

WebCam con Delphi ( III )Webcam con OpenGL

Webcams:
Logitech C920 HD Pro
Creative Live Cam Chat HD
Logitec C270 Webcam para videoconferencias