Webcam con Delphi ( III )

Continuando con el proyecto de manejo de una webcam con Delphi os presento el procedimiento para detener la grabación de una secuencia de video:



Tenéis que crear un tButton llamado "PararVideo" y en el evento Onclick teclear lo siguiente:



PROCEDURE TForm1.PararVideoClick(Sender: TObject);

BEGIN

IF ventana <> 0 THEN

BEGIN

SendMessage(ventana, WM_CAP_STOP, 0, 0);

END;

END;







UNIT WEBCAM

============



unit Webcam;
interface
uses
Windows, Messages;
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
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;
public
procedure Connect;
procedure Disconnect;
procedure GrabFrame;
procedure SaveDIB(const FileName: String = 'webcam.bmp');
procedure Preview(&on: 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(&on: Boolean);
begin
if CaptureWnd <> 0 then
if &on 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.

 

=================

EJEMPLO DE USO

===============

 

en el evento OnCreate:

... 

  private
{ Private declarations }
public
{ Public declarations }
camera: TWebcam;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,
1000, 1000);
end;

 

 

 

ENCENDIDO Y APAGADO DE LA CAMARA:

================================= 

procedure TForm1.Button1Click(Sender: TObject);
const
str_Connect = 'Encender la camara';
str_Disconn = 'Apagar la camara';
begin
if (Sender as TButton).Caption = str_Connect then begin
camera.Connect;
camera.Preview(true);
Camera.PreviewRate(4);
(Sender as TButton).Caption:=str_Disconn;
end
else begin
camera.Disconnect;
(Sender as TButton).Caption:=str_Connect;
end;
end;




CAPTURA DE LA FOTO

==================

procedure TForm1.Button2Click(Sender: TObject);
var
PanelDC: HDC;
begin
if not Assigned(Image1.Picture.Bitmap) then
Image1.Picture.Bitmap := TBitmap.Create
else
begin
Image1.Picture.Bitmap.Free;
Image1.picture.Bitmap := TBitmap.Create;
end;
Image1.Picture.Bitmap.Height := Panel1.Height;
Image1.Picture.Bitmap.Width := Panel1.Width;
Image1.Stretch := True;
PanelDC := GetDC(Panel1.Handle);
try
BitBlt(Image1.Picture.Bitmap.Canvas.Handle,
0,0,Panel1.Width, Panel1.Height, PanelDC, 0,0, SRCCOPY);
finally
ReleaseDC(Handle, PanelDC);
end;
end;

 




Webcam con Delphi ( II )

A continuación os muestro nuevas utilidades para usar una webcam con Delphi.



ALMACENAR UNA SECUENCIA DE VIDEO

Nuevos componentes del form:



tSaveDialog,Definición de propiedades:

- Name = Guardar



tButtonDefinición de propiedades:

- Name = BtnAlmacenarVideo

- Caption = AlmacenarVideo



En el Evento Onclic del tButton poner





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;







GUARDAR UNA FOTO DE LA VENTANA DE CAPTURA

Añadir un tButton



tButtonDefinición de propiedades:

- Name = BtnGuardarImagen

- Caption = Guardar Imagen



Código del Botón





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;







Webcam con Delphi (I)


A continuación os presento el software que os permitirá manejar vuestra Webcam con Delphi.



Primeramente tenéis que instalar en vuestro sistema el software "Microsoft Video for Windows SDK " que contiene la librería Avicap32.dll.

Dentro de las funciones que contiene utilizaremos "capCreateCaptureWindowA" para inicializar el driver y capturar la imagen.

Después para manejar la ventana de captura tendremos que usar la función "SendMessage" lo que facilita y simplifica muchísimo el trabajo a los programadores.




Ahora vamos con el programa:



Como variables globales añadimos:



Ventana: hwnd; //Handle de la ventana de captura



En la sección "const" escribimos:





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;





En la sección "implementation":





FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; STDCALL EXTERNAL 'AVICAP32.DLL';





Es la llamada a la librería externa Avicap32.dll



Elementos de la interface:



-Botón "iniciar" (Al pulsarlo empezará la captura de la imagen procedente de la Webcam)



-Botón "detener" (Para parar la captura de la imagen)



-Control de Imagen "tImage" (lo llamaremos "Image1")







El código que se incluirá dentro de los botones es el siguiente:



Botón "Iniciar"

PROCEDURE TForm1.Button1Click(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, 0);
EXCEPT
RAISE;
END;
END
ELSE
BEGIN
MessageDlg('Error al conectar Webcam', mtError, [mbok], 0);
END;
END;



Botón "Detener"







PROCEDURE TForm1.Button2Click(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
Ventana := 0;
END;
END;



En el evento Onclose deberemos hacer una llamada al procedimiento incluido en el botón "Detener".

Y eso es todo por ahora, en posteriores artículos iremos añadiendo más utilidades.











Obtener parametros de los paneles solares

Programa que calcula partiendo de los siguientes datos: (se obtienen de la hoja de características del fabricante de los módulos fotovoltaic...