PDA

Ver la Versión Completa : Foto de webcam con VFrames


Ramsay
11-03-2016, 02:48:59
Hola ,estoy tratando de realizar una foto de una webcam activa , el codigo :


procedure take_photo;

var
bit: TBitmap;
Bmp: TBitmap;
invisible_paint: TPaintBox;
DeviceList: TStringList;
video: TVideoImage;

begin

DeviceList := TStringList.Create;

invisible_paint := TPaintBox.Create(nil);
invisible_paint.Width := 400;
invisible_paint.Height := 400;
invisible_paint.Align := alClient;

video := TVideoImage.Create;
video.GetListOfDevices(DeviceList);
video.SetDisplayCanvas(invisible_paint.Canvas);
video.VideoStart(DeviceList[0]);

bit := TBitmap.Create;
bit.PixelFormat := pf24bit;
video.GetBitmap(bit);
bit.SaveToFile('test.bmp');

video.VideoStop;

bit.Free;
invisible_paint.Free;
video.Free;
DeviceList.Free;

end;


Es una funcion en una aplicacion de consola , el problema es que siempre me genera un bmp vacio con todo balnco o verde. ¿ Como soluciono este problema ?

Ramsay
11-03-2016, 17:09:04
Ya descubri cual es el problema , cuando se carga la webcam en una imagen , primero se muestra blanco y despues carga la webcam , lo mismo pasa ahora , intente usando Sleep o Application.ProcessMessages para evitar esto , pero continua igual.

Ramsay
11-03-2016, 22:19:29
Ya encontre una forma que funciona , ahora estoy usando eventos en una unit :


unit capture;

interface

uses SysUtils, Windows, Jpeg, Vcl.Graphics, VSample,
VFrames, Classes;

var
m1: TMethod;
video: TVideoImage;

function capture_webcam(): boolean;

implementation

procedure OnNewVideoFrame(ASelf:Pointer; Width, Height: integer;
DataPtr: Pointer);
begin
// start the code
end;

function capture_webcam(): boolean;
var
DeviceList: TStringList;
begin

DeviceList := TStringList.Create;

video := TVideoImage.Create;
video.GetListOfDevices(DeviceList);
video.VideoStart(DeviceList[0]);

m1.code := @OnNewVideoFrame;
m1.Data := video;

video.OnNewVideoFrame := TNewVideoFrameEvent(m1);

end;

//

end.

Todo compila bien pero cuando ejecuto la funcion me devuelve este error : access violation at 0x0018fdee: write of address 0x00000000

Solo es ese detalle , ya funciona todo , ¿ alguien sabe cual es el problema al crear el evento ? porque funciona en otros eventos pero en este no.