使用Delphi从网络摄像头获取快照

使用Delphi从网络摄像头获取快照

关注
发信
关注(28)粉丝(399)

使用Delphi从网络摄像头获取快照

本文介绍了使用Delphi从网络摄像头获取快照的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 29岁程序员，3月因学历无情被辞！ 我需要从Delphi中的网络摄像头获取一个常规的快照。速度不是问题（一次是罚款）。我已经根据 http://delphi.pjh2.de 中的内容尝试过演示代码，但是我不能让它上班它编译并运行正常，但回调函数从不触发。 我没有真正的网络摄像头，而是运行，而不是模拟器。模拟器工作（我可以看到使用Skype的视频），但不是测试应用程序。我真的不知道从哪里开始看... 任何人都可以试试这个代码吗？ （对于大量的帖子抱歉 - 找不到如何或可以附加文件 - 一个zip文件可用 here 。） 或者，任何网络摄像头演示代码都将被欣赏，最好用已知的EXE以及来源。 程序WebCamTest; 使用表单， WebCamMainForm.pas中的WebCamMainForm {Form1}，$ y $ v $ y $ v $ {$ R * .res} begin Application.Initialize; Application.CreateForm（TForm1，Form1）; Application.Run; 结束。 unit WebCamMainForm; 接口 使用 Windows，消息，SysUtils，类，图形，控件，窗体，对话框，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：指针; //视频缓冲区地址 dwBufferLength：DWord; //数据缓冲区的大小（以字节为单位） dwBytesUsed：DWord; // see below dwTimeCaptured：DWord; // see below dwUser：DWord; //用户特定数据 dwFlags：DWord; // see below dwReserved1，dwReserved2，dwReserved3：DWord; //保留;不要使用 end; TVIDEOHDRPtr = ^ TVideoHDR; DWordDim =数组[1..PICWIDTH] DWord; TForm1 = class（TForm） Timer1：TTimer; Panel1：TPanel; procedure FormDestroy（Sender：TObject）; procedure FormCreate（Sender：TObject）; procedure FormActivate（Sender：TObject）; 程序Timer1Timer（Sender：TObject）; private FCapHandle：THandle; FCodec：TVideoCodec; FBuf1，FBuf2：DWordDim的数组[1..PICHEIGHT]; FBitmap：TBitmap; FJpeg：TJPegImage; {Private-Deklarationen} public {Public-Deklarationen} end; var Form1：TForm1; 实现 {$ R * .dfm} 函数capCreateCaptureWindow（lpszWindowName：LPCSTR; dwStyle：DWORD ; x，y， nWidth， nHeight：integer; hwndParent：HWND; nID：integer）：HWND;标准 external'AVICAP32.DLL'name'capCreateCaptureWindowA'; 函数FrameCallbackFunction（AHandle：hWnd; VIDEOHDR：TVideoHDRPtr）：bool;标准 var I：integer; begin result：= true; with form1 do begin try ConvertCodecToRGB（FCodec，VideoHDR ^ .lpData，@ FBuf2，PICWIDTH，PICHEIGHT）; 为I：= 1到PICHEIGHT做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）; 除结束; 结束结束 // ---------------------------------------- -------------------------------------- 程序TForm1.FormCreate （发件人：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或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被注释掉 FillChar（BitmapInfo，SizeOf（BitmapInfo），0）; SendMessage（FCapHandle，WM_CAP_GET_VIDEOFORMAT，SizeOf（BitmapInfo），Integer（@BitmapInfo））; FCodec：= BICompressionToVideoCodec（bitmapinfo.bmiHeader.biCompression）; 如果FCodec vcUnknown then begin Timer1.Enabled：= true; 结束结束 程序TForm1.FormDestroy（Sender：TObject）; begin FBitmap.Free; FJpeg.Free; 结束 程序TForm1.FormActivate（发件人：TObject）; begin 如果FCodec = vcUnknown然后 showMessage（'unknown compression'）; FBitmap.Height：= PICHEIGHT + SUBLINEHEIGHT; 结束 // ---------------------------------------- -------------------------------------- 程序TForm1.Timer1Timer （发件人：TObject）; begin SendMessage（FCapHandle，WM_CAP_SET_CALLBACK_FRAME，0，integer（@FrameCallbackFunction））; SendMessage（FCapHandle，WM_CAP_GRAB_FRAME_NOSTOP，1，0）; // ist hintergrundlauff blind hig end; 结束。 对象Form1：TForm1 Left = 0 顶部= 0 Caption ='Form1' ClientHeight = 301 ClientWidth = 562 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name ='Tahoma'字体.Style = [] OldCreateOrder = False OnActivate = FormActivate OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 对象Panel1：TPanel 左= 48 顶部= 16 宽度= 185 高度= 145 Caption ='Panel1' TabOrder = 0 end 对象Timer1：TTimer OnTimer = Timer1Timer 左= 464 顶部= 24 结束结束 {************************************************ ************************************** } {} {YUVConverts} {} {此文件的内容受Y图书馆公共许可证版本1.0（} {许可证）的限制;您不得使用此文件，除非符合许可证。您可以通过http://delphi.pjh2.de/}获得 {许可证副本} {} {根据许可证分发的软件以按原样分发，基础，不提供} {任何形式，明示或暗示。请参阅许可证的具体语言管理} {许可证下的权利和限制。 } {} {原始代码是：YUVConverts.pas，CapDemoC.dpr的一部分。 } {原始代码的初始开发人员是Peter J. Haas（libs@pjh2.de）。创建的部分} {由彼得·哈斯先生版权所有（C）2000-2005彼得·哈斯。版权所有。 } {} {提供者：} {} {您可以在Peter J. Haas的首页找到该文件的最新版本，位于} {http://delphi.pjh2.de/} {} {*********************** ************************************** ************************* $ //历史见结束文件 {$ ALIGN ON，$ BOOLEVAL OFF，$ LONGSTRINGS ON，$ IOCHECKS ON，$ WRITEABLECONST OFF，$ OVERFLOWCHECKS OFF} {$ RANGECHECKS OFF，$ TYPEDADDRESS ON，$ MINENUMSIZE 1} 单位yuvconverts; 接口使用 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; 函数ConvertCodecToRGB（编解码器：TVideoCodec; Src，Dst：指针; AWidth，AHeight：Integer）：Boolean; 实现 函数BICompressionToVideoCodec（Value：DWord）：TVideoCodec; begin case BI_RGB，BI_BITFIELDS：Result：= vcRGB; // no RLE BI_YUY2：Result：= vcYUY2; BI_UYVY：结果：= vcUYVY; BI_BTYUV：结果：= vcBTYUV; BI_YVU9：Result：= vcYVU9; BI_YUV12：结果：= vcYUV12; BI_Y8：Result：= vcY8; BI_Y211：Result：= vcY211; else 结果：= vcUnknown; 结束结束 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 =打包记录 Y，U，V，F1：字节; 结束 PBGR32 = ^ TBGR32; TBGR32 =打包记录 B，G，R，A：字节; 结束 函数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 如果ValueB> 255然后 ValueB：= 255; 如果ValueB< 0 then ValueB：= 0; ValueG：= Trunc（fY * ValueY + fGU * ValueU + fGV * ValueV）; 如果ValueG> 255然后 ValueG：= 255; 如果ValueG ValueG：= 0; ValueR：= Trunc（fY * ValueY + fRV * ValueV）; // fRU = 0 如果ValueR> 255然后 ValueR：= 255; 如果ValueR ValueR：= 0; with TBGR32（Result）do begin B：= ValueB; G：= ValueG; R：= ValueR; A：= 0; 结束结束 类型 TDWordRec =打包记录 case 0的整数：（B0，B1，B2，B3：Byte）; 1：（W0，W1：Word）; 结束 // UYVY // YUV 4：2：2（每个像素的Y采样，每一个像素上的U和V采样每个像素的 //每行水平）。一个宏像素包含1个DWord中的2个像素。 // 16位每像素，4字节大写字母 // U0 Y0 V0 Y1 程序UYVYtoRGB（Src，Dst：指针; AWidth，AHeight：Integer）; type PUYVY = ^ TUYVY; TUYVY =打包记录 U，Y0，V，Y1：字节; 结束 var x，y：整数; w：整数; SrcPtr：PDWord; DstPtr：PDWord; SrcLineSize：Integer; DstLineSize：Integer; YUV：DWord; b：字节; begin SrcLineSize：= AWidth * 2; DstLineSize：= AWidth * 4; // Dst是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）; 结束 Dec（PByte（Dst），DstLineSize）; Inc（PByte（Src），SrcLineSize）; 结束结束 // YUY2，YUNV，V422 // YUV 4：2：2为UYVY但在DWord // macropixel中具有不同的组件顺序。 // 16位每像素，4字节大写字母 // Y0 U0 Y1 V0 程序YUY2toRGB（Src，Dst：指针; AWidth，AHeight：Integer）; var x，y：整数; w：整数; SrcPtr：PDWord; DstPtr：PDWord; SrcLineSize：Integer; DstLineSize：Integer; YUV：DWord; b：字节; begin SrcLineSize：= AWidth * 2; DstLineSize：= AWidth * 4; // Dst是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 ^; //第一像素 b：= TDWordRec（YUV）.B2; // Y0 U Y1 V - > Y0 U V 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）; 结束 Dec（PByte（Dst），DstLineSize）; Inc（PByte（Src），SrcLineSize）; 结束结束 // BTYUV，I42P // YUV 4：1：1（每个像素的Y采样，每四个像素采样的U和V //每行水平）。 3个DWords中的宏像素包含8个像素。 // 16位每像素，12字节大画面 // U0 Y0 V0 Y1 U4 Y2 V4 Y3 Y4 Y5 Y6 Y7 程序BTYUVtoRGB（Src，Dst：指针; AWidth，AHeight：Integer ）; type PBTYUVPixel = ^ TBTYUVPixel; TBTYUVPixel =打包记录 U0，Y0，V0，Y1，U4，Y2，V4，Y3，Y4，Y5，Y6，Y7：字节; 结束 var x，y：整数; w：整数; 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; 而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）; 如果x Break; TYUV（YUV）.Y：= SrcPixel.Y1; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Dec（x）; 如果x Break; TYUV（YUV）.Y：= SrcPixel.Y2; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Dec（x）; 如果x Break; TYUV（YUV）.Y：= SrcPixel.Y3; DstPtr ^：= YUVtoBGRAPixel（YUV）; 公司（DstPtr）; Dec（x）; 如果x 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）; 如果x Break; TYUV（YUV）.Y：= SrcPixel.Y5; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Dec（x）; 如果x Break; TYUV（YUV）.Y：= SrcPixel.Y6; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Dec（x）; 如果x Break; TYUV（YUV）.Y：= SrcPixel.Y7; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Inc（SrcPtr）; 结束 Inc（PByte（Dst），DstLineSize）; Inc（PByte（Src），SrcLineSize）; 结束结束 // YVU9 // 8位Y平面，后跟8位4x4子采样V和U平面。 // 9像素像素，平面格式程序YVU9toRGB（Src，Dst：Pointer; AWidth，AHeight：Integer）; var x，y，r，l：整数; w：整数; 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是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和V YUV：=（SrcUPtr ^ shl 8）或（SrcVPtr ^ shl 16）; for r：= 0 to 3 do begin YUV：=（YUV和$ 00FFFF00）或SrcYPtr ^; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Inc（SrcYPtr）; 结束 Inc（SrcUPtr）; Inc（SrcVPtr）; 结束 Dec（PByte（Dst），DstLineSize）; if l< 3然后开始 Dec（SrcUPtr，SrcUVLineSize）; Dec（SrcVPtr，SrcUVLineSize）; 结束结束结束结束 // YUV12，I420，IYUV // 8位Y平面，后跟8位2x2子采样U和V平面。 // 12像素像素，平面格式程序YUV12toRGB（Src，Dst：指针; AWidth，AHeight：Integer）; // I420，IYUV var x，y，l：Integer; w：整数; 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是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到1开始 DstPtr：= Dst; for x：= 0 to w do begin // First Pixel YUV：= SrcYPtr ^或（SrcUPtr ^ shl 8）或（SrcVPtr ^ shl 16）; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Inc（SrcYPtr）; //第二像素 YUV：=（YUV和$ 00FFFF00）或SrcYPtr ^; DstPtr ^：= YUVtoBGRAPixel（YUV）; Inc（DstPtr）; Inc（SrcYPtr）; Inc（SrcUPtr）; Inc（SrcVPtr）; 结束 Dec（PByte（Dst），DstLineSize）; 如果l = 0，则开始 Dec（SrcUPtr，SrcUVLineSize）; Dec（SrcVPtr，SrcUVLineSize）; 结束结束结束结束 // Y8，Y800 //简单的，单色Y平面的单色图像。 // 8像素像素，平面格式程序Y8toRGB（Src，Dst：指针; AWidth，AHeight：Integer）; var x，y：整数; w：整数; SrcPtr：PByte; DstPtr：PDWord; SrcLineSize：Integer; DstLineSize：Integer; 像素：DWord; begin SrcLineSize：= AWidth; DstLineSize：= AWidth * 4; // Dst是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 像素：= SrcPtr ^; TDWordRec（Pixel）.B1：= TDWordRec（Pixel）.B0; TDWordRec（Pixel）.B2：= TDWordRec（Pixel）.B0; TDWordRec（Pixel）.B3：= 0; DstPtr ^：=像素; Inc（DstPtr）; Inc（SrcPtr）; 结束 Dec（PByte（Dst），DstLineSize）; Inc（PByte（Src），SrcLineSize）; 结束结束 // Y211 //封装的YUV格式，Y对每行的每个第二个像素进行采样， //，每4个像素采样U和V。 // 8像素像素，4字节大尺寸 // Y0，U0，Y2，V0 程序Y211toRGB（Src，Dst：指针; AWidth，AHeight：Integer）; type PYUYV = ^ TYUYV; TYUYV =打包记录 Y0，U，Y2，V：字节; 结束 var x，y：整数; w：整数; SrcPtr：PDWord; DstPtr：PDWord; SrcLineSize：Integer; DstLineSize：Integer; YUV：DWord; BGR：DWord; b：字节; begin SrcLineSize：=（（AWidth + 3）div 4）* 4; DstLineSize：= AWidth * 4; // Dst是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 ^; //第一和第二像素 b：= TDWordRec（YUV）.B2; // Y0 U Y2 V - > Y0 U V Y2 TDWordRec（YUV）.B2：= TDWordRec（YUV）.B3; TDWordRec（YUV）.B3：= b; BGR：= YUVtoBGRAPixel（YUV）; DstPtr ^：= BGR; Inc（DstPtr）; DstPtr ^：= BGR; Inc（DstPtr）; //第三和第四 TDWordRec（YUV）.B0：= TDWordRec（YUV）.B3; // Y0 U V Y2 - > Y2 U V Y2 BGR：= YUVtoBGRAPixel（YUV）; DstPtr ^：= BGR; 公司（DstPtr）; DstPtr ^：= BGR; Inc（DstPtr）; Inc（SrcPtr）; 结束 Dec（PByte（Dst），DstLineSize）; Inc（PByte（Src），SrcLineSize）; 结束结束 函数ConvertCodecToRGB（编解码器：TVideoCodec; Src，Dst：指针; AWidth，AHeight：Integer）：Boolean; begin 结果：= True; case编码器 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 结果：= False; 结束结束 //历史： // 2005-02-12，Peter J. Haas // // 2002-02-22，Peter J. Haas // - 添加YVU9，YUV12（I420） // - 添加Y211（未测试） // // 2001-06-14，Peter J. Haas // - 第一个公开版本 // - YUY2，UYVY，BTYUV（Y41P），Y8 end。 一些消息结果： 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或WS_VISIBLE，0，0，PICWIDTH，PICHEIGHT，Panel1.Handle，1）; // return 2558326 MsgResult：= SendMessage（FCapHandle，WM_CAP_DRIVER_CONNECT，0，0）; //返回0 MsgResult：= SendMessage（FCapHandle，WM_CAP_SET_PREVIEWRATE，15000，0）; // return 1 MsgResult：= sendMessage（FCapHandle，WM_CAP_SET_OVERLAY，1，0）; //返回0 MsgResult：= SendMessage（FCapHandle，WM_CAP_SET_PREVIEW，1，0）; //返回0 // SendMessage（FCapHandle，WM_CAP_DLG_VIDEOFORMAT，1,0）; // -this被注释掉 FillChar（BitmapInfo，SizeOf（BitmapInfo），0）; MsgResult：= SendMessage（FCapHandle，WM_CAP_GET_VIDEOFORMAT，SizeOf（BitmapInfo），整数（@BitmapInfo））; //返回0 FCodec：= BICompressionToVideoCodec（bitmapinfo.bmiHeader.biCompression）; //返回vcRGB 如果FCodec vcUnknown然后开始 Timer1.Enabled：= true; 结束结束 程序TForm1.FormDestroy（Sender：TObject）; begin FBitmap.Free; FJpeg.Free; 结束 程序TForm1.FormActivate（发件人：TObject）; begin 如果FCodec = vcUnknown然后 showMessage（'unknown compression'）; FBitmap.Height：= PICHEIGHT + SUBLINEHEIGHT; 结束 // ---------------------------------------- -------------------------------------- 程序TForm1.Timer1Timer （发件人：TObject）; begin MsgResult：= SendMessage（FCapHandle，WM_CAP_SET_CALLBACK_FRAME，0，integer（@FrameCallbackFunction））; //返回0 MsgResult：= SendMessage（FCapHandle，WM_CAP_GRAB_FRAME_NOSTOP，1，0）; // ist hintergrundlauff blind hig // returns 0 end; 解决方案 您的程序适用于我在Win7 32bits使用D2010 。 它正在引发一个例外： code> --------------------------- 项目WebCamTest.exe引发异常类EFCreateError，消息为 '无法创建文件c：\webcam.jpg。访问被拒绝'。 --------------------------- 可以通过更改 FJpeg.SaveToFile（'c：\webcam .jpg'）; 至 FJpeg.SaveToFile（TPath.GetTempPath +'\webcam.jpg'）; 而且，它不显示整个可用图像，您必须放大面板，更新或缩小网络摄像头输出。 使用一些代码修改进行更新，使其能够按照您的评论工作... //引入RGB数组和缓冲区数组[1..PICWIDTH]的TVideoArray =数组[1..PICHEIGHT] TRGBTriple PVideoArray = ^ TVideoArray; TForm1 = class（TForm） [...] FBuf24_1：TVideoArray; [...] 函数FrameCallbackFunction（AHandle：hWnd; VIDEOHDR：TVideoHDRPtr）：bool;标准 var I：integer; begin result：= true; with form1 do begin try 如果ConvertCodecToRGB（FCodec，VideoHDR ^ .lpData，@ FBuf2，PICWIDTH，PICHEIGHT）然后开始为I ：= 1到PICHEIGHT做FBuf1 [I]：= FBuf2 [PICHEIGHT-（I-1）]; SetBitmapBits（FBitmap.Handle，PICWIDTH * PICHEIGHT * SizeOf（DWord），@ FBuf1）; end else begin //假设RGB 为I：= 1到PICHEIGHT do FBuf24_1 [I]：= PVideoArray（VideoHDR ^ .lpData）^ [ PICHEIGHT-I + 1]; SetBitmapBits（FBitmap.Handle，PICWIDTH * PICHEIGHT * SizeOf（RGBTriple），@ FBuf24_1）; 结束 [...] I need to get a regular snapshot from a webcam in Delphi. Speed is not a problem (once a second is fine). I have tried demo code from based on stuff from http://delphi.pjh2.de but I can't get it to work. It compiles and runs OK but the callback function never fires.I don't have a real webcam but am running instead a simulator. The simulator works (I can see the video using Skype) but not with the test app. I don't really know where to start looking...Can anyone be bothered to try this code? (Apologies for the voluminous post - couldn't find how or if you can attach files - a zip file is available here.)Alternatively, any webcam demo code would be appreciated, preferably with a known good EXE as well as 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;interfaceuses 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盲higend;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 endend{**************************************************************************************************}{ }{ 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;interfaceuses 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;implementationfunction 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 Y1procedure 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 V0procedure 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 U V 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 Y7procedure 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 formatprocedure 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 formatprocedure YUV12toRGB(Src, Dst: Pointer; AWidth, AHeight: Integer); // I420, IYUVvar 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 formatprocedure 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, V0procedure 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 U V 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 U V Y2 -> Y2 U V 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), Y8end.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);beginMsgResult := SendMessage(FCapHandle, WM_CAP_SET_CALLBACK_FRAME, 0, integer(@FrameCallbackFunction)); // returns 0MsgResult := SendMessage(FCapHandle, WM_CAP_GRAB_FRAME_NOSTOP, 1, 0); // ist hintergrundlauff盲hig // returns 0end; 解决方案 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 changingFJpeg.SaveToFile('c:\webcam.jpg');toFJpeg.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;[...] 这篇关于使用Delphi从网络摄像头获取快照的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！
07-04 22:19
Powered by LMLPHP ©2024 使用Delphi从网络摄像头获取快照 0.040438