delphi 如何从相机捕捉连续帧?

pprl5pva  于 2022-11-04  发布在  其他
关注(0)|答案(1)|浏览(166)

我使用下面的代码来捕获摄像头:

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;
yzuktlbb

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帧,这就是您得到的结果。
要连续捕获帧,您必须执行以下任一操作:

相关问题