老陈---Usb摄像头专题讲座

技术2022-05-11 107

文档作者：陈经韬

本文主要讲述视频数据获取、保存为mpeg、调用Mpeg4压缩算法、自己用Delphi写编解码器和如何防范Usb偷窥。

一：获取摄像头数据

获取数据可以使用Directx或Vfw接口。一般来说，Directx比较占用cpu，而且com接口是比较麻烦的，所以一般使用vfw。不过，如果想直接捕获视频和声音保存为wmv文件，那么就要使用Directx。我们这里先讲vfw的。

1：Vcl法:到网上搜索VideoCap控件，拖放到窗口即可。2：API法：网上已经有很多相关介绍了，这里还是重复一下：下面给出一个简单的例子，主要完成数据捕获和压缩。同时为了趣味性，还加上字幕功能。添加单元vfw.pas，同时本例子还用到jpeg压缩，所以还要添加jpeg单元。完整代码如下（注意：代码没有做过多容错处理，请自行完善）：

unit Unit1;

interface

uses Windows, Messages, SysUtils, {} vfw, Jpeg, {} Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;

type TFrmMain = class(TForm) Button1: TButton; Panel1: TPanel; Image1: TImage; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } CaptureHandle: THandle; BmpInfo: TBitmapInfo; procedure CompareFrame(lpVHdr: PVIDEOHDR); public { Public declarations } end;

var FrmMain: TFrmMain;

implementation

{$R *.dfm}

procedure TFrmMain.FormCreate(Sender: TObject);begin CaptureHandle := 0;end;

procedure GetUsbCamerBmpSize(var BmpInfoHeader: TBitmapinfoheader);var PBmpInfoHeader: PBitmapInfo; dwSize: DWORD;begin dwSize := capGetVideoFormatSize(FrmMain.CaptureHandle); PBmpInfoHeader := GlobalAllocPtr(GHND, dwSize); capGetVideoFormat(FrmMain.CaptureHandle, PBmpInfoHeader, dwSize); CopyMemory(@BmpInfoHeader, @PBmpInfoHeader.bmiHeader, Sizeof(TBitmapinfoheader)); GlobalFreePtr(PBmpInfoHeader);end;

procedure TFrmMain.CompareFrame(lpVHdr: PVIDEOHDR);var BmpFileHeader: TBitmapFileHeader; BmpInfoHeader: TBitmapInfoHeader; MyMemoryStream: TMemoryStream; MyBmp: TBitmap; MyJpg: TJPEGImage;begin{注意:实际上,lpVHdr里面已经包含有图像的裸数据了.可以直接Draw显示出来了.这里因为需要添加字幕,同时转化为Jpeg格式.所以我们为裸数据加上Bmp文件头和结构.} FillChar(BmpFileHeader, Sizeof(TBitmapfileheader), 0); FillChar(BmpInfoHeader, Sizeof(TBitmapinfoheader), 0);

BmpFileHeader.bfType := $4D42; //文件类型,必须为BM. BmpFileHeader.bfSize := BmpInfo.bmiHeader.biSizeImage; //BMP数据的大小字节 BmpFileHeader.bfReserved1 := 0; //保留,必需为0 BmpFileHeader.bfReserved2 := 0; //保留,必需为0 BmpFileHeader.bfOffBits := Sizeof(TBitmapFileHeader) + Sizeof(TBitmapInfoHeader); //Specifies the offset, in bytes, from the BITMAPFILEHEADER structure to the bitmap bits.

GetUsbCamerBmpSize(BmpInfoHeader);

Panel1.Left := 0; Panel1.Top := 0; Panel1.ClientWidth := BmpInfoHeader.biWidth; Panel1.ClientHeight := BmpInfoHeader.biHeight;

MyBmp := TBitmap.Create; MyJpg := TJPEGImage.Create; MyMemoryStream := TMemoryStream.Create;

MyMemoryStream.Write(BmpFileHeader, sizeof(BmpFileHeader)); MyMemoryStream.Write(BmpInfoHeader, sizeof(BmpInfoHeader)); MyMemoryStream.Write(lpVHdr^.lpData^, BmpInfo.bmiHeader.biSizeImage); MyMemoryStream.Position := 0;

MyBmp.LoadFromStream(MyMemoryStream);

with MyBmp.Canvas do begin Brush.style := bsClear; //先这样设置 Font.Color := clRed; // 文字前景色 Font.Size := 20; //TxtFont.Size;//10;//Self.Font.Size;//Font.Name := Self.Font.Name; TextOut(0, 0, DateTimeToStr(Now)); //else//if RadioButton3.Checked then TextOut(0,0,Edit1.Text); end;

Image1.Picture.Bitmap.Assign(MyBmp); MyJpg.Assign(MyBmp); MyJpg.CompressionQuality := 65; MyMemoryStream.Clear; MyJpg.SaveToStream(MyMemoryStream); MyMemoryStream.Position := 0;//SendVideoBufToClient(MyMemoryStream);//发送数据出去 MyMemoryStream.Free; MyBmp.Free; MyJpg.Free;end;

function FrameCallBack(hWnd: HWND; lpVHdr: PVIDEOHDR): DWORD; stdcall;begin FrmMain.CompareFrame(lpVHdr); Result := DWORD(True);end;

procedure TFrmMain.Button1Click(Sender: TObject);var CapParms: TCAPTUREPARMS;begin //定义视频输入格式 FillChar(BmpInfo.bmiHeader, SizeOf(TBitmapInfoHeader), 0); with BmpInfo.bmiHeader do begin biBitCount := 24; biClrImportant := 0; biClrUsed := 0; biCompression := BI_RGB; biHeight := 240; biPlanes := 1; biSize := SizeOf(TBitmapInfoHeader); biSizeImage := 0; biWidth := 320; biXPelsPerMeter := 0; biYPelsPerMeter := 0; end;

CaptureHandle := capCreateCaptureWindow('Capture Window', WS_VISIBLE or WS_CHILD, 0, 0, 320, 240, Handle, 0); //创建一个AVICap捕获窗口 if CaptureHandle = 0 then begin ShowMessage('创建窗口失败!'); Exit; end; if not capDriverConnect(CaptureHandle, 0) then //连接摄像头.0代表第一个摄像头 begin ShowMessage('打开摄像头失败!'); Exit; end; capSetVideoFormat(CaptureHandle, @BmpInfo, SizeOf(BmpInfo)); //设置视频格式 capPreviewRate(CaptureHandle, 15); //设置预览视频的频率 capSetCallbackOnVideoStream(CaptureHandle, @FrameCallBack); //设置回调函数.流格式. //capSetCallbackOnFrame(CaptureHandle, @FrameCallBack);//帧格式 capCaptureGetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //获取当前设置 CapParms.fYield := TRUE; CapParms.fAbortLeftMouse := FALSE; CapParms.fAbortRightMouse := FALSE; capCaptureSetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //改变需要改变的参数 capCaptureSequenceNoFile(CaptureHandle); //不保存文件end;

procedure TFrmMain.Button2Click(Sender: TObject);begin if CaptureHandle <> 0 then begin CapCaptureStop(CaptureHandle); //停止捕获//capSetCallbackOnFrame(CaptureHandle,nil); capDriverDisconnect(CaptureHandle); //断开连接 end;end;

end.

二：发送和保存

现在我们简单修改一下第一章节的程序,让它可以发送捕获的数据,接收端可以保存为mpeg文件.为了方便,网络部分我们直接使用Delphi自带的Indy.数据保存部分,可以使用Directx接口.我们这里使用了一个mpeg的代码.购买该代码可以打开http://www.msbsoftware.it/mpegpas/.我们来看修改后的发送端代码.

unit Unit_Send;

interface

uses Windows, Messages, SysUtils, {} vfw, Jpeg, {} Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;

type TFrmMain = class(TForm) btnStart: TButton; Panel1: TPanel; Image1: TImage; btnStop: TButton; Label1: TLabel; Edit1: TEdit; IdTCPClient1: TIdTCPClient; IdAntiFreeze1: TIdAntiFreeze; procedure btnStartClick(Sender: TObject); procedure btnStopClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } CaptureHandle: THandle; BmpInfo: TBitmapInfo; procedure CompareFrame(lpVHdr: PVIDEOHDR); public { Public declarations } end;

var FrmMain: TFrmMain;

implementation

{$R *.dfm}

procedure TFrmMain.FormCreate(Sender: TObject);begin CaptureHandle := 0; btnStart.Enabled := True; btnStop.Enabled := False;end;

function ChangeBmp(var MyBmp: TBitmap): Boolean; {动态改变BMP图像大小}var TempBitmap: TBitmap;begin TempBitmap := TBitmap.Create; TempBitmap.Assign(MyBmp); MyBmp.Width := 160; //176 MyBmp.Height := 120; //144 MyBmp.PixelFormat := pf15bit; SetStretchBltMode(MyBmp.Canvas.Handle, COLORONCOLOR); stretchblt(MyBmp.Canvas.Handle, 0, 0, MyBmp.Width, MyBmp.Height, TempBitmap.Canvas.Handle, 0, 0, TempBitmap.Width, TempBitmap.Height, srccopy); TempBitmap.Free; Result := True;end;

GetUsbCamerBmpSize(BmpInfoHeader);

Panel1.Left := 0; Panel1.Top := 0; Panel1.ClientWidth := BmpInfoHeader.biWidth; Panel1.ClientHeight := BmpInfoHeader.biHeight;

MyBmp := TBitmap.Create; MyJpg := TJPEGImage.Create; MyMemoryStream := TMemoryStream.Create;

MyBmp.LoadFromStream(MyMemoryStream);

ChangeBmp(MyBmp); //因为接收方的mpeg固定为此大小.所以必须改变它.当然,也可以先发送大小过去动态设置,则可省略此步. Image1.Picture.Bitmap.Assign(MyBmp); MyJpg.Assign(MyBmp); MyJpg.CompressionQuality := 65; MyMemoryStream.Clear; MyJpg.SaveToStream(MyMemoryStream); MyMemoryStream.Position := 0;

//发送数据出去 try IdTCPClient1.WriteInteger(MyMemoryStream.Size); IdTCPClient1.WriteStream(MyMemoryStream); except btnStop.Click; MyMemoryStream.Free; MyBmp.Free; MyJpg.Free; ShowMessage('发送失败'); Exit; end;

MyMemoryStream.Free; MyBmp.Free; MyJpg.Free;end;

function FrameCallBack(hWnd: HWND; lpVHdr: PVIDEOHDR): DWORD; stdcall;begin FrmMain.CompareFrame(lpVHdr); Result := DWORD(True);end;

procedure TFrmMain.btnStartClick(Sender: TObject);var CapParms: TCAPTUREPARMS;begin (Sender as TButton).Enabled := False; IdTCPClient1.Host := Trim(Edit1.Text); IdTCPClient1.Port := 2000;

try IdTCPClient1.Connect(1000 * 10); except ShowMessage('连接失败!'); (Sender as TButton).Enabled := True; Exit; end;

//定义视频输入格式 FillChar(BmpInfo.bmiHeader, SizeOf(TBitmapInfoHeader), 0); with BmpInfo.bmiHeader do begin biBitCount := 24; biClrImportant := 0; biClrUsed := 0; biCompression := BI_RGB; biHeight := 240; biPlanes := 1; biSize := SizeOf(TBitmapInfoHeader); biSizeImage := 0; biWidth := 320; biXPelsPerMeter := 0; biYPelsPerMeter := 0; end;

CaptureHandle := capCreateCaptureWindow('Capture Window', WS_VISIBLE or WS_CHILD, 0, 0, 320, 240, Handle, 0); //创建一个AVICap捕获窗口 if CaptureHandle = 0 then begin ShowMessage('创建窗口失败!'); (Sender as TButton).Enabled := True; Exit; end; if not capDriverConnect(CaptureHandle, 0) then //连接摄像头.0代表第一个摄像头 begin ShowMessage('打开摄像头失败!'); (Sender as TButton).Enabled := True; Exit; end; capSetVideoFormat(CaptureHandle, @BmpInfo, SizeOf(BmpInfo)); //设置视频格式 capPreviewRate(CaptureHandle, 15); //设置预览视频的频率 capSetCallbackOnVideoStream(CaptureHandle, @FrameCallBack); //设置回调函数.流格式. //capSetCallbackOnFrame(CaptureHandle, @FrameCallBack);//帧格式 capCaptureGetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //获取当前设置 CapParms.fYield := TRUE; CapParms.fAbortLeftMouse := FALSE; CapParms.fAbortRightMouse := FALSE; capCaptureSetSetup(CaptureHandle, @CapParms, sizeof(TCAPTUREPARMS)); //改变需要改变的参数 capCaptureSequenceNoFile(CaptureHandle); //不保存文件 btnStop.Enabled := True;end;

procedure TFrmMain.btnStopClick(Sender: TObject);begin (Sender as TButton).Enabled := False; if CaptureHandle <> 0 then begin CapCaptureStop(CaptureHandle); //停止捕获//capSetCallbackOnFrame(CaptureHandle,nil); capDriverDisconnect(CaptureHandle); //断开连接 end; if IdTCPClient1.Connected then IdTCPClient1.Disconnect;end;

end.

接收端代码:

unit Unit_Recv;

interface

uses Windows, Messages, SysUtils, {} mpeg, jpeg, {} Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault, IdAntiFreezeBase, IdAntiFreeze, ExtCtrls, StdCtrls;

type TFrmMain = class(TForm) IdTCPServer1: TIdTCPServer; btnStart: TButton; CheckBox1: TCheckBox; Panel3: TPanel; Image1: TImage; IdAntiFreeze1: TIdAntiFreeze; IdThreadMgrDefault1: TIdThreadMgrDefault; btnStop: TButton; procedure btnStartClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnStopClick(Sender: TObject); procedure IdTCPServer1Execute(AThread: TIdPeerThread); private { Private declarations } MyMpeg: TMpeg; fs: TFileStream; public { Public declarations } end;

var FrmMain: TFrmMain;

implementation

{$R *.dfm}

procedure TFrmMain.FormCreate(Sender: TObject);begin CheckBox1.Checked := True; btnStart.Enabled := True; btnStop.Enabled := False; MyMpeg := nil; fs := nil;end;

procedure TFrmMain.btnStartClick(Sender: TObject);var m_FileName: string;begin (Sender as TButton).Enabled := False; try IdTCPServer1.DefaultPort := 2000; IdTCPServer1.Active := True; except ShowMessage('打开监听端口失败!'); (Sender as TButton).Enabled := True; Exit; end; CheckBox1.Enabled := False; if CheckBox1.Checked then begin m_FileName := ExtractFilePath(Application.ExeName) + 'Demo.mpeg'; MyMpeg := TMpeg.Create; fs := TFileStream.Create(m_FileName, fmCreate or fmOpenReadWrite or fmShareDenyNone); MyMpeg.Open(160, 120, 4, 2000, bf24hz, fs); end; btnStop.Enabled := True;end;

procedure TFrmMain.btnStopClick(Sender: TObject);begin (Sender as TButton).Enabled := False; if MyMpeg <> nil then MyMpeg.Free; if fs <> nil then fs.Free;end;

procedure TFrmMain.IdTCPServer1Execute(AThread: TIdPeerThread);var iSize: integer; MyStream: TMemoryStream; MyBmp: TBitmap; MyJpg: TJPEGImage;begin try iSize := AThread.Connection.ReadInteger; except Exit; end; MyStream := TMemoryStream.Create; try AThread.Connection.ReadStream(MyStream, iSize); except MyStream.Free; Exit; end; MyStream.Position := 0; MyBmp := TBitmap.Create; MyJpg := TJPEGImage.Create; MyJpg.LoadFromStream(MyStream); MyBmp.Assign(MyJpg); if CheckBox1.Checked then begin MyMpeg.AddIImage(MyBmp); MyMpeg.Keep(2); end; Image1.Picture.Bitmap.Assign(MyBmp); MyStream.Free; MyJpg.Free; MyBmp.Free;end;

end.

完整代码点这里下载.

专利

最新回复(0)