使用Delphi从网络摄像头获取快照 [英] Getting a snapshot from a webcam with Delphi
本文介绍了使用Delphi从网络摄像头获取快照的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我没有真正的网络摄像头，而是运行，而不是模拟器。模拟器工作（我可以看到使用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 < 0 then
ValueG：= 0;
ValueR：= Trunc（fY * ValueY + fRV * ValueV）; // fRU = 0
如果ValueR> 255然后
ValueR：= 255;
如果ValueR < 0然后
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 <= 0则
Break;
TYUV（YUV）.Y：= SrcPixel.Y1;
DstPtr ^：= YUVtoBGRAPixel（YUV）;
Inc（DstPtr）;
Dec（x）;
如果x <= 0则
Break;
TYUV（YUV）.Y：= SrcPixel.Y2;
DstPtr ^：= YUVtoBGRAPixel（YUV）;
Inc（DstPtr）;
Dec（x）;
如果x <= 0则
Break;
TYUV（YUV）.Y：= SrcPixel.Y3;
DstPtr ^：= YUVtoBGRAPixel（YUV）;
公司（DstPtr）;
Dec（x）;
如果x <= 0则
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 <= 0则
Break;
TYUV（YUV）.Y：= SrcPixel.Y5;
DstPtr ^：= YUVtoBGRAPixel（YUV）;
Inc（DstPtr）;
Dec（x）;
如果x <= 0则
Break;
TYUV（YUV）.Y：= SrcPixel.Y6;
DstPtr ^：= YUVtoBGRAPixel（YUV）;
Inc（DstPtr）;
Dec（x）;
如果x <= 0则
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;
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 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 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 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), 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;
解决方案
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;
[...]
这篇关于使用Delphi从网络摄像头获取快照的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
