delphi - How to get a snapshot from a webcam with Delphi7 using VFrames(TVideoImage)

Question

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.

Answer 1

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;