¿Componente para la webcam?

[AlexM]

Hola, estoy desarrollando un programa para windows. Una de las cosas que necesito es que en un form se vea reproducida la webcam. Se que hay un componente que se encarga de eso, pero no encuentro mucha información de este.

¿Cuál es su nombre y donde lo puedo instalar?

¡Gracias y saludos!

[[escafandra]]

Precisamente acabo de hacer una mini app que hace eso mismo: MiniWebCam

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Exit1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Rectangle1Click(Sender: TObject);
    procedure Round1Click(Sender: TObject);
    procedure SizeClick(Sender: TObject);
  private
    hWndC : THandle;
    Round: BOOL;
  public
    procedure SetResolution(Width, Height: integer);
  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_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}
var
OldWindowProc: Pointer;

function NewWindowProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
  hParent: THANDLE;
begin
  hParent:= GetParent(hWnd);
  if (Msg = WM_LBUTTONDOWN) or (Msg = WM_RBUTTONDOWN) then
  CallWindowProc(Pointer(GetWindowLong(hParent, GWL_WNDPROC)), hParent, Msg, WParam, LParam);
  Result:= CallWindowProc(OldWindowProc, hWnd, Msg, WParam, lParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Round:= false;
  Height:= 120;
  Width:= MulDiv(Height, 4, 3);
  hWndC := capCreateCaptureWindowA('Mi Ventana de captura', WS_CHILD or WS_VISIBLE ,0, 0, Width, Height, Handle, 0);
  if hWndC <> 0 then
  begin
    OldWindowProc:= Pointer(SetWindowLong(hWndC, GWL_WNDPROC, LongInt(@NewWindowProc)));
    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);
//    SetResolution(320, 240);
    SetResolution(640, 480);
//    SetResolution(800, 600);
  end;
end;

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

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
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);
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, $F012, 0);
  end
  else if Button = mbRight then
    PopupMenu1.Popup(Left+X, Top+Y);
end;

procedure TForm1.Round1Click(Sender: TObject);
var
  Rgn: HRGN;
  Rect: TRect;
begin
  Round:= true;
  Rect:= ClientRect;
  Rgn:= CreateRoundRectRgn(Rect.left, Rect.top, Rect.bottom, Rect.bottom, Rect.bottom, Rect.bottom);
  SetWindowRgn(Handle, Rgn, true);
end;

procedure TForm1.Rectangle1Click(Sender: TObject);
var
  Rgn: HRGN;
  Rect: TRect;
begin
  Round:= false;
  Rect:= ClientRect;
  Rgn:= CreateRectRgn(Rect.left, Rect.top, Rect.Right, Rect.Bottom);
  SetWindowRgn(Handle, Rgn, true);
end;

procedure TForm1.SizeClick(Sender: TObject);
var
  Item: TMenuItem;
begin
  Item:= TMenuItem(Sender);
  Height:= StrToInt(StringReplace(Item.Caption, '&', '', [rfReplaceAll]));
  Width:= MulDiv(Height, 4, 3);
  if Round then Round1Click(self)
  else Rectangle1Click(self);
  SetWindowPos(hWndC, 0, 0, 0, Width, Height, SWP_SHOWWINDOW or SWP_NOZORDER);
end;

end.

Saludos.

[[escafandra]]

Si sólo te hace falta un formulario normal y corriente, lo siguiente es un ejemplo de un previsualizador en un Form sin botones ni controles. Muestra una imajen de la Webcam a una resolución de 800x600:

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    hWndC : THandle;
  public
    procedure SetResolution(Width, Height: integer);
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_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}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Width:= 400;
  Height:= 300;
  hWndC := capCreateCaptureWindowA('Mi Ventana de captura', WS_CHILD or WS_VISIBLE ,0, 0, Width, Height, 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);
    SetResolution(640, 480);
  end;
end;

procedure TForm1.SetResolution(Width, Height: integer);
var
  bi: BITMAPINFO;
begin
  if hWndC = 0 then exit;  

  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);
  end;
end;

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

end.

Saludos.