Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Eliminar ventana en este proyecto de Camara (https://www.clubdelphi.com/foros/showthread.php?t=86304)

FideRosado 17-07-2014 06:37:58

Eliminar ventana en este proyecto de Camara
 
Hola, recentemente ando en busca de la forma en la que pueda eliminar la ventana que sale al ejecutar la captura de video de una webcam,he visto muchos ejemplos y me he quedado con este proy, espero que entre todos podamos mejorarlo de cierta forma, kisas he metido la pata escribiendo el codigo,pues aveces me pierdo.

tambien como que se duerme el empesar a capturar el video, y no me lo muestra a la hora de hacer lick en el boton..Iniciar captura , pues antes de eso me sale la famosa ventana de escojer el driver, o seleccionar la fuente de captura, pues estaba pensando en crear un .ini con esas configuraciones y cargarcelos a la app, o poner unos listbox que me saquen los dispositivos y formatos soportados por la webcam, y asi poder escojer, sin esa molesta ventana.. pero ya por aca es hora de descansar un poco y tengo muchaas horas intentandolo..

bueno . aca les dejo el source , para que se les ocurra algo ke aarreglar jeje..yo seguire mañana..

Código Delphi [-]

// ELEMENTOS DEL FORM

    iniciarCaptura: TButton;
    detenerCaptura: TButton;
    Image1: TImage;
    Guardar: TSaveDialog;
    BtnAlmacenarVideo: TButton;
    BtnGuardarImagen: TButton;
    PararVideo: TButton;

UNIT DEL FORM

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    iniciarCaptura: TButton;
    detenerCaptura: TButton;
    Image1: TImage;
    Guardar: TSaveDialog;
    BtnAlmacenarVideo: TButton;
    BtnGuardarImagen: TButton;
    PararVideo: TButton;
    procedure iniciarCapturaClick(Sender: TObject);
    procedure detenerCapturaClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnAlmacenarVideoClick(Sender: TObject);
    procedure BtnGuardarImagenClick(Sender: TObject);
    procedure PararVideoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    camera: TWebcam;
    Ventana: hwnd; //Handle de la ventana de captura
  end;

var
  Form1: TForm1;

const

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;

implementation

uses Math;

{$R *.dfm}
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer;
 y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'avicap32.dll';


procedure TForm1.iniciarCapturaClick(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, 1);


     EXCEPT
        RAISE;
     END;
  END
  ELSE
  BEGIN

     MessageDlg('Error al conectar Webcam', mtError, [mbok], 0);
  END;


     
END;

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  IF Ventana <> 0 THEN
  BEGIN
     SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
     Ventana := 0;
  END;
end;

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;

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;

procedure TForm1.PararVideoClick(Sender: TObject);
BEGIN
IF ventana <> 0 THEN
BEGIN
SendMessage(ventana, WM_CAP_STOP, 0, 0);
END;
END;

end.

ACA LES PONGO LA UNIT WebCam.PASS

Código Delphi [-]
unit Webcam;
interface

uses
  Windows, Messages;

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;

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
      procedure Connect;
      procedure Disconnect;
      procedure GrabFrame;
      procedure SaveDIB(const FileName: String = 'webcam.bmp');
      procedure Preview(IsOn: 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( IsOn: Boolean);
begin
  if CaptureWnd <> 0 then
    if IsOn 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.

FideRosado 17-07-2014 06:43:32

Proyecto Camara Adjunto
 
1 Archivos Adjunto(s)
aca esta adjunto..

http://clubdelphi.com/foros/attachme...1&d=1405572173

FideRosado 17-07-2014 17:00:34

pregunto
 
agregue esta funcin al proy pero aun no se como asignar el valor para que no se cargue la ventana de seleccion del driver

Código Delphi [-]
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
  Name, Ver: array[0..1024] of Char;
begin
  for i:= 0 to 9 do begin
    if capGetDriverDescription(i,@Name,Sizeof(Name)-1,@Ver,Sizeof(Ver)-1) then begin
     // Listbox1.Items.AddObject();
      ComboBox1.Items.AddObject(Name,TObject(i));
      ComboBox1.ItemIndex:=i;
    end ;
  end;

end;

hay alguien que me diga como hacerlo pr fvor


La franja horaria es GMT +2. Ahora son las 04:26:22.

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