I need to get a regular snapshot from a webcam in Delphi. Speed is not a problem (once per second). I tried the demo code based on the material from http://delphi.pjh2.de , but I can not get it to work. It compiles and works fine, but the callback function never works.
I do not have a real webcam, but instead I run the simulator. The simulator works (I see the video using Skype), but not with the test application. I don’t know where to start ...
Can anyone bother trying this code? (Apologies for the voluminous post - could not find how or if you can attach the files - a zip file is available here .)
Alternatively, any webcam demo code will be appreciated, preferably with a known good EXE, as well as with the source.
program WebCamTest; uses Forms, WebCamMainForm in 'WebCamMainForm.pas' {Form1}, yuvconverts in 'yuvconverts.pas'; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. unit WebCamMainForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, YUVConverts, StdCtrls, JPeg {, TntStdCtrls} ; const WM_CAP_START = WM_USER; WM_CAP_DRIVER_CONNECT = WM_CAP_START+ 10; WM_CAP_SET_PREVIEW = WM_CAP_START+ 50; WM_CAP_SET_OVERLAY = WM_CAP_START+ 51; WM_CAP_SET_PREVIEWRATE = WM_CAP_START+ 52; 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; PICWIDTH= 640; PICHEIGHT= 480; SUBLINEHEIGHT= 18; EXTRAHEIGHT= 400; type TVIDEOHDR= record 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; DWordDim= array[1..PICWIDTH] of DWord; TForm1 = class(TForm) Timer1: TTimer; Panel1: TPanel; procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Timer1Timer(Sender: TObject); private FCapHandle: THandle; FCodec: TVideoCodec; FBuf1, FBuf2: array[1..PICHEIGHT] of DWordDim; FBitmap: TBitmap; FJpeg: TJPegImage; { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} function capCreateCaptureWindow(lpszWindowName: LPCSTR; dwStyle: DWORD; x, y, nWidth, nHeight: integer; hwndParent: HWND; nID: integer): HWND; stdcall; external 'AVICAP32.DLL' name 'capCreateCaptureWindowA'; function FrameCallbackFunction(AHandle: hWnd; VIDEOHDR: TVideoHDRPtr): bool; stdcall; var I: integer; begin result:= true; with form1 do begin try ConvertCodecToRGB(FCodec, VideoHDR^.lpData, @FBuf2, PICWIDTH, PICHEIGHT); for I:= 1 to PICHEIGHT do FBuf1[I]:= FBuf2[PICHEIGHT- (I- 1)]; SetBitmapBits(FBitmap.Handle, PICWIDTH* PICHEIGHT* SizeOf(DWord), @FBuf1); FBitmap.Canvas.Brush.Color:= clWhite; FBitmap.Canvas.Font.Color:= clRed; FJpeg.Assign(FBitmap); FJpeg.CompressionQuality:= 85; FJpeg.ProgressiveEncoding:= true; FJpeg.SaveToFile('c:\webcam.jpg'); SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, 0); except end; end; end; //------------------------------------------------------------------------------ procedure TForm1.FormCreate(Sender: TObject); var BitmapInfo: TBitmapInfo; begin Timer1.Enabled := false; FBitmap:= TBitmap.Create; FBitmap.Width:= PICWIDTH; FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT+ EXTRAHEIGHT; FBitmap.PixelFormat:= pf32Bit; FBitmap.Canvas.Font.Assign(Panel1.Font); FBitmap.Canvas.Brush.Style:= bssolid; FBitmap.Canvas.Rectangle(0, PICHEIGHT, PICWIDTH, PICHEIGHT+ SUBLINEHEIGHT); FJpeg:= TJpegImage.Create; FCapHandle:= capCreateCaptureWindow('Video', WS_CHILD or WS_VISIBLE, 0, 0, PICWIDTH, PICHEIGHT, Panel1.Handle, 1); SendMessage(FCapHandle, WM_CAP_DRIVER_CONNECT, 0, 0); SendMessage(FCapHandle, WM_CAP_SET_PREVIEWRATE, 15000, 0); sendMessage(FCapHandle, WM_CAP_SET_OVERLAY, 1, 0); SendMessage(FCapHandle, WM_CAP_SET_PREVIEW, 1, 0); // SendMessage(FCapHandle, WM_CAP_DLG_VIDEOFORMAT,1,0); // -this was commented out FillChar(BitmapInfo, SizeOf(BitmapInfo), 0); SendMessage(FCapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo)); FCodec:= BICompressionToVideoCodec(bitmapinfo.bmiHeader.biCompression); if FCodec<> vcUnknown then begin Timer1.Enabled:= true; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin FBitmap.Free; FJpeg.Free; end; procedure TForm1.FormActivate(Sender: TObject); begin if FCodec= vcUnknown then showMessage('unknown compression'); FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT; end; //------------------------------------------------------------------------------ procedure TForm1.Timer1Timer(Sender: TObject); begin SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, integer(@FrameCallbackFunction)); SendMessage(FCapHandle, WM_CAP_GRAB_FRAME_NOSTOP, 1, 0); // ist hintergrundlauff盲hig end; end. object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 301 ClientWidth = 562 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnActivate = FormActivate OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 48 Top = 16 Width = 185 Height = 145 Caption = 'Panel1' TabOrder = 0 end object Timer1: TTimer OnTimer = Timer1Timer Left = 464 Top = 24 end end {**************************************************************************************************} { } { YUVConverts } { } { The contents of this file are subject to the Y Library Public License Version 1.0 (the } { "License"); you may not use this file except in compliance with the License. You may obtain a } { copy of the License at http://delphi.pjh2.de/ } { } { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } { ANY KIND, either express or implied. See the License for the specific language governing } { rights and limitations under the License. } { } { The Original Code is: YUVConverts.pas, part of CapDemoC.dpr. } { The Initial Developer of the Original Code is Peter J. Haas ( libs@pjh2.de ). Portions created } { by Peter J. Haas are Copyright (C) 2000-2005 Peter J. Haas. All Rights Reserved. } { } { Contributor(s): } { } { You may retrieve the latest version of this file at the homepage of Peter J. Haas, located at } { http://delphi.pjh2.de/ } { } {**************************************************************************************************} // For history see end of file {$ALIGN ON, $BOOLEVAL OFF, $LONGSTRINGS ON, $IOCHECKS ON, $WRITEABLECONST OFF, $OVERFLOWCHECKS OFF} {$RANGECHECKS OFF, $TYPEDADDRESS ON, $MINENUMSIZE 1} unit yuvconverts; interface uses Windows; type TVideoCodec = (vcUnknown, vcRGB, vcYUY2, vcUYVY, vcBTYUV, vcYVU9, vcYUV12, vcY8, vcY211); const BI_YUY2 = $32595559; // 'YUY2' BI_UYVY = $59565955; // 'UYVY' BI_BTYUV = $50313459; // 'Y41P' BI_YVU9 = $39555659; // 'YVU9' planar BI_YUV12 = $30323449; // 'I420' planar BI_Y8 = $20203859; // 'Y8 ' BI_Y211 = $31313259; // 'Y211' function BICompressionToVideoCodec(Value: DWord): TVideoCodec; function ConvertCodecToRGB(Codec: TVideoCodec; Src, Dst: Pointer; AWidth, AHeight: Integer): Boolean; implementation function BICompressionToVideoCodec(Value: DWord): TVideoCodec; begin case Value of BI_RGB, BI_BITFIELDS: Result := vcRGB; // no RLE BI_YUY2: Result := vcYUY2 ; BI_UYVY: Result := vcUYVY ; BI_BTYUV: Result := vcBTYUV; BI_YVU9: Result := vcYVU9; BI_YUV12: Result := vcYUV12; BI_Y8: Result := vcY8; BI_Y211: Result := vcY211; else Result := vcUnknown; end; end; const // RGB255 ColorFAQ fY = 298.082 / 256; fRU = 0; fGU = -100.291 / 256; fBU = 516.411 / 256; fRV = 408.583 / 256; fGV = -208.120 / 256; fBV = 0; { // RGB219 ColorFAQ too dark fY = 256 / 256; fRU = 0; fGU = -86.132 / 256; fBU = 443.506 / 256; fRV = 350.901 / 256; fGV = -178.738 / 256; fBV = 0; } { // Earl same like RGB255 fY = 1.164; fRU = 0; fGU = -0.392; fBU = 2.017; fRV = 1.596; fGV = -0.813; fBV = 0; } // |R| |fY fRU fRV| |Y| | 16| // |G| = |fY fGU fGV| * |U| - |128| // |B| |fY fBU fBV| |V| |128| type TYUV = packed record Y, U, V, F1: Byte; end; PBGR32 = ^TBGR32; TBGR32 = packed record B, G, R, A: Byte; end; function YUVtoBGRAPixel(AYUV: DWord): DWord; var ValueY, ValueU, ValueV: Integer; ValueB, ValueG, ValueR: Integer; begin ValueY := TYUV(AYUV).Y - 16; ValueU := TYUV(AYUV).U - 128; ValueV := TYUV(AYUV).V - 128; ValueB := Trunc(fY * ValueY + fBU * ValueU); // fBV = 0 if ValueB > 255 then ValueB := 255; if ValueB < 0 then ValueB := 0; ValueG := Trunc(fY * ValueY + fGU * ValueU + fGV * ValueV); if ValueG > 255 then ValueG := 255; if ValueG < 0 then ValueG := 0; ValueR := Trunc(fY * ValueY + fRV * ValueV); // fRU = 0 if ValueR > 255 then ValueR := 255; if ValueR < 0 then ValueR := 0; with TBGR32(Result) do begin B := ValueB; G := ValueG; R := ValueR; A := 0; end; end; type TDWordRec = packed record case Integer of 0: (B0, B1, B2, B3: Byte); 1: (W0, W1: Word); end; // UYVY // YUV 4:2:2 (Y sample at every pixel, U and V sampled at every second pixel // horizontally on each line). A macropixel contains 2 pixels in 1 DWord. // 16 Bits per Pixel, 4 Byte Macropixel // U0 Y0 V0 Y1 procedure UYVYtoRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); type PUYVY = ^TUYVY; TUYVY = packed record U, Y0, V, Y1: Byte; end; var x, y: Integer; w: Integer; SrcPtr: PDWord; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; YUV: DWord; b: Byte; begin SrcLineSize := AWidth * 2; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth div 2) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin YUV := SrcPtr^; // First Pixel b := TDWordRec(YUV).B0; TDWordRec(YUV).B0 := TDWordRec(YUV).B1; TDWordRec(YUV).B1 := b; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); // Second Pixel TDWordRec(YUV).B0 := TDWordRec(YUV).B3; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // YUY2, YUNV, V422 // YUV 4:2:2 as for UYVY but with different component ordering within the DWord // macropixel. // 16 Bits per Pixel, 4 Byte Macropixel // Y0 U0 Y1 V0 procedure YUY2toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); var x, y: Integer; w: Integer; SrcPtr: PDWord; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; YUV: DWord; b: Byte; begin SrcLineSize := AWidth * 2; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth div 2) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin YUV := SrcPtr^; // First Pixel b := TDWordRec(YUV).B2; // Y0 U Y1 V -> Y0 UV Y1 TDWordRec(YUV).B2 := TDWordRec(YUV).B3; TDWordRec(YUV).B3 := b; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); // Second Pixel TDWordRec(YUV).B0 := TDWordRec(YUV).B3; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // BTYUV, I42P // YUV 4:1:1 (Y sample at every pixel, U and V sampled at every fourth pixel // horizontally on each line). A macropixel contains 8 pixels in 3 DWords. // 16 Bits per Pixel, 12 Byte Macropixel // U0 Y0 V0 Y1 U4 Y2 V4 Y3 Y4 Y5 Y6 Y7 procedure BTYUVtoRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); type PBTYUVPixel = ^TBTYUVPixel; TBTYUVPixel = packed record U0, Y0, V0, Y1, U4, Y2, V4, Y3, Y4, Y5, Y6, Y7: Byte; end; var x, y: Integer; w: Integer; SrcPtr: PBTYUVPixel; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; YUV: DWord; SrcPixel: TBTYUVPixel; begin SrcLineSize := ((AWidth + 7) div 8) * (3 * 4); DstLineSize := AWidth * 4; w := AWidth - 1; for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; x := w; while x > 0 do begin // read macropixel SrcPixel := SrcPtr^; // First 4 Pixel TYUV(YUV).U := SrcPixel.U0; TYUV(YUV).V := SrcPixel.V0; TYUV(YUV).Y := SrcPixel.Y0; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x <= 0 then Break; TYUV(YUV).Y := SrcPixel.Y1; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x <= 0 then Break; TYUV(YUV).Y := SrcPixel.Y2; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x <= 0 then Break; TYUV(YUV).Y := SrcPixel.Y3; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x <= 0 then Break; // Second 4 Pixel TYUV(YUV).U := SrcPixel.U4; TYUV(YUV).V := SrcPixel.V4; TYUV(YUV).Y := SrcPixel.Y4; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x <= 0 then Break; TYUV(YUV).Y := SrcPixel.Y5; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x <= 0 then Break; TYUV(YUV).Y := SrcPixel.Y6; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Dec(x); if x <= 0 then Break; TYUV(YUV).Y := SrcPixel.Y7; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcPtr); end; Inc(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // YVU9 // 8 bit Y plane followed by 8 bit 4x4 subsampled V and U planes. // 9 Bits per Pixel, planar format procedure YVU9toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); var x, y, r, l: Integer; w: Integer; SrcYPtr: PByte; SrcUPtr: PByte; SrcVPtr: PByte; DstPtr: PDWord; SrcYLineSize: Integer; SrcUVLineSize: Integer; DstLineSize: Integer; YUV: DWord; begin DstLineSize := AWidth * 4; SrcYLineSize := AWidth; SrcUVLineSize := (AWidth + 3) div 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); SrcYPtr := Src; SrcVPtr := PByte(LongInt(SrcYPtr) + SrcYLineSize * AHeight); SrcUPtr := PByte(LongInt(SrcVPtr) + SrcUVLineSize * ((AHeight + 3) div 4)); w := (AWidth div 4) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to (AHeight div 4) - 1 do begin { TODO : bei ungeraden H枚hen fehlt letzte Reihe } for l := 0 to 3 do begin DstPtr := Dst; for x := 0 to w do begin // U and V YUV := (SrcUPtr^ shl 8) or (SrcVPtr^ shl 16); for r := 0 to 3 do begin YUV := (YUV and $00FFFF00) or SrcYPtr^; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcYPtr); end; Inc(SrcUPtr); Inc(SrcVPtr); end; Dec(PByte(Dst), DstLineSize); if l < 3 then begin Dec(SrcUPtr, SrcUVLineSize); Dec(SrcVPtr, SrcUVLineSize); end; end; end; end; // YUV12, I420, IYUV // 8 bit Y plane followed by 8 bit 2x2 subsampled U and V planes. // 12 Bits per Pixel, planar format procedure YUV12toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); // I420, IYUV var x, y, l: Integer; w: Integer; SrcYPtr: PByte; SrcUPtr: PByte; SrcVPtr: PByte; DstPtr: PDWord; SrcYLineSize: Integer; SrcUVLineSize: Integer; DstLineSize: Integer; YUV: DWord; begin DstLineSize := AWidth * 4; SrcYLineSize := AWidth; SrcUVLineSize := (AWidth + 1) div 2; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); SrcYPtr := Src; SrcUPtr := PByte(LongInt(SrcYPtr) + SrcYLineSize * AHeight); SrcVPtr := PByte(LongInt(SrcUPtr) + SrcUVLineSize * ((AHeight + 1) div 2)); w := (AWidth div 2) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to (AHeight div 2) - 1 do begin { TODO : bei ungeraden H枚hen fehlt letzte Reihe } for l := 0 to 1 do begin DstPtr := Dst; for x := 0 to w do begin // First Pixel YUV := SrcYPtr^ or (SrcUPtr^ shl 8) or (SrcVPtr^ shl 16); DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcYPtr); // Second Pixel YUV := (YUV and $00FFFF00) or SrcYPtr^; DstPtr^ := YUVtoBGRAPixel(YUV); Inc(DstPtr); Inc(SrcYPtr); Inc(SrcUPtr); Inc(SrcVPtr); end; Dec(PByte(Dst), DstLineSize); if l = 0 then begin Dec(SrcUPtr, SrcUVLineSize); Dec(SrcVPtr, SrcUVLineSize); end; end; end; end; // Y8, Y800 // Simple, single Y plane for monochrome images. // 8 Bits per Pixel, planar format procedure Y8toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); var x, y: Integer; w: Integer; SrcPtr: PByte; DstPtr: PDWord; SrcLineSize: Integer; DstLineSize: Integer; Pixel: DWord; begin SrcLineSize := AWidth; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth) - 1; for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin Pixel := SrcPtr^; TDWordRec(Pixel).B1 := TDWordRec(Pixel).B0; TDWordRec(Pixel).B2 := TDWordRec(Pixel).B0; TDWordRec(Pixel).B3 := 0; DstPtr^ := Pixel; Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; // Y211 // Packed YUV format with Y sampled at every second pixel across each line // and U and V sampled at every fourth pixel. // 8 Bits per Pixel, 4 Byte Macropixel // Y0, U0, Y2, V0 procedure Y211toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); type PYUYV = ^TYUYV; TYUYV = packed record Y0, U, Y2, V: Byte; end; var x, y: Integer; w : Integer; SrcPtr : PDWord; DstPtr : PDWord; SrcLineSize : Integer; DstLineSize : Integer; YUV: DWord; BGR: DWord; b: Byte; begin SrcLineSize := ((AWidth + 3) div 4) * 4; DstLineSize := AWidth * 4; // Dst is Bottom Top Bitmap Inc(PByte(Dst), (AHeight - 1) * DstLineSize); w := (AWidth div 4) - 1; { TODO : bei ungeraden Breiten fehlt letztes Pixel } for y := 0 to AHeight - 1 do begin SrcPtr := Src; DstPtr := Dst; for x := 0 to w do begin // Y0 U Y2 V YUV := SrcPtr^; // First and second Pixel b := TDWordRec(YUV).B2; // Y0 U Y2 V -> Y0 UV Y2 TDWordRec(YUV).B2 := TDWordRec(YUV).B3; TDWordRec(YUV).B3 := b; BGR := YUVtoBGRAPixel(YUV); DstPtr^ := BGR; Inc(DstPtr); DstPtr^ := BGR; Inc(DstPtr); // third and fourth TDWordRec(YUV).B0 := TDWordRec(YUV).B3; // Y0 UV Y2 -> Y2 UV Y2 BGR := YUVtoBGRAPixel(YUV); DstPtr^ := BGR; Inc(DstPtr); DstPtr^ := BGR; Inc(DstPtr); Inc(SrcPtr); end; Dec(PByte(Dst), DstLineSize); Inc(PByte(Src), SrcLineSize); end; end; function ConvertCodecToRGB(Codec: TVideoCodec; Src, Dst: Pointer; AWidth, AHeight: Integer): Boolean; begin Result := True; case Codec of vcYUY2: YUY2toRGB (Src, Dst, AWidth, AHeight); vcUYVY: UYVYtoRGB (Src, Dst, AWidth, AHeight); vcBTYUV: BTYUVtoRGB(Src, Dst, AWidth, AHeight); vcYVU9: YVU9toRGB (Src, Dst, AWidth, AHeight); vcYUV12: YUV12toRGB(Src, Dst, AWidth, AHeight); vcY8: Y8toRGB (Src, Dst, AWidth, AHeight); vcY211: Y211toRGB (Src, Dst, AWidth, AHeight); else Result := False; end; end; // History: // 2005-02-12, Peter J. Haas // // 2002-02-22, Peter J. Haas // - add YVU9, YUV12 (I420) // - add Y211 (untested) // // 2001-06-14, Peter J. Haas // - First public version // - YUY2, UYVY, BTYUV (Y41P), Y8 end.
Some message results:
var MsgResult : Integer ; procedure TForm1.FormCreate(Sender: TObject); var BitmapInfo: TBitmapInfo; begin Timer1.Enabled := false; FBitmap:= TBitmap.Create; FBitmap.Width:= PICWIDTH; FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT+ EXTRAHEIGHT; FBitmap.PixelFormat:= pf32Bit; FBitmap.Canvas.Font.Assign(Panel1.Font); FBitmap.Canvas.Brush.Style:= bssolid; FBitmap.Canvas.Rectangle(0, PICHEIGHT, PICWIDTH, PICHEIGHT+ SUBLINEHEIGHT); FJpeg:= TJpegImage.Create; FCapHandle:= capCreateCaptureWindow('Video', WS_CHILD or WS_VISIBLE, 0, 0, PICWIDTH, PICHEIGHT, Panel1.Handle, 1); // returns 2558326 MsgResult := SendMessage(FCapHandle, WM_CAP_DRIVER_CONNECT, 0, 0); // returns 0 MsgResult := SendMessage(FCapHandle, WM_CAP_SET_PREVIEWRATE, 15000, 0); // returns 1 MsgResult := sendMessage(FCapHandle, WM_CAP_SET_OVERLAY, 1, 0); // returns 0 MsgResult := SendMessage(FCapHandle, WM_CAP_SET_PREVIEW, 1, 0); // returns 0 // SendMessage(FCapHandle, WM_CAP_DLG_VIDEOFORMAT,1,0); // -this was commented out FillChar(BitmapInfo, SizeOf(BitmapInfo), 0); MsgResult := SendMessage(FCapHandle, WM_CAP_GET_VIDEOFORMAT, SizeOf(BitmapInfo), Integer(@BitmapInfo)); // returns 0 FCodec:= BICompressionToVideoCodec(bitmapinfo.bmiHeader.biCompression); // returns vcRGB if FCodec<> vcUnknown then begin Timer1.Enabled:= true; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin FBitmap.Free; FJpeg.Free; end; procedure TForm1.FormActivate(Sender: TObject); begin if FCodec= vcUnknown then showMessage('unknown compression'); FBitmap.Height:= PICHEIGHT+ SUBLINEHEIGHT; end; //------------------------------------------------------------------------------ procedure TForm1.Timer1Timer(Sender: TObject); begin MsgResult := SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, integer(@FrameCallbackFunction)); // returns 0 MsgResult := SendMessage(FCapHandle, WM_CAP_GRAB_FRAME_NOSTOP, 1, 0); // ist hintergrundlauff盲hig // returns 0 end;