Para seguir con el módulo de usuarios y hacerlo bien antes he tenido que hacer el de capturas desde la webcam
A la izquierda del todo es un panel, los 5 speedbuton que veis y un timagen a la derecha. Este es el código
Código Delphi
[-]unit UCapturas;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Webcam, Buttons, ExtCtrls, jpeg, Clipbrd;
type
TFCapturas = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton4: TSpeedButton;
procedure SpeedButton5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
private
public
camera: TWebcam; end;
var
FCapturas: TFCapturas;
implementation
{$R *.dfm}
USES UDM,UUsuarios;
procedure TFCapturas.FormCreate(Sender: TObject);
begin
camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,1000, 1000);
end;
procedure TFCapturas.SpeedButton1Click(Sender: TObject);
begin
camera.Disconnect;
(Sender as TSpeedButton).Caption:='Apagar camara';
Close;
end;
procedure TFCapturas.SpeedButton2Click(Sender: TObject);
var JPGImage: TJPEGImage;
Clip: TClipboard;
AData: THandle;
APalette: hPalette;
begin
JPGImage:= TJPEGImage.Create;
JPGImage.Assign(Image1.Picture.Bitmap);
JPGImage.SaveToClipboardFormat(CF_PICTURE, AData,APalette);
if VarSUnidad='UUSUARIOS' then FUsuarios.DBImage1.Picture.LoadFromClipboardFormat(CF_PICTURE, AData,APalette);
JPGImage.Free;
camera.Disconnect;
SpeedButton5.Caption:='Apagar camara';
Close;
end;
procedure TFCapturas.SpeedButton3Click(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;
procedure TFCapturas.SpeedButton4Click(Sender: TObject);
begin
camera.Connect;
camera.Preview(true);
Camera.PreviewRate(4);
SpeedButton4.Enabled:=False;
SpeedButton5.Enabled:=True;
SpeedButton5.Caption:='Apagar camara';
end;
procedure TFCapturas.SpeedButton5Click(Sender: TObject);
const str_Connect = 'Encender la camara';
str_Disconn = 'Apagar la camara';
begin
if (Sender as TSpeedButton).Caption = str_Connect then begin
camera.Connect;
camera.Preview(true);
Camera.PreviewRate(4);
(Sender as TSpeedButton).Caption:=str_Disconn;
end
else begin
camera.Disconnect;
(Sender as TSpeedButton).Caption:=str_Connect;
end;
END;
end.
Podéis ver que llamamos a una unit webcam este es su código
Código Delphi
[-]
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';
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.
Comentar que en el DataModule (DM) esta la variable fija VarSUnidad, a la que le hemos asignado el valor de UUSUARIOS desde el módulo de usuarios, cuando estemos en clientes haremos los mismo pero dando el nombre de clientes, así el mismo módulo sirve para varios apartados, igual pasa con el editor aunque este trabajara con ciertas diferencias.