[[José Luis Garcí]]

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;      //Añadimos la unit WEBCAM y Jpeg

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
    { Private declarations }
  public
    { Public declarations }
    camera: TWebcam;  //Para la webcam
  end;

var
  FCapturas: TFCapturas;

implementation

{$R *.dfm}

USES UDM,UUsuarios;

procedure TFCapturas.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ FormCreate ]*****
//------------------------------------------------------------------------------
begin
  camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,1000, 1000);
end;

procedure TFCapturas.SpeedButton1Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ Salir ]*****
// Cierra el formulario de capturas
//------------------------------------------------------------------------------
begin
   camera.Disconnect;
   (Sender as TSpeedButton).Caption:='Apagar camara';
   Close;
end;

procedure TFCapturas.SpeedButton2Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Pasar foto ]*****
// Pasa la imagen y cierra el formulario de capturas
//------------------------------------------------------------------------------
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);
//------------------------------------------------------------------------------
//**************************************************************[ Captura ]*****
//------------------------------------------------------------------------------
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);
//------------------------------------------------------------------------------
//*******************************************************[ Iniciar cámara ]*****
//------------------------------------------------------------------------------
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);
//------------------------------------------------------------------------------
//***********************************************[ Encender/apagar cámara ]*****
//------------------------------------------------------------------------------
const //Gran parte de este código ha sido bajado de http://www.clubdelphi.com/foros/showthread.php?t=67582
  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';
{ 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.

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.