1. 技术文章
  2. Getting a snapshot from a webcam with Delphi

Getting a snapshot from a webcam with Delphi

由 ◇◆丶佛笑我妖孽 提交于 2019-11-29 00:17:13

Your program works for me on Win7 32bits with D2010.

What it does though is raising an exception: 

---------------------------
Project WebCamTest.exe raised exception class EFCreateError with message 
'Cannot create file "c:\webcam.jpg". Access is denied'.
---------------------------

which can be corrected by changing

FJpeg.SaveToFile('c:\webcam.jpg');

to

FJpeg.SaveToFile(TPath.GetTempPath + '\webcam.jpg');

And also, it does not display the whole available image, you'd have to enlarge your Panel, recenter or shrink the webcam output.

Update with some code modifications that would make it work per your comments...

  // introducing the RGB array and a buffer
  TVideoArray = array[1..PICHEIGHT] of array[1..PICWIDTH] of TRGBTriple;
  PVideoArray = ^TVideoArray;

  TForm1 = class(TForm)
[...]
  FBuf24_1: TVideoArray;
[...]

function FrameCallbackFunction(AHandle: hWnd; VIDEOHDR: TVideoHDRPtr): bool; stdcall;
var
  I: integer;
begin
  result:= true;

  with form1 do begin
  try
    if ConvertCodecToRGB(FCodec, VideoHDR^.lpData, @FBuf2, PICWIDTH, PICHEIGHT) then
    begin
      for I:= 1 to PICHEIGHT do FBuf1[I]:= FBuf2[PICHEIGHT- (I- 1)];
      SetBitmapBits(FBitmap.Handle, PICWIDTH* PICHEIGHT* SizeOf(DWord), @FBuf1);
    end
    else
    begin  // assume RGB
      for I:= 1 to PICHEIGHT do
        FBuf24_1[I] := PVideoArray(VideoHDR^.lpData)^[PICHEIGHT-I+1];
      SetBitmapBits(FBitmap.Handle, PICWIDTH* PICHEIGHT* SizeOf(RGBTriple), @FBuf24_1);
    end;
[...]

If you wish to use DirectX API instead of deprecated Video For Windows (VFW) API: http://www.delphibasics.info/home/delphibasicsprojects/directxdelphiwebcamcaptureexample

Here is a link to a larger project implementing the code detailed below: http://www.delphibasics.info/home/delphibasicssnippets/delphiwebcamcaptureexample

Interchange lines indicated by comment notation as you wish.

program WebcamTest;
//www.delphibasics.info
//cswi

uses
  Windows;

const
  WM_CAP_DRIVER_CONNECT = 1034;
  WM_CAP_GRAB_FRAME = 1084;
  //WM_CAP_SAVEDIB = 1049;
  WM_CAP_EDIT_COPY = 1054;//
  WM_CAP_DRIVER_DISCONNECT = 1035;

function SendMessageA(hWnd: Integer;
                      Msg: Integer;
                      wParam: Integer;
                      lParam: Integer): Integer;
                      stdcall;
                      external 'user32.dll' name 'SendMessageA';

function capGetDriverDescriptionA(DrvIndex: Cardinal;
                                  Name: PAnsiChar;
                                  NameLen: Integer;
                                  Description: PAnsiChar;
                                  DescLen: Integer) : Boolean;
                                  stdcall;
                                external 'avicap32.dll' name 'capGetDriverDescriptionA';

function capCreateCaptureWindowA(lpszWindowName: PAnsiChar;
                                 dwStyle: Integer;
                                 x : Integer;
                                 y : Integer;
                                 nWidth : Integer;
                                 nHeight : Integer;
                                 ParentWin: Integer;
                                 nId: Integer): Integer;
                                 stdcall;
                                 external 'avicap32.dll' name 'capCreateCaptureWindowA';

function IntToStr(i: Integer): String;
begin
  Str(i, Result);
end;

var
  WebCamId : Integer;
  CaptureWindow : Integer;
  x : Integer;
  FileName : PAnsiChar;
  hData:  DWORD;
  pData:  Pointer;
  dwSize: DWORD;
  szText : AnsiString;
  FileHandle, BytesWritten : LongWord;
begin
  WebcamId := 0;
  CaptureWindow := capCreateCaptureWindowA('CaptureWindow', 0, 0, 0, 0, 0, 0, 0);
  if CaptureWindow <> 0 then
  begin
    if SendMessageA(CaptureWindow, WM_CAP_DRIVER_CONNECT, WebCamId, 0) <> 1 then
    begin
      SendMessageA(CaptureWindow, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    end
    else
    begin
      for x := 1 to 20 do // Take 20 photos.
      begin
        SendMessageA(CaptureWindow, WM_CAP_GRAB_FRAME, 0, 0);
        FileName := PAnsiChar('C:\Test' + IntToStr(x) + '.bmp');
        //SendMessageA(CaptureWindow, WM_CAP_SAVEDIB, 0, LongInt(FileName));
        SendMessageA(CaptureWindow, WM_CAP_EDIT_COPY, 0, LongInt(FileName));//
        if OpenClipBoard(0) then
        begin
          hData := GetClipBoardData(CF_DIB);
          if hData <> 0 then
          begin
            pData := GlobalLock(hData);
            if pData <> nil then
            begin
              dwSize := GlobalSize(hData);
              if dwSize <> 0 then
              begin
                FileHandle := CreateFileA(FileName, GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_NEW, FILE_ATTRIBUTE_HIDDEN, 0);
                WriteFile(FileHandle, pData, dwSize, BytesWritten, nil);
                CloseHandle(FileHandle);
              end;
              GlobalUnlock(DWORD(pData));
            end;
          end;
          CloseClipBoard;
        end;
      end;
    end;
    SendMessageA(CaptureWindow, WM_CAP_DRIVER_DISCONNECT, 0, 0);
  end;
end.

I use a component called TVideoCap. It is for 3, 4, and 5 but it includes source so it is easy to update. It will do exactly what you want. Just do a search for 'TVideoCap'.

标签
Delphi
callback
webcam
video-capture
vfw
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!