Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Manipular WebCam (https://www.clubdelphi.com/foros/showthread.php?t=92914)

jose.ignacio.ve 13-03-2018 15:37:24

Manipular WebCam
 
Hola. tengo un proyecto que necesito manipular una cámara web, trabajo delphi XE2 el proyecto es de gestion de personas. Necesito que al cargar la persona sacarle una foto y guardar la imagen asociado a la persona.. Probé con el código que esta en el foro utilizando la api de windows pero se ve negro, trate de instalar delphiTwain y no logre instalar. Alguna otra idea?

Casimiro Notevi 13-03-2018 19:49:54

Creoque tienes que aclarar las ideas.
También tienes que explicarnos mejor las cosas.
DelphiTwain es para el escaner, no para la webcam.

jose.ignacio.ve 13-03-2018 23:05:21

Necesito, que al entrar al formulario de carga de personas tenga un boton que diga sacar foto y que se coloque en un timagen o algo asi.. O sea manipular la camara, con botones de encendido y de tomar fotos. No se que mas puede explicar.

Casimiro Notevi 14-03-2018 00:44:32

Pues una simple búsqueda por webcam devuelve estos enlaces.

escafandra 14-03-2018 11:50:07

Quizás este enlace te resulte interesante: MiniWebCam

Saludos.

escafandra 14-03-2018 23:48:27

Te pongo un ejemplo que conecta la cámara, la desconecta y hace fotos.

Prepara tu formulario con:
Tres botones: Conectar, Desconectar, Hacer foto.
Un TPanel que será la ventana de previsualización.

El código sera el siguiente:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    hWndC : THandle;
    procedure SetResolution(Width, Height: integer);
  public
  end;


var
  Form1: TForm1;

const
  WM_CAP_START                    = WM_USER;
  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_GET_VIDEOFORMAT          = WM_CAP_START + 44;
  WM_CAP_SET_VIDEOFORMAT          = WM_CAP_START + 45;
  WM_CAP_SET_PREVIEW              = WM_CAP_START + 50;
  WM_CAP_SET_OVERLAY              = WM_CAP_START + 51;
  WM_CAP_SET_PREVIEWRATE          = WM_CAP_START + 52;
  WM_CAP_SET_SCALE                = WM_CAP_START + 53;


function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle, x, y, nWidth, nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'AVICAP32.DLL';

implementation

{$R *.dfm}

// Conectar
procedure TForm1.Button1Click(Sender: TObject);
begin
  hWndC := capCreateCaptureWindowA('Ventana de captura', WS_CHILD or WS_VISIBLE ,0, 0, Panel1.Width,Panel1.Height,Panel1.Handle,0);
  if hWndC <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
    SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
    SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 40, 0);
    SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
    SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
    Panel1.Width:= 640;
    Panel1.Height:= 480;
    SetResolution(Panel1.Width, Panel1.Height);
    Button2.Enabled:= true;
    Button3.Enabled:= true;
  end;
end;

// Desconectar
procedure TForm1.Button2Click(Sender: TObject);
begin
  if hWndC <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SendMessage(hWndC, WM_CLOSE, 0, 0);
    hWndC := 0;
  end;
  Button2.Enabled:= false;
  Button3.Enabled:= false;
end;

// Sacar Foto
procedure TForm1.Button3Click(Sender: TObject);
begin
  if hWndC <> 0 then begin
    SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(ExtractFilePath(Application.ExeName)+'test.bmp')));
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
  if hWndC <> 0 then begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
  end;
end;

procedure TForm1.SetResolution(Width, Height: integer);
var
  bi: BITMAPINFO;
begin
  SendMessage(hWndC, WM_CAP_GET_VIDEOFORMAT, sizeof(bi), Cardinal(@bi));
  bi.bmiHeader.biWidth:= Width;
  bi.bmiHeader.biHeight:= Height;

  if SendMessage(hWndC, WM_CAP_SET_VIDEOFORMAT, sizeof(bi), Cardinal(@bi)) <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
    Button2.Enabled:= false;
    Button3.Enabled:= false;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled:= false;
  Button3.Enabled:= false;
end;

end.


En principio la resolución será de 640 x 480 pero puedes cambiarla. Ya puedes encuadrar tu foto y disparar cuando te plazca.

Saludos.


La franja horaria es GMT +2. Ahora son las 04:06:27.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi