WebCam-Bildzugriff: Zuerst Grabbe & Dekomprimiere den Frame!

[TStringlist]

> WebCam-Bildzugriff: Zuerst Grabbe & Dekomprimiere den Frame!


Hallo


Jeder Delphianer und gleichzeitige WebCam-Besitzer möchte wohl in jedem Fall irgendwann auch mal eines absolut sicher: Nämlich im eigenen Programm auf die laufenden Bilder seiner WebCam zugreifen können (um dann z.B. an diesen immer wieder aktuellen WebCam-Bildern eine Bildauswertung durchzuführen). Dabei sollten jedoch möglichst folgende Bedingungen erfüllt sein:

1) Die Beschaffung eines jeweiligen WebCam-Bildes sollte natürlich auch in einem Programm funktionieren, welches dann auch mal weitgehend im Hintergrund laufen kann (was ja beim PREVIEW'en der WebCam-Frames nicht der Fall ist) und

2) Das Verfahren sollte möglichst einfach sein, also auch schon mit den normalen 'Bordmitteln' von Delphi funktionieren, sprich: Ohne dafür noch extra irgendwelche event. undurchsichtige Units downloaden zu müssen.


Wie das z.B. auch geht, sollte dann möglichst im folgenden kurzen Programm klar werden, in welchem übrigens alles andere konsequent weggelassen wurde, was nicht für eine solche reine Bildbeschaffung notwendig ist.



Ansonsten zum Programm selbst, hier schon mal vorab eine kurze Erläuterung bezüglich der wesentlichen Aktionen darin:

Im Rahmen der primären Einstellungen (in 'FormCreate') wird zuerst einmal mittels der Video Capture Messages das PREVIEW der WebCam-Frames initiiert. Dadurch wird das laufende WebCam-Bild auf einem Control des eigenen Delphi-Programms sichtbar gemacht. Das alleine reicht aber für einen wirklichen Bildzugriff noch nicht aus, z.B. auch schon deswegen, weil nämlich bei einem im Hintergrund verschwindenden Programm dieser PREVIEW-Vorgang dann zum Stillstand kommt.

Hinzukommen müssen noch zwei weitere Dinge: Und zwar einmal ein auch im Hintergrund lauffähiges 'Grabben' des WebCam-Frames, welcher daraufhin dann jeweils in einer Frame-Callback-Funktion zur Verfügung gestellt wird. Und hinzukommen muss außerdem auch noch eine Dekomprimierung dieses Frames, denn der wird dort in dieser Frame-Callback-Funktion immer nur komprimiert angeliefert.

Während das 'Grabben' eines Frames noch relativ einfach ist und durch das Timer-gemanagte Absenden von nur jeweils einer WM_CAP_GRAB_FRAME_NOSTOP-Message bewerkstelligt wird (plus dem vorhergehenden Installieren der schon erwähnten Frame-Callback-Funktion), ist zur Dekomprimierung noch etwas mehr Aufwand nötig.

Hierfür (zur Dekomprimierung eines solchen Frames) nutzt man nämlich einen davor erst noch zu suchenden sogenannten Codec. Dieses ist ein Compressor/Decompressor, der entweder sowieso schon auf dem System drauf ist oder der bei der Installierung irgendeiner Hardware dann noch mit dazu geladen wurde.

Wichtig für diese also zuerst noch auszuführende Codec-Suche ist dann schließlich, dass zwischen dem Source-Frame und dem Destination-Buffer (DIB-FBitmap2) die Formate gleich sind und das der Codec diese Dekomprimierung auch überhaupt beherrscht. Alle hierfür nötigen Informationen brauchen daher bloß noch in Form der beiden jeweiligen BitmapInfos an die Codecs übergeben zu werden, um diese dann der Reihe nach diesbezüglich befragen zu können. Ist ein solcher Codec gefunden, dann wird die Suche abgebrochen und dieser gefundene Codec auch sogleich benutzt, dh. er wird dann nochmals (am Ende von 'FormCreate') geöffnet und anschließend in der Frame-Callback-Funktion zu einer jeweiligen Dekomprimierung veranlasst.

Im Anschluss an diese Dekomprimierung brauchen die daheraus resultierenden Bit-Daten dann nur noch mehr mittels einer einfachen 'setDIBits'-Anweisung auf das normale FBitmap übertragen zu werden und sind danach verfügbar für jeden weiteren quasi normalen Bildzugriff (um damit auch letztlich wieder beim ursprünglichen Betreff dieses Threads herausgekommen zu sein).



Hier der Code:

(Fürs unkomplizierte Ausprobieren: Nur ein Panel (640*480) und einen Timer auf die Form ziehen. Dann jeweils einen Doppelklick auf das OnCreate und OnDestroy der Form u. einen auf das OnTimer des Timers. Anschließend die gesamte Unit1 per copy&paste durch diese hier ersetzen. ...And last but not least: Man halte danach irgendeinen roten Gegenstand in die linke obere Ecke des WebCam-Bildes und lasse durch das Programm ALARM schlagen.)

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, mmSystem;

const
  // Video Capture Messages
  WM_CAP_START = WM_USER;
  WM_CAP_DRIVER_CONNECT      = WM_CAP_START + 10;
  // WM_CAP_SET_PREVIEW ist NICHT hintergrundlauffähig
  WM_CAP_SET_PREVIEW         = WM_CAP_START + 50;
  WM_CAP_SET_PREVIEWRATE     = WM_CAP_START + 52;
  // WM_CAP_GRAB_FRAME_NOSTOP ist hintergrundlauffähig !!!
  WM_CAP_GRAB_FRAME_NOSTOP   = WM_CAP_START + 61;
  WM_CAP_SET_CALLBACK_FRAME  = WM_CAP_START + 5;
  WM_CAP_GET_VIDEOFORMAT     = WM_CAP_START + 44;

  WM_CAP_DLG_VIDEOFORMAT     = WM_CAP_START+41;

//   -   -   -   -   -   -   -   -

  // Messages for installable Compressors
  ICM_USER              = (DRV_USER+$0000) ;
  ICM_DECOMPRESS_QUERY  = (ICM_USER+11) ; // query support for decompress
  ICM_DECOMPRESS_BEGIN  = (ICM_USER+12) ; // start a series of decompress calls
  ICM_DECOMPRESS_END    = (ICM_USER+14) ; // end a series of decompress calls


  ICTYPE_VIDEO = ord ('v') +
                 ord ('i') shl  8 +
                 ord ('d') shl 16 +
                 ord ('c') shl 24;

  ICMODE_COMPRESS       = 1;
  ICMODE_DECOMPRESS     = 2;
  ICMODE_FASTDECOMPRESS = 3;
  ICMODE_QUERY          = 4;
  ICMODE_FASTCOMPRESS   = 5;
  ICMODE_DRAW           = 8;
  ICMODE_CONST = ICMODE_FASTDECOMPRESS;

  ICDECOMPRESS_HURRYUP     = $80000000;  // don't draw just buffer (hurry up!)
  ICDECOMPRESS_UPDATE      = $40000000;  // don't draw just update
  ICDECOMPRESS_PREROLL     = $20000000;  // this frame is before real start
  ICDECOMPRESS_NULLFRAME   = $10000000;  // repeat last frame
  ICDECOMPRESS_NOTKEYFRAME = $08000000;  // this frame is not a key frame
  ICDECOMPRESS_CONST = ICDECOMPRESS_UPDATE;

  ICERR_OK              = 0 ;

type
  HIC = THandle;
  PVOID = Pointer;

  // enthält Information über den gegrabbten Frame
  TVIDEOHDR = record
    lpData         : PBYTE;  // address of video buffer
    dwBufferLength : DWORD;  // size, in bytes, of the Data buffer
    dwBytesUsed    : DWORD;  // Bytes actually used
    dwTimeCaptured : DWORD;  // Milliseconds from start of stream
    dwUser         : DWORD;  // user-specific data
    dwFlags        : DWORD;  // assorted flags (see defines)
    dwReserved     : array[0..3] of DWORD; // reserved for driver
  end;
  PVIDEOHDR = ^TVideoHDR;

  // enthält Informationen über den De/Compressor
  TICInfo = packed record 
    dwSize,
    fccType,
    fccHandler,
    dwFlags,
    dwVersio,
    dwVersionICM  : DWORD;
    szName        : array [0..15] of wchar;
    szDescription : array [0..127] of wchar;
    szDriver      : array [0..127] of wchar;
  end;


  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure AppException (Sender: TObject; E: Exception);
    procedure Timer1Timer(Sender: TObject);
  private
    FCapHandle : THandle;          // Handle des CapWindows
    FfccType, FfccHandler : DWord; // 'fcc-Kennung' des Codecs
    FICHandle : THandle;           // Handle des Codecs
    FGrabFrameFlag : Boolean;      // 'Zu/Auf-macher' der Callback-Funk
    FPicHeight, FPicWidth : integer;
    FBitmap, FBitmap2 : TBitmap;
    FBuf2 : Pointer;               // ^Bit-Buffer von FBitmap2
    FCapBitmapInfo,                // BitmapInfo des PREVIEW FRAMES
    FBitmapInfo2 : TBitmapInfo;    // BitmapInfo von FBitmap2
    function EnumerateAndAskVideoCodecs : Boolean;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}


// zuerst einige Functions die external deklariert sind:

function capCreateCaptureWindow(
  lpszWindowName  : LPCSTR;
  dwStyle         : DWORD;
  x, y            : integer;
  nWidth, nHeight : integer;
  hwndParent      : HWND;
  nID             : integer): HWND;
stdcall; external 'AVICAP32.DLL' name 'capCreateCaptureWindowA';

function ICInfo (fccType, fccHandler : DWORD; var ICInfo: TICInfo): BOOL;
stdcall; external 'msvfw32.dll';

function ICOpen (fccType, fccHandler : DWORD; wMode: UINT): THandle;
stdcall; external 'msvfw32.dll';

function ICClose (Handle: THandle): LRESULT;
stdcall; external 'msvfw32.dll';

function ICSendMessage(hic: HIC; msg: UINT; dw1, dw2: DWORD) : DWORD;
stdcall; external 'msvfw32.dll';

function ICDecompress(     // decompress a single frame
  hic        : HIC;
  dwFlags    : DWORD;             // flags (from AVI index...)
  lpbiFormat : PBITMAPINFOHEADER; // BITMAPINFO of compressed data
  lpData     : PVOID;             // source data pointer
  lpbi       : PBITMAPINFOHEADER; // DIB to decompress to
  lpBits     : PVOID): DWORD;     // destination data pointer
cdecl; external 'MSVFW32.DLL';


//=============================================================

// die Callback-Function in der dann jeder Frame vorbeigereicht wird
function FrameCallbackFunction(AHandle : hWnd; VIDEOHDRPtr : PVIDEOHDR): bool; stdcall;
var I : integer;
    AColor : array[1..4] of byte;
begin
  result := true;

  with form1 do begin
    // da diese Callback-Funk sonst auch bei jedem Preview-Frame ganz durchlaufen werden würde:
    // Freigabe nur per FGrabFrameFlag; wird in der Timer-Proc zuvor jeweils auf TRUE gesetzt
    if FGrabFrameFlag = false then exit;
    FGrabFrameFlag := false;

    // dekomprimieren der Frame-Rohdaten durch den schon im Creater geöffneten Codec
    ICSendMessage(FICHandle, ICM_DECOMPRESS_BEGIN, integer(@FCapBitmapInfo), integer(@FBitmapInfo2));
    I := ICDecompress(FICHandle,ICDECOMPRESS_CONST, @FCapBitmapInfo,VIDEOHDRPtr^.lpData,
                                                    @FBitmapInfo2,FBuf2);
    if I <> ICERR_OK then windows.beep(2000,20); // nur nochmal 'ne "Ohrenkontrolle"
    ICSendMessage(FICHandle, ICM_DECOMPRESS_END, 0, 0);

    // laden der DIB-Bits in das normale (DDB-)FBitmap zur weiteren ganz normalen Bildbearbeitung
    SetDIBits(FBitmap2.Canvas.Handle,FBitmap.Handle,0,FPicHeight,FBuf2,FBitmapInfo2,DIB_RGB_COLORS);

    // + Code zur Untersuchung der Bildes, z.B.: Wenn ein bestimmter Pixel X/Y
    // (=0/0) des Pictures rot ist, dann schlage Alarm... (oder so)
    DWord(AColor) := FBitmap.Canvas.Pixels[0,0];
    if (AColor[1] >= AColor[2]+50) and (AColor[1] >= AColor[3]+50) then beep;
  end;
end;


// bewirkt das periodisches Grabben eines WebCam-Frames
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  FGrabFrameFlag := true;
  SendMessage(FCapHandle, WM_CAP_GRAB_FRAME_NOSTOP, 1, 0);
end;


//================================================================

// befragt alle auffindbaren Video-Codecs
function TForm1.EnumerateAndAskVideoCodecs : Boolean;
var
  Counter   : integer;
  ICInfoRec : TICInfo;
  Ahic      : THandle;
begin
  result := false;
  Counter := 0;
  // solange noch kein passender Video-Codec gefunden wurde, wird weitergesucht
  while (result = false) and ICInfo(ICTYPE_VIDEO, counter, ICInfoRec) do begin
    // Versuch den Codec zur Befragung zu öffnen
    Ahic := ICOpen(ICInfoRec.fccType, ICInfoRec.fccHandler, ICMODE_QUERY);
    if Ahic<>0 then begin
      // befragen des Codecs ob er die Dekomprimierung ausführen kann
      if ICSendMessage(Ahic, ICM_DECOMPRESS_QUERY, integer(@FCapBitmapInfo), integer(@FBitmapInfo2)) = ICERR_OK then begin
        // wenn ja, dann: Speichern der Codec-"fcc-Kennung" + Abbruch der Codec-Suche
        FfccType := ICInfoRec.fccType;
        FfccHandler := ICInfoRec.fccHandler;
        result := true;
      end;
      ICClose(Ahic);
    end;
    inc(counter);
  end;
end;

//-------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
var ImgHdrSize,ImgSize : DWord;
begin
  Application.OnException := AppException;
  Timer1.Enabled := false;
  FGrabFrameFlag := false; // reguliert die "Freigabe" der Callback-Funktion

  // Anweisungen zum Schalten des PREVIEWs der WebCam-Frames
  FCapHandle := capCreateCaptureWindow('Video',ws_child+ws_visible, 0, 0,
  Panel1.Width, Panel1.Height, Panel1.Handle, 1);
  SendMessage(FCapHandle, WM_CAP_DRIVER_CONNECT, 0, 0);
  SendMessage(FCapHandle, WM_CAP_SET_PREVIEWRATE, 15, 0);
  SendMessage(FCapHandle, WM_CAP_SET_PREVIEW, 1, 0);

  // Eingabe-Dialog fürs Format und die Comprimierung des PREVIEWs
  // (beides auch gleichzeitig gültig für die gegrabbten Frames)
  SendMessage(FCapHandle, WM_CAP_DLG_VIDEOFORMAT,1,0);

  // das BitmapInfo der PREVIEW FRAMES muss beschafft werden
  FillChar(FCapBitmapInfo, SizeOf(FCapBitmapInfo), 0);
  SendMessage(FCapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(FCapBitmapInfo), Integer(@FCapBitmapInfo));
  // nach dem Format der PREVIEW FRAMES richtet sich weiteres
  FPicWidth := FCapBitmapInfo.bmiHeader.biWidth;
  FPicHeight := FCapBitmapInfo.bmiHeader.biHeight;
  Panel1.Width := FPicWidth;
  Panel1.Height := FPicHeight;

  // Endempfänger des jeweils gegrabbten und dekomprimierten Frames
  FBitmap := TBitmap.Create;
  FBitmap.Width := FPicWidth;
  FBitmap.Height := FPicHeight;
  FBitmap.PixelFormat := pf24Bit;

  // ein zweites zu FBitmap kompatibles TBitmap, welches gleich in ein
  // DIB umgewandelt wird. Das BitmapInfo, das dadurch anfallen wird, ist 
  // dann für die Suche eines Codecs und die Dekomprimierung essentiell.
  FBitmap2 := TBitmap.Create;
  FBitmap2.Width := FPicWidth;
  FBitmap2.Height := FPicHeight;
  FBitmap2.PixelFormat := pf24Bit;
  // Umwandlung von FBitmap2 in ein DIB
  GetDIBSizes(FBitmap2.Handle,ImgHdrSize,ImgSize);
  GetMem(FBuf2,ImgSize);
  GetDIB(FBitmap2.Handle, FBitmap2.Palette, FBitmapInfo2, FBuf2^);

  // Suche nach einem passenden Codec ...
  if EnumerateAndAskVideoCodecs = false // ist die Codec-Suche erfolglos...
  then raise Exception.Create('Kein passender Codec gefunden') // Prog-Ende
  else begin // sonst wird alles fürs Frame-Grabben & Decompressen eingeschaltet
    FICHandle := ICOpen(FfccType, FfccHandler, ICMODE_CONST);
    SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, integer(@FrameCallbackFunction));
    Timer1.Enabled := true;
  end;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  ICClose(FICHandle);
  FreeMem(FBuf2);
  FBitmap2.Free;
  FBitmap.Free;
end;


// Bei irgendwelchen Exceptions: E.Message-Output & Prog-Ende 
procedure TForm1.AppException (Sender: TObject; E: Exception);
begin
  showMessage('Fehler!' +#13#13+
              E.Message + #13#13 +
              'Programm wird abgebrochen.');
  Application.Terminate;
end;


end.

Funktioniert perfekt bei einer 'Philips ToUCam Pro I' mit den da möglichen Komprimierungsarten IYUV und I420.


Vielleicht noch ein Tipp: Wer in dieser Richtung noch ein bisschen weitergraben möchte, der sollte sich dazu dann vielleicht doch noch eine extra Unit zulegen, nämlich die Unit 'VFW.PAS'. (Beim Downloaden der Jedi-Komponenten ist die z.B. automatisch dabei ...ansonsten im Web aber event. auch noch hier verfügbar). Da sind zwar keine Problemlösungen als solches drin, aber trotzdem ist diese Unit ein 1A-Nachschlagewerk bezüglich der ganzen Deklarationen aller Video Capture- und Compression-Messages, external-Functions, Typen und Konstanten (also auch Error-Meldungen etc.), die für dieses Thema so insgesamt nur wichtig sein können. Außerdem, diese Unit in der Uses-Klausel würde dann natürlich auch sämtliche eigenen Deklarationen dieser Art überflüssig machen und jedes Programm damit auch wieder um einiges kürzer bzw. übersichtlicher.


Gruß,
TStringlist