我使用下面的代码来捕获摄像头:
unit Webcam;
interface
uses
Windows, Messages, SysUtils, Graphics, ExtCtrls, Classes, VFW {https://drkb.ru/multimedia/audio/extract_track/ed7dcb6994c641e4};
type
TCamera = class(TObject)
private
class var VideoHwnd: HWND;
class function FrameCallback(hCapWnd: HWND; lpVHdr: PVIDEOHDR): DWORD;
stdcall; static;
public
constructor Create(Owner: TPanel);
destructor Destroy; override;
end;
var
Camera: TCamera;
implementation
constructor TCamera.Create(Owner: TPanel);
begin
VideoHwnd := capCreateCaptureWindowA('', WS_CHILD or WS_VISIBLE, 0, 0, 640,
480, Owner.Handle, 0);
if (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then
begin
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, 1, 0);
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE, 1, 0);
SendMessage(VideoHwnd, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(VideoHwnd, WM_CAP_SET_SCALE, 1, 0);
SendMessage(VideoHwnd, WM_CAP_SET_CALLBACK_FRAME, 1,
lParam(@FrameCallback));
SendMessage(VideoHwnd,
{ WM_CAP_GRAB_FRAME } WM_CAP_GRAB_FRAME_NOSTOP, 1, 0);
end;
end;
destructor TCamera.Destroy;
begin
if (VideoHwnd <> 0) then
begin
SendMessage(VideoHwnd, WM_CAP_DRIVER_DISCONNECT, 1, 0);
SendMessage(VideoHwnd, WM_CLOSE, 1, 0);
end;
inherited;
end;
class function TCamera.FrameCallback(hCapWnd: HWND; lpVHdr: PVIDEOHDR)
: DWORD; stdcall;
var
MemoryStream: TMemoryStream;
BitmapInfo: TBitmapInfo;
Bitmap: TBitmap;
Hdb: Thandle;
begin
FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
if (SendMessage(hCapWnd, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo),
lParam(@BitmapInfo)) <> 0) then
begin
MemoryStream := TMemoryStream.Create;
try
Bitmap := TBitmap.Create;
try
with Bitmap do
begin
Width := BitmapInfo.bmiHeader.biWidth;
Height := BitmapInfo.bmiHeader.biHeight;
case BitmapInfo.bmiHeader.biBitCount of
1:
PixelFormat := pf1bit;
4:
PixelFormat := pf4bit;
8:
PixelFormat := pf8bit;
15:
PixelFormat := pf15bit;
16:
PixelFormat := pf16bit;
24:
PixelFormat := pf24bit;
32:
PixelFormat := pf32bit;
end;
Hdb := DrawDibOpen;
DrawDibDraw(Hdb, Canvas.Handle, 0, 0, BitmapInfo.bmiHeader.biWidth,
BitmapInfo.bmiHeader.biHeight, @BitmapInfo.bmiHeader,
lpVHdr^.lpdata, 0, 0, BitmapInfo.bmiHeader.biWidth,
BitmapInfo.bmiHeader.biHeight, 0);
DrawDibClose(Hdb);
SaveToStream(MemoryStream);
end;
MemoryStream.Position := 0;
finally
Bitmap.Free;
end;
finally
MemoryStream.Free;
end;
end;
end;
procedure GetDriverList(List: TStrings);
var
wIndex: Word;
szDeviceName: array [0 .. MAX_PATH] of AnsiChar;
szDeviceVersion: array [0 .. MAX_PATH] of AnsiChar;
begin
List.Clear;
for wIndex := 0 to 9 do
begin
if capGetDriverDescriptionA(wIndex, @szDeviceName, SizeOf(szDeviceName),
@szDeviceVersion, SizeOf(szDeviceVersion)) then
List.AddObject(szDeviceName, Pointer(wIndex));
end;
if List.Count = 0 then
RaiseLastOSError;
end;
end.
当我的窗体可见时,一切都正常。另一方面,当我的窗体配置为wsMinimize
,或通过代码隐藏时,只显示/捕获一个帧,然后它停止。
有什么解决办法吗?
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormActivate(Sender: TObject);
begin
ShowWindow(Handle, SW_HIDE);
end;
end.
编辑:
我在注解中插入了一个错误callback function,但似乎一切正常(没有报告错误)。
// inside TCamera class (private declarations):
class function ErrorCallback(hCapWnd: HWND; nErrID: Integer;
lpErrorText: LPTSTR): LRESULT; stdcall; static;
//...
class function TCamera.ErrorCallback(hCapWnd: HWND; nErrID: Integer;
lpErrorText: LPTSTR): LRESULT; stdcall;
begin
Result := 1;
if hCapWnd <= 0 then
begin
Result := 0;
Exit;
end;
if nErrID = 0 then
begin
Result := 1;
Exit;
end;
Writeln(IntToStr(nErrID) + ' : ' + PAnsiChar(lpErrorText) + ' : ' +
IntToStr(hCapWnd));
end;
1条答案
按热度按时间yzuktlbb1#
根据
WM_CAP_GRAB_FRAME_NOSTOP
文档:WM_CAP_GRAB_FRAME_NOSTOP
消息使用来自捕获设备的单个未压缩帧填充帧缓冲区,并显示该帧。与WM_CAP_GRAB_FRAME
消息不同,此消息不会更改覆盖或预览的状态。您可以显式发送此消息,也可以使用capGrabFrameNoStop
宏发送此消息。WM_CAP_GRAB_FRAME
文档也是这样说的:WM_CAP_GRAB_FRAME消息从捕获驱动程序检索并显示单个帧。捕获后,覆盖和预览将被禁用。您可以显式发送此消息,也可以使用capGrabFrame宏发送。
因此,您要求捕获窗口一次捕获1帧,这就是您得到的结果。
要连续捕获帧,您必须执行以下任一操作:
WM_CAP_GRAB_FRAME(_NOSTOP)
以请求下一帧。WM_CAP_SEQUENCE_NOFILE
与WM_CAP_SET_CALLBACK_VIDEOSTREAM
搭配使用,而不要将WM_CAP_GRAB_FRAME(_NOSTOP)
与WM_CAP_SET_CALLBACK_FRAME
搭配使用。