Rückumwandlung eines gegrabten Frames (Webcam) in Bitmap

[TStringlist]

So, hier nochmal eine kleine Zusammenfassung des kurzen Codes, welcher (wenigstens bei mir) ohne Probleme läuft.

(...und mit dem man nun mittels eines im Hintergund laufenden Programms der Webcam alle Sekunde z.B. ein Bild 'abnehmen' kann, um dieses danach wie auch immer zu untersuchen. Das Clipboard bleibt dabei jetzt unberührt).

Delphi-Quellcode:

Uses ...,
     YUVConverts, // zur Dekomprimierung des Frame-Rohmaterials, aus Phantom1's Post
     ...;

const 
  WM_CAP_DRIVER_CONNECT = WM_USER + 10; 
  WM_CAP_EDIT_COPY = WM_USER + 30; 
  WM_CAP_SET_PREVIEW = WM_USER + 50; 
  WM_CAP_SET_OVERLAY = WM_USER + 51; 
  WM_CAP_SET_PREVIEWRATE = WM_USER + 52;
  WM_CAP_GRAB_FRAME_NOSTOP = WM_User + 61;
  WM_CAP_SET_CALLBACK_FRAME = WM_User + 5;

  WM_CAP_DLG_VIDEOFORMAT          = WM_USER+41;   //Formatauswahl 
  WM_CAP_DLG_VIDEOSOURCE          = WM_USER+42;   //Einstellungen 
  WM_CAP_DLG_VIDEOCOMPRESSION     = WM_USER+46;   //Kompression

  PicWidth = 640;
  PicHeight = 480;

type 
  ...
  DWordDim = array[1..PicWidth] of DWord;

var
  Form1: TForm1;
  VHandle : THandle;
  GrabFrameFlag : Boolean;
  Buf1,Buf2 : array[1..PicHeight] of DWordDim;
  FBitmap : TBitmap;

.
.
.

//Dann brauchst du noch das hier
function capCreateCaptureWindow(lpszWindowName: LPCSTR;
  dwStyle: DWORD;
  x, y,
  nWidth,
  nHeight: integer;
  hwndParent: HWND;
  nID: integer): HWND; stdcall;
  external 'AVICAP32.DLL' name 'capCreateCaptureWindowA';


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

procedure TForm1.FormCreate(Sender: TObject);
begin
  VHandle := capCreateCaptureWindow('Video',ws_child+ws_visible, 0, 0,
  PicWidth, PicHeight, Panel1.Handle, 1);
  SendMessage(VHandle, WM_CAP_DRIVER_CONNECT, 0, 0);
  SendMessage(VHandle, WM_CAP_SET_PREVIEWRATE, 15, 0);
  sendMessage(VHandle, WM_CAP_SET_OVERLAY, 1, 0);
  SendMessage(VHandle, wm_cap_set_preview, 1, 0);

  SendMessage(VHandle, WM_CAP_SET_CALLBACK_FRAME, 0, integer(@FrameCallbackFunction));

  SendMessage(VHandle,WM_CAP_DLG_VIDEOFORMAT,1,0);

  FBitmap := TBitmap.Create;
  FBitmap.Width := PicWidth;
  FBitmap.Height := PicHeight;
  FBitmap.PixelFormat := pf32Bit;

  GrabFrameFlag := false;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  FBitmap.free;
end;

Die eigentliche Frame-Callback-Funktion (sollte dann allerdings überm Creator stehen, sonst ist dort ihre Adresse noch nicht bekannt):

Delphi-Quellcode:

Type
TVIDEOHDR = record  // lpVHdr, aus dem INet herausgefischt
  lpData : Pointer; // address of video buffer
  dwBufferLength : DWord; // size, in bytes, of the Data buffer
  dwBytesUsed : DWord; // see below
  dwTimeCaptured : DWord; // see below
  dwUser : DWord; // user-specific data
  dwFlags : DWord; // see below
  dwReserved1, dwReserved2, dwReserved3 : DWord; // reserved; do not use
end;
TVIDEOHDRPtr = ^TVideoHDR;

function FrameCallbackFunction(AHandle : hWnd; VIDEOHDR : TVideoHDRPtr): bool; stdcall;
var I : integer;
  AColor : array[1..4] of byte;
begin
  result := true;

  // da diese Callback-Funktion sonst bei jedem Preview-Frame ganz durchlaufen werden würde:
  if GrabFrameFlag = false then exit;
  GrabFrameFlag := false;

  // dekomprimieren der Frame-Rohdaten
{ TVideoCodec = (vcUnknown, vcRGB, vcYUY2, vcUYVY, vcBTYUV, vcYVU9, vcYUV12, vcY8, vcY211); }
  ConvertCodecToRGB(vcYUV12,VideoHDR^.lpData,@Buf2,PicWidth,PicHeight);

  // da zu einem bottom-up-bitmap dekomprimiert wird, drehe ich die Daten nochmal rum
  for I := 1 to PicHeight do Buf1[I] := Buf2[PicHeight -(I-1)];

  // laden der fertigen Pixel-Daten nach FBitmap
  SetBitmapBits(FBitmap.Handle,PicWidth*PicHeight*SizeOf(DWord),@Buf1);

{
  // ...Code zur Untersuchung der Bildes, z.B.:
  DWord(AColor) := FBitmap.Canvas.Pixels[X,Y];
  // ist der Rot-Wert an einem bestimmten X/Y > als Z dann schlage Alarm...(oder so)
  if AColor[1] > Z then beep;
}

end;

Und schließlich noch die TimerProc, zur periodischen Webcam-Bildbearbeitung:

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  GrabFrameFlag := true;
  SendMessage(VHandle, WM_CAP_GRAB_FRAME_NOSTOP, 1, 0); // für die Hintergrundlaufbarkeit
end;