function capCreateCaptureWindowA(lpWindowName: PChar; dwStyle, X, Y, nWidth, nHeight, hWnd, nID: Integer): Cardinal; stdcall external 'avicap32';
function capGetDriverDescriptionA(wDriverIndex: Word; lpszName: PChar; cbName: Cardinal; lpszVer: PChar; cbVer: Cardinal): LongBool; stdcall external 'avicap32';
function GetCapture(lpszName: PChar; hWnd: Integer): Cardinal;
var
DeviceName: array [0..31] of Char;
Rect: TRect;
begin
Result := 0;
repeat if capGetDriverDescriptionA(Result, @DeviceName, SizeOf(DeviceName), nil, 0) and (lstrcmp(@DeviceName, lpszName) = 0) then
begin GetClientRect(hWnd, Rect);
hWnd := capCreateCaptureWindowA('cap.wnd', WS_CHILD or WS_VISIBLE, 0, 0, Rect.Right, Rect.Bottom, hWnd, 0);
if hWnd <> 0 then
begin
SendMessage(hWnd, WM_USER + 10, Result, 0);
SendMessage(hWnd, WM_USER + 53, 1, 0);
SendMessage(hWnd, WM_USER + 52, 33, 0);
SendMessage(hWnd, WM_USER + 51, 0, 0);
SendMessage(hWnd, WM_USER + 50, 1, 0);
ShowWindow(hWnd, SW_SHOW);
end;
Result := hWnd;
Exit;
end;
Inc(Result);
until Result = 10;
Result := 0;
end;
procedure Capture(const hCapture: Cardinal; const lpFileName: PChar);
begin
SendMessage(hCapture, WM_USER + 60, 0, 0);
SendMessage(hCapture, WM_USER + 25, 0, Integer(lpFileName));
SendMessage(hCapture, WM_USER + 50, 1, 0); end;
var hCapture: Cardinal;
procedure TForm1.Button1Click(Sender: TObject);
begin
Capture(hCapture, 'c:\archivo.bmp');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
hCapture := GetCapture('Creative WebCam NX Pro (VFW)', Panel1.Handle);
end;