FideRosado
17-07-2014, 06:37:58
Hola, recentemente ando en busca de la forma en la que pueda eliminar la ventana que sale al ejecutar la captura de video de una webcam,he visto muchos ejemplos y me he quedado con este proy, espero que entre todos podamos mejorarlo de cierta forma, kisas he metido la pata escribiendo el codigo,pues aveces me pierdo.
tambien como que se duerme el empesar a capturar el video, y no me lo muestra a la hora de hacer lick en el boton..Iniciar captura , pues antes de eso me sale la famosa ventana de escojer el driver, o seleccionar la fuente de captura, pues estaba pensando en crear un .ini con esas configuraciones y cargarcelos a la app, o poner unos listbox que me saquen los dispositivos y formatos soportados por la webcam, y asi poder escojer, sin esa molesta ventana.. pero ya por aca es hora de descansar un poco y tengo muchaas horas intentandolo..
bueno . aca les dejo el source , para que se les ocurra algo ke aarreglar jeje..yo seguire mañana..
// ELEMENTOS DEL FORM
iniciarCaptura: TButton;
detenerCaptura: TButton;
Image1: TImage;
Guardar: TSaveDialog;
BtnAlmacenarVideo: TButton;
BtnGuardarImagen: TButton;
PararVideo: TButton;
UNIT DEL FORM
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,WebCam, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
iniciarCaptura: TButton;
detenerCaptura: TButton;
Image1: TImage;
Guardar: TSaveDialog;
BtnAlmacenarVideo: TButton;
BtnGuardarImagen: TButton;
PararVideo: TButton;
procedure iniciarCapturaClick(Sender: TObject);
procedure detenerCapturaClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BtnAlmacenarVideoClick(Sender: TObject);
procedure BtnGuardarImagenClick(Sender: TObject);
procedure PararVideoClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
camera: TWebcam;
Ventana: hwnd; //Handle de la ventana de captura
end;
var
Form1: TForm1;
const
WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START + 68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
WM_CAP_SAVEDIB = WM_CAP_START + 25;
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
WM_CAP_SEQUENCE = WM_CAP_START + 62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
WM_CAP_EDIT_COPY = WM_CAP_START + 30;
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
implementation
uses Math;
{$R *.dfm}
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer;
y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'avicap32.dll';
procedure TForm1.iniciarCapturaClick(Sender: TObject);
BEGIN
Ventana := capCreateCaptureWindowA('Ventana de captura',
WS_CHILD OR WS_VISIBLE, image1.Left, image1.Top, image1.Width,
image1.Height, form1.Handle, 0);
IF Ventana <> 0 THEN
BEGIN
TRY
SendMessage(Ventana, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(Ventana, WM_CAP_SET_PREVIEWRATE, 40, 0);
SendMessage(Ventana, WM_CAP_SET_PREVIEW, 1, 1);
EXCEPT
RAISE;
END;
END
ELSE
BEGIN
MessageDlg('Error al conectar Webcam', mtError, [mbok], 0);
END;
END;
procedure TForm1.detenerCapturaClick(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
Ventana := 0;
END;
END;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IF Ventana <> 0 THEN
BEGIN
SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
Ventana := 0;
END;
end;
procedure TForm1.BtnAlmacenarVideoClick(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
Guardar.Filter := 'Fichero AVI (*.avi)*.avi';
Guardar.DefaultExt := 'avi';
Guardar.FileName := 'FicheroAvi';
IF Guardar.Execute THEN
BEGIN
SendMessage(Ventana, WM_CAP_FILE_SET_CAPTURE_FILEA, 0,
Longint(pchar(Guardar.Filename)));
SendMessage(Ventana, WM_CAP_SEQUENCE, 0, 0);
END;
END;
END;
procedure TForm1.BtnGuardarImagenClick(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
Guardar.FileName := 'Captura de la imagen';
Guardar.DefaultExt := 'bmp';
Guardar.Filter := 'Fichero Bitmap (*.bmp)*.bmp';
IF Guardar.Execute THEN
SendMessage(Ventana, WM_CAP_SAVEDIB, 0,
longint(pchar(Guardar.FileName)));
END;
END;
procedure TForm1.PararVideoClick(Sender: TObject);
BEGIN
IF ventana <> 0 THEN
BEGIN
SendMessage(ventana, WM_CAP_STOP, 0, 0);
END;
END;
end.
ACA LES PONGO LA UNIT WebCam.PASS
unit Webcam;
interface
uses
Windows, Messages;
const
WM_Connect = WM_USER + 10;
WM_Disconnect = WM_USER + 11;
WM_GrabFrame = WM_USER + 60;
WM_SaveDIB = WM_USER + 25;
WM_Preview = WM_USER + 50;
WM_PreviewRate = WM_USER + 52;
WM_Configure = WM_USER + 41;
type
TWebcam = class
constructor Create(
const WindowName: String = '';
ParentWnd: Hwnd = 0;
Left: Integer = 0;
Top: Integer = 0;
Width: Integer = 0;
height: Integer = 0;
Style: Cardinal = WS_CHILD or WS_VISIBLE;
WebcamID: Integer = 0);
public
procedure Connect;
procedure Disconnect;
procedure GrabFrame;
procedure SaveDIB(const FileName: String = 'webcam.bmp');
procedure Preview(IsOn: Boolean = True);
procedure PreviewRate(Rate: Integer = 42);
procedure Configure;
private
CaptureWnd: HWnd;
end;
implementation
function capCreateCaptureWindowA(
WindowName: PChar;
dwStyle: Cardinal;
x,y,width,height: Integer;
ParentWin: HWnd;
WebcamID: Integer): Hwnd; stdcall external 'AVICAP32.dll';
{ TWebcam }
procedure TWebcam.Configure;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Configure, 0, 0);
end;
procedure TWebcam.Connect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Connect, 0, 0);
end;
constructor TWebcam.Create(const WindowName: String; ParentWnd: Hwnd; Left, Top,
Width, height: Integer; Style: Cardinal; WebcamID: Integer);
begin
CaptureWnd := capCreateCaptureWindowA(PChar(WindowName), Style, Left, Top, Width, Height,
ParentWnd, WebcamID);
end;
procedure TWebcam.Disconnect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Disconnect, 0, 0);
end;
procedure TWebcam.GrabFrame;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_GrabFrame, 0, 0);
end;
procedure TWebcam.Preview( IsOn: Boolean);
begin
if CaptureWnd <> 0 then
if IsOn then
SendMessage(CaptureWnd, WM_Preview, 1, 0)
else
SendMessage(CaptureWnd, WM_Preview, 0, 0);
end;
procedure TWebcam.PreviewRate(Rate: Integer);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_PreviewRate, Rate, 0);
end;
procedure TWebcam.SaveDIB(const FileName: String);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_SaveDIB, 0, Cardinal(PChar(FileName)));
end;
end.
tambien como que se duerme el empesar a capturar el video, y no me lo muestra a la hora de hacer lick en el boton..Iniciar captura , pues antes de eso me sale la famosa ventana de escojer el driver, o seleccionar la fuente de captura, pues estaba pensando en crear un .ini con esas configuraciones y cargarcelos a la app, o poner unos listbox que me saquen los dispositivos y formatos soportados por la webcam, y asi poder escojer, sin esa molesta ventana.. pero ya por aca es hora de descansar un poco y tengo muchaas horas intentandolo..
bueno . aca les dejo el source , para que se les ocurra algo ke aarreglar jeje..yo seguire mañana..
// ELEMENTOS DEL FORM
iniciarCaptura: TButton;
detenerCaptura: TButton;
Image1: TImage;
Guardar: TSaveDialog;
BtnAlmacenarVideo: TButton;
BtnGuardarImagen: TButton;
PararVideo: TButton;
UNIT DEL FORM
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,WebCam, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
iniciarCaptura: TButton;
detenerCaptura: TButton;
Image1: TImage;
Guardar: TSaveDialog;
BtnAlmacenarVideo: TButton;
BtnGuardarImagen: TButton;
PararVideo: TButton;
procedure iniciarCapturaClick(Sender: TObject);
procedure detenerCapturaClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BtnAlmacenarVideoClick(Sender: TObject);
procedure BtnGuardarImagenClick(Sender: TObject);
procedure PararVideoClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
camera: TWebcam;
Ventana: hwnd; //Handle de la ventana de captura
end;
var
Form1: TForm1;
const
WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START + 68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
WM_CAP_SAVEDIB = WM_CAP_START + 25;
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
WM_CAP_SEQUENCE = WM_CAP_START + 62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
WM_CAP_EDIT_COPY = WM_CAP_START + 30;
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
implementation
uses Math;
{$R *.dfm}
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer;
y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'avicap32.dll';
procedure TForm1.iniciarCapturaClick(Sender: TObject);
BEGIN
Ventana := capCreateCaptureWindowA('Ventana de captura',
WS_CHILD OR WS_VISIBLE, image1.Left, image1.Top, image1.Width,
image1.Height, form1.Handle, 0);
IF Ventana <> 0 THEN
BEGIN
TRY
SendMessage(Ventana, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(Ventana, WM_CAP_SET_PREVIEWRATE, 40, 0);
SendMessage(Ventana, WM_CAP_SET_PREVIEW, 1, 1);
EXCEPT
RAISE;
END;
END
ELSE
BEGIN
MessageDlg('Error al conectar Webcam', mtError, [mbok], 0);
END;
END;
procedure TForm1.detenerCapturaClick(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
Ventana := 0;
END;
END;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IF Ventana <> 0 THEN
BEGIN
SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
Ventana := 0;
END;
end;
procedure TForm1.BtnAlmacenarVideoClick(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
Guardar.Filter := 'Fichero AVI (*.avi)*.avi';
Guardar.DefaultExt := 'avi';
Guardar.FileName := 'FicheroAvi';
IF Guardar.Execute THEN
BEGIN
SendMessage(Ventana, WM_CAP_FILE_SET_CAPTURE_FILEA, 0,
Longint(pchar(Guardar.Filename)));
SendMessage(Ventana, WM_CAP_SEQUENCE, 0, 0);
END;
END;
END;
procedure TForm1.BtnGuardarImagenClick(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
Guardar.FileName := 'Captura de la imagen';
Guardar.DefaultExt := 'bmp';
Guardar.Filter := 'Fichero Bitmap (*.bmp)*.bmp';
IF Guardar.Execute THEN
SendMessage(Ventana, WM_CAP_SAVEDIB, 0,
longint(pchar(Guardar.FileName)));
END;
END;
procedure TForm1.PararVideoClick(Sender: TObject);
BEGIN
IF ventana <> 0 THEN
BEGIN
SendMessage(ventana, WM_CAP_STOP, 0, 0);
END;
END;
end.
ACA LES PONGO LA UNIT WebCam.PASS
unit Webcam;
interface
uses
Windows, Messages;
const
WM_Connect = WM_USER + 10;
WM_Disconnect = WM_USER + 11;
WM_GrabFrame = WM_USER + 60;
WM_SaveDIB = WM_USER + 25;
WM_Preview = WM_USER + 50;
WM_PreviewRate = WM_USER + 52;
WM_Configure = WM_USER + 41;
type
TWebcam = class
constructor Create(
const WindowName: String = '';
ParentWnd: Hwnd = 0;
Left: Integer = 0;
Top: Integer = 0;
Width: Integer = 0;
height: Integer = 0;
Style: Cardinal = WS_CHILD or WS_VISIBLE;
WebcamID: Integer = 0);
public
procedure Connect;
procedure Disconnect;
procedure GrabFrame;
procedure SaveDIB(const FileName: String = 'webcam.bmp');
procedure Preview(IsOn: Boolean = True);
procedure PreviewRate(Rate: Integer = 42);
procedure Configure;
private
CaptureWnd: HWnd;
end;
implementation
function capCreateCaptureWindowA(
WindowName: PChar;
dwStyle: Cardinal;
x,y,width,height: Integer;
ParentWin: HWnd;
WebcamID: Integer): Hwnd; stdcall external 'AVICAP32.dll';
{ TWebcam }
procedure TWebcam.Configure;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Configure, 0, 0);
end;
procedure TWebcam.Connect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Connect, 0, 0);
end;
constructor TWebcam.Create(const WindowName: String; ParentWnd: Hwnd; Left, Top,
Width, height: Integer; Style: Cardinal; WebcamID: Integer);
begin
CaptureWnd := capCreateCaptureWindowA(PChar(WindowName), Style, Left, Top, Width, Height,
ParentWnd, WebcamID);
end;
procedure TWebcam.Disconnect;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_Disconnect, 0, 0);
end;
procedure TWebcam.GrabFrame;
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_GrabFrame, 0, 0);
end;
procedure TWebcam.Preview( IsOn: Boolean);
begin
if CaptureWnd <> 0 then
if IsOn then
SendMessage(CaptureWnd, WM_Preview, 1, 0)
else
SendMessage(CaptureWnd, WM_Preview, 0, 0);
end;
procedure TWebcam.PreviewRate(Rate: Integer);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_PreviewRate, Rate, 0);
end;
procedure TWebcam.SaveDIB(const FileName: String);
begin
if CaptureWnd <> 0 then
SendMessage(CaptureWnd, WM_SaveDIB, 0, Cardinal(PChar(FileName)));
end;
end.