Ver Mensaje Individual
  #3  
Antiguo 08-05-2016
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.197
Reputación: 20
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Si sólo te hace falta un formulario normal y corriente, lo siguiente es un ejemplo de un previsualizador en un Form sin botones ni controles. Muestra una imajen de la Webcam a una resolución de 800x600:

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    hWndC : THandle;
  public
    procedure SetResolution(Width, Height: integer);
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_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}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Width:= 400;
  Height:= 300;
  hWndC := capCreateCaptureWindowA('Mi Ventana de captura', WS_CHILD or WS_VISIBLE ,0, 0, Width, Height, 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);
    SetResolution(640, 480);
  end;
end;

procedure TForm1.SetResolution(Width, Height: integer);
var
  bi: BITMAPINFO;
begin
  if hWndC = 0 then exit;  

  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);
  end;
end;

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

end.

Saludos.

Última edición por escafandra fecha: 08-05-2016 a las 17:50:49.
Responder Con Cita