Manipular WebCam

[[escafandra]]

Te pongo un ejemplo que conecta la cámara, la desconecta y hace fotos.

Prepara tu formulario con:
Tres botones: Conectar, Desconectar, Hacer foto.
Un TPanel que será la ventana de previsualización.

El código sera el siguiente:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    hWndC : THandle;
    procedure SetResolution(Width, Height: integer);
  public
  end;


var
  Form1: TForm1;

const
  WM_CAP_START                    = WM_USER;
  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_GET_VIDEOFORMAT          = WM_CAP_START + 44;
  WM_CAP_SET_VIDEOFORMAT          = WM_CAP_START + 45;
  WM_CAP_SET_PREVIEW              = WM_CAP_START + 50;
  WM_CAP_SET_OVERLAY              = WM_CAP_START + 51;
  WM_CAP_SET_PREVIEWRATE          = WM_CAP_START + 52;
  WM_CAP_SET_SCALE                = WM_CAP_START + 53;


function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle, x, y, nWidth, nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'AVICAP32.DLL';

implementation

{$R *.dfm}

// Conectar
procedure TForm1.Button1Click(Sender: TObject);
begin
  hWndC := capCreateCaptureWindowA('Ventana de captura', WS_CHILD or WS_VISIBLE ,0, 0, Panel1.Width,Panel1.Height,Panel1.Handle,0);
  if hWndC <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
    SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
    SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 40, 0);
    SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
    SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
    Panel1.Width:= 640;
    Panel1.Height:= 480;
    SetResolution(Panel1.Width, Panel1.Height);
    Button2.Enabled:= true;
    Button3.Enabled:= true;
  end;
end;

// Desconectar
procedure TForm1.Button2Click(Sender: TObject);
begin
  if hWndC <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SendMessage(hWndC, WM_CLOSE, 0, 0);
    hWndC := 0;
  end;
  Button2.Enabled:= false;
  Button3.Enabled:= false;
end;

// Sacar Foto
procedure TForm1.Button3Click(Sender: TObject);
begin
  if hWndC <> 0 then begin
    SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(ExtractFilePath(Application.ExeName)+'test.bmp')));
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
  if hWndC <> 0 then begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
  end;
end;

procedure TForm1.SetResolution(Width, Height: integer);
var
  bi: BITMAPINFO;
begin
  SendMessage(hWndC, WM_CAP_GET_VIDEOFORMAT, sizeof(bi), Cardinal(@bi));
  bi.bmiHeader.biWidth:= Width;
  bi.bmiHeader.biHeight:= Height;

  if SendMessage(hWndC, WM_CAP_SET_VIDEOFORMAT, sizeof(bi), Cardinal(@bi)) <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
    Button2.Enabled:= false;
    Button3.Enabled:= false;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled:= false;
  Button3.Enabled:= false;
end;

end.

En principio la resolución será de 640 x 480 pero puedes cambiarla. Ya puedes encuadrar tu foto y disparar cuando te plazca.

Saludos.