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

最新推荐文章于 2022-07-29 09:25:52 发布

iiprogram

最新推荐文章于 2022-07-29 09:25:52 发布

阅读量2.2k

点赞数

分类专栏： vcbcbdelphi的window编程文章标签： radiobutton image forms delphi button structure

vcbcbdelphi的window编程专栏收录该内容

551 篇文章 1 订阅

订阅专栏

文档作者：陈经韬

本文主要讲述视频数据获取、保存为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.

完整代码点这里下载.

iiprogram

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
1
评论
老陈---Usb摄像头专题讲座

文档作者：陈经韬本文主要讲述视频数据获取、保存为mpeg、调用Mpeg4压缩算法、自己用Delphi写编解码器和如何防范Usb偷窥。一：获取摄像头数据获取数据可以使用Directx或Vfw接口。一般来说，Directx比较占用cpu，而且com接口是比较麻烦的，所以一般使用vfw。不过，如果想直接捕获视频和声音保存为wmv文件，那么就要使用Directx。我们这里先讲vfw的。
复制链接

扫一扫

专栏目录