unit UnitWebcam;
interface
uses
Windows;
const
WM_CAP_DRIVER_CONNECT = $0400 + 10;
WM_CAP_DRIVER_DISCONNECT = $0400 + 11;
WM_CAP_SAVEDIB = $0400 + 25;
WM_CAP_GRAB_FRAME = $0400 + 60;
WM_CAP_SET_VIDEOFORMAT = $0400 + 45;
var
CaptureWindow: dword;
isConnected: Boolean;
function capCreateCaptureWindowA(lpszWindowName: PChar; dwStyle: dword;
x, y, nWidth, nHeight: word; ParentWin: dword; nId: word): dword;
stdcall external '
AVICAP32.DLL';
function capGetDriverDescriptionA(wDriverIndex: UINT; lpszName: LPSTR;
cbName: integer; lpszVer: LPSTR; cbVer: integer): BOOL;
stdcall;
external '
AVICAP32.DLL';
function ListWebcams():
string;
procedure GetWebcamSnapshot(Filename:
string);
Procedure ConnectWebcam(WebcamIndex: integer);
procedure DisconnectWebcam();
implementation
function ListWebcams():
string;
var
szName, szVersion:
array[0..MAX_PATH]
of char;
iReturn: boolean;
x: integer;
begin
x := 0;
repeat
iReturn := capGetDriverDescriptionA(x, @szName, sizeof(szName),
@szVersion, sizeof(szVersion));
if iReturn
then
begin
Result := Result + '
|"' + szName + '
- ' + szVersion + '
"';
Inc(x);
end;
until iReturn = False;
result := copy(result,2,length(result) - 2);
end;
Procedure ConnectWebcam(WebcamIndex: integer);
begin
CaptureWindow := capCreateCaptureWindowA('
CaptureWindow', WS_CHILD
or
WS_DISABLED, 0, 0, 0, 0, GetDesktopWindow, 0);
isConnected := (CaptureWindow <> 0)
and
(SendMessage(CaptureWindow, WM_CAP_DRIVER_CONNECT, WebcamIndex, 0) <> 0)
end;
procedure DisconnectWebcam();
begin
SendMessage(CaptureWindow, WM_CAP_DRIVER_DISCONNECT, 0, 0);
CaptureWindow := 0;
end;
procedure GetWebcamSnapshot(Filename:
string);
var
bmi: BITMAPINFO;
begin
if isConnected
then
begin
SendMessage(CaptureWindow, WM_CAP_SET_VIDEOFORMAT, 0, integer(@bmi));
SendMessage(CaptureWindow, WM_CAP_GRAB_FRAME, 0, 0);
SendMessage(CaptureWindow, WM_CAP_SAVEDIB, 0, longint(PChar(Filename)));
end;
end;
end.