如何从Delphi7使用VFrames（TVideoImage）从网络摄像头获取快照(How to get a snapsho ...

原作者: [db:作者] 来自: [db:来源] 收藏邀请

I'm using Delphi7 and VFrames (TVideoImage) with this Procedure

uses  VFrames;
....
procedure TForm1.snapshot;
var
cam:TVideoImage;
strlst:TStringList;
BMP:TBitmap;
begin
strlst := TStringList.Create ; 
cam :=TVideoImage.Create;
cam.GetListOfDevices(strlst);
cam.VideoStart(strlst.Strings[0]); //specify a cam by number
//get snapshot
BMP := TBitmap.Create;
cam.GetBitmap(BMP);
BMP.SaveToFile('test.bmp');
cam.VideoStop;
BMP.Free;
end;

Result blank Bitmap file.

解决方案

I made a small wrapper class for VFrames/VSample:

unit u_class_webcam;

interface

uses
  Jpeg,
  Forms,
  VSample,
  VFrames,
  Classes,
  Graphics,
  SysUtils;


type
  TWebcam = class
  private
    Video       : TVideoImage;
    Devices     : TStringList;
    Resolutions : TStringList;
    function GetDeviceReady: Boolean;
    function GetHeight: Integer;
    function GetWidth: Integer;
    function GetActiveDevice: String;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetDisplayCanvas(const Canvas : TCanvas);
    procedure TakeSnapshot(const Filename : String);
    function TakeSnapshotToBmp : TBitmap;
    procedure Start;
    procedure Stop;
    property DeviceReady : Boolean read GetDeviceReady;
    property Width : Integer read GetWidth;
    property Height : Integer read GetHeight;
    property ActiveDevice : String read GetActiveDevice;
  end;

// webcam singleton
var
  Webcam : TWebcam;

implementation

{ TWebcam }
function TWebcam.GetActiveDevice: String;
begin
 Result := '';
 if Devices.Count > 0 then
  Result := Devices[0];
end;

function TWebcam.GetHeight: Integer;
begin
 Result := Video.VideoHeight;
end;

function TWebcam.GetWidth: Integer;
begin
 Result := Video.VideoWidth;
end;

function TWebcam.GetDeviceReady: Boolean;
begin
 Video.GetListOfDevices(Devices);
 Result := Devices.Count > 0;
end;

procedure TWebcam.SetDisplayCanvas(const Canvas : TCanvas);
begin
 Video.SetDisplayCanvas(Canvas);
end;

function TWebcam.TakeSnapshotToBmp : TBitmap;
begin
 Result := TBitmap.Create;
 Bitmap.PixelFormat := pf24bit;
 Video.GetBitmap(Result);
end;

procedure TWebcam.TakeSnapshot(const Filename: String);

var
  Bitmap : TBitmap;
  Jpeg   : TJpegImage;

begin
 Bitmap := TBitmap.Create;
 JPeg := TJpegImage.Create;
 try
  Bitmap.PixelFormat := pf24bit;
  Video.GetBitmap(Bitmap);
  JPeg.Assign(Bitmap);
  JPeg.SaveToFile(Filename);
 finally
  Bitmap.Free;
  JPeg.Free;
 end;
end;

procedure TWebcam.Start;
begin
 if DeviceReady then
  begin
   Video.VideoStart(Devices[0]);
   Video.GetListOfSupportedVideoSizes(Resolutions);
   Video.SetResolutionByIndex(Resolutions.Count-1);
  end;
end;

procedure TWebcam.Stop;
begin
 if Video.VideoRunning then
  Video.VideoStop;
end;

constructor TWebcam.Create;
begin
 Devices := TStringList.Create;
 Resolutions := TStringList.Create;
 Video := TVideoImage.Create;
end;

destructor TWebcam.Destroy;
begin
 Stop;
 Devices.Free;
 Resolutions.Free;
 Application.ProcessMessages;
 Video.Free;
end;

end.

usage:

procedure TForm1.TestIt;

var Bmp : TBitmap;

begin
 WebCam := TWebCam.Create;
 try
  WebCam.Start;
  WebCam.SetDisplayCanvas(Self.Canvas); 
  Bmp := WebCam.TakeSnapShotToBmp;
  // do something with BMP
  Bmp.Free;
  WebCam.Stop;
 finally
  WebCam.Free;
 end;
end;

机译

我使用Delphi7和VFrames（TVideoImage）与此过程

 使用VFrames; 
 .... 
 procedure TForm1.snapshot; 
 var 
 cam：TVideoImage; 
 strlst：TStringList; 
 BMP：TBitmap; 
 begin 
 strlst：= TStringList.Create; 
 cam：= TVideoImage.Create; 
 cam.GetListOfDevices（strlst）; 
 cam.VideoStart（strlst.Strings [0]）; //指定一个凸轮号码
 //获取快照
 BMP：= TBitmap.Create; 
 cam.GetBitmap（BMP）; 
 BMP.SaveToFile（'test.bmp'）; 
 cam.VideoStop; 
 BMP.Free; 
结束

结果空白位图文件。

解决方案

我为 VFrames / VSample 制作了一个小包装类：

  unit u_class_webcam; 

接口

使用
 Jpeg，
表单，
 VSample，
 VFrames，
类，
图形，
 SysUtils; 


 type 
 TWebcam = class 
 private 
视频：TVideoImage; 
设备：TStringList; 
决议：TStringList; 
函数GetDeviceReady：Boolean; 
函数GetHeight：Integer; 
函数GetWidth：Integer; 
函数GetActiveDevice：String; 
 public 
构造函数创建; 
析构函数覆盖
程序SetDisplayCanvas（const Canvas：TCanvas）; 
程序TakeSnapshot（const Filename：String）; 
函数TakeSnapshotToBmp：TBitmap; 
程序开始; 
程序停止; 
属性DeviceReady：Boolean读取GetDeviceReady; 
属性宽度：整数读取GetWidth; 
属性高度：整数读取GetHeight; 
属性ActiveDevice：String读取GetActiveDevice; 
结束

 // webcam singleton 
 var 
网络摄像头：TWebcam; 

实现

 {TWebcam} 
函数TWebcam.GetActiveDevice：String; 
 begin 
结果：=''; 
如果Devices.Count> 0然后
结果：= Devices [0]; 
结束

函数TWebcam.GetHeight：Integer; 
 begin 
结果：= Video.VideoHeight; 
结束

函数TWebcam.GetWidth：Integer; 
 begin 
结果：= Video.VideoWidth; 
结束

函数TWebcam.GetDeviceReady：Boolean; 
 begin 
 Video.GetListOfDevices（Devices）; 
结果：= Devices.Count> 0; 
结束

程序TWebcam.SetDisplayCanvas（const Canvas：TCanvas）; 
 begin 
 Video.SetDisplayCanvas（Canvas）; 
结束

函数TWebcam.TakeSnapshotToBmp：TBitmap; 
 begin 
结果：= TBitmap.Create; 
 Bitmap.PixelFormat：= pf24bit; 
 Video.GetBitmap（Result）; 
结束

 procedure TWebcam.TakeSnapshot（const Filename：String）; 

 var 
位图：TBitmap; 
 Jpeg：TJpegImage; 

 begin 
 Bitmap：= TBitmap.Create; 
 JPeg：= TJpegImage.Create; 
 try 
 Bitmap.PixelFormat：= pf24bit; 
 Video.GetBitmap（Bitmap）; 
 JPeg.Assign（Bitmap）; 
 JPeg.SaveToFile（Filename）; 
 finally 
 Bitmap.Free; 
 JPeg.Free; 
结束
结束

程序TWebcam.Start; 
开始
如果DeviceReady然后
开始
 Video.VideoStart（Devices [0]）; 
 Video.GetListOfSupportedVideoSizes（Resolutions） 
 Video.SetResolutionByIndex（Resolutions.Count-1）; 
结束
结束

程序TWebcam.Stop; 
开始
如果Video.VideoRunning然后
 Video.VideoStop; 
结束

构造函数TWebcam.Create; 
 begin 
设备：= TStringList.Create; 
决议：= TStringList.Create; 
视频：= TVideoImage.Create; 
结束

析构函数TWebcam.Destroy; 
开始
停止; 
 Devices.Free; 
决议。 
 Application.ProcessMessages; 
 Video.Free; 
结束

结束。

用法：

 code> procedure TForm1.TestIt; 

 var Bmp：TBitmap; 

 begin 
 WebCam：= TWebCam.Create; 
 try 
 WebCam.Start; 
 WebCam.SetDisplayCanvas（Self.Canvas）; 
 Bmp：= WebCam.TakeSnapShotToBmp; 
 //做一些BMP 
 Bmp.Free; 
 WebCam.Stop; 
 finally 
 WebCam.Free; 
结束
结束