[[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.