文档名称:老陈---Usb摄像头专题讲座(一)
文档类别:Delphi编程文章
文档作者:陈经韬
发布日期:2006-12-08
文档备注:藏鲸阁
查看次数:

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

 



--------------------------------------------------------------------------------
  相关新闻
  老陈---谈Delphi中SSL协议的应用(二)2007-11-27 19:27:58
  老陈---谈Delphi中SSL协议的应用(一)2007-11-11 17:01:48
  老陈---为什么黑洞远程控制的屏幕传输比Radmin快2007-04-29 16:42:12
  Anskya[小零]---Hello world for FASM2006-12-10 17:54:37
  老陈---Usb摄像头专题讲座(二)2006-12-09 09:44:51
  余李虎---CRACKME的分析(附注册机算法原码)2006-12-07 12:27:00
  谈用Delphi设计Email程序(二)2005-05-31 00:58:55
  谈用Delphi设计Email程序(一)2005-05-31 00:57:57
  用Delphi创建服务程序2005-05-31 00:56:47
  深入浅出3389(一)---开启终端服务2005-05-31 00:54:14
分类:Delphi编程文章 日期:2006-12-08 查看: