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;
Links relacionados
Webcam con Delphi ( I )
Webcam con Delphi ( II )
Ahora debemos guardar los parámetros de la red con FFNN1.SaveToFile('redneural1.txt'), de tal forma que la próxima vez que queramos simular la función y=10+x no sea necesario entrenarla ya que bastaría con cargar el patrón de red previamente guardado con FFNN1.LoadFromFile('redneural1.txt').
Pulsar "Next>>" y en la relación de librerías registradas en tu sistema seleccionar
En la ventana siguiente indicar en Palette Page el item "additional" que es donde se guardarán cada uno de los componentes de esta librería
En la ventana siguiente marca "Add unit to ...."
y pulsa el botón "Finish" 