7 replies to this topic

[escafandra]

A mi hijo le ha dado por grabar video capturando la pantalla del PC y me preguntó si se podía colocar su imagen, capturada por una webcam, en un lugar de la pantalla mientras grababa. Por supuesto le dije que era posible y me puse a escribir el programita que os presento.

Se trata de una pequeña aplicación que coloca en pantalla nuestra imagen, bien en un recuadro rectangular o redondo, a elegir en un PopUpMenu, asi como una variedad de tamaños. La imagen se puede recolocar por toda la pantalla.

Se basa en el manejo que proporciona la API de Windows para estos menesteres que básicamente se usa con mensajes a una ventana especial creada con la API capCreateCaptureWindow. Para que el formulario principal pueda capturar mensajes a esa ventana, he hecho un subclassing, con esto reenvío los mensajes al formulario y podemos activar el PopUpMenu  y conseguir el movimiento de la misma arrastrándola con el ratón.

El código es como sigue:

delphi

var
OldWindowProc: Pointer;
 
function NewWindowProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
  hParent: THANDLE;
begin
  hParent:= GetParent(hWnd);
  if (Msg = WM_LBUTTONDOWN) or (Msg = WM_RBUTTONDOWN) then
  CallWindowProc(Pointer(GetWindowLong(hParent, GWL_WNDPROC)), hParent, Msg, WParam, LParam);
  Result:= CallWindowProc(OldWindowProc, hWnd, Msg, WParam, lParam);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Round:= false;
  Height:= 120;
  Width:= MulDiv(Height, 4, 3);
  hWndC := capCreateCaptureWindowA('Mi Ventana de captura', WS_CHILD or WS_VISIBLE ,0, 0, Width, Height, Handle, 0);
  if hWndC <> 0 then
  begin
    OldWindowProc:= Pointer(SetWindowLong(hWndC, GWL_WNDPROC, LongInt(@NewWindowProc)));
    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(320, 240);
    SetResolution(640, 480);
//    SetResolution(800, 600);
  end;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if hWndC <> 0 then
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
end;
 
procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
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);
  end;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, $F012, 0);
  end
  else if Button = mbRight then
    PopupMenu1.Popup(Left+X, Top+Y);
end;
 
procedure TForm1.Round1Click(Sender: TObject);
var
  Rgn: HRGN;
  Rect: TRect;
begin
  Round:= true;
  Rect:= ClientRect;
  Rgn:= CreateRoundRectRgn(Rect.left, Rect.top, Rect.bottom, Rect.bottom, Rect.bottom, Rect.bottom);
  SetWindowRgn(Handle, Rgn, true);
end;
 
procedure TForm1.Rectangle1Click(Sender: TObject);
var
  Rgn: HRGN;
  Rect: TRect;
begin
  Round:= false;
  Rect:= ClientRect;
  Rgn:= CreateRectRgn(Rect.left, Rect.top, Rect.Right, Rect.Bottom);
  SetWindowRgn(Handle, Rgn, true);
end;
 
procedure TForm1.SizeClick(Sender: TObject);
var
  Item: TMenuItem;
begin
  Item:= TMenuItem(Sender);
  Height:= StrToInt(StringReplace(Item.Caption, '&', '', [rfReplaceAll]));
  Width:= MulDiv(Height, 4, 3);
  if Round then Round1Click(self)
  else Rectangle1Click(self);
  SetWindowPos(hWndC, 0, 0, 0, Width, Height, SWP_SHOWWINDOW or SWP_NOZORDER);
end;

 
Subo el proyecto completo y el binario compilado.

Espero que sea de utilidad.


Saludos.

Attached Files

•  MiniWebCam_Bin.rar   153.81KB   71 downloads
•  Mini WebCam_Source.rar   2.61KB   69 downloads

[enecumene]

[egostar]

Que interesante y sobre todo que buen padre eres

 

Saludos

[dandyuno]

solo sale la imagen en negro ¿que ocurre?

[escafandra]

solo sale la imagen en negro ¿que ocurre?

 

Probablemente tengas abierta otra aplicación que conecte con la webcam antes de abrir MiniWebCam. en ese caso prevalece la primera conexión. Cierra todas las aplicaciones que puedan estar usando la webcam. 

 

Saludos.

[escafandra]

Una forma de desconectar a lo bruto cualquier ventana de captura de la webcam puede ser usar este código antes de crear la nuestra:

delphi

function EnumWindowsProc(Handle: Thandle; lParam: LPARAM): BOOL; stdcall;
var
  Buffer: ShortString;
begin
  Result:= true;
  GetClassName(Handle, @Buffer[0], 255);
  if lstrcmpiA(@Buffer[0], 'ClsCapWin') = 0 then
    PostMessage(Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0)
  else
    EnumChildWindows(Handle, @EnumWindowsProc, 0);
end;

Y se usaría así:

delphi

// Desconecta otra App que use la WebCam
  EnumWindows(@EnumWindowsProc, 0);

Ejemplo en el código de MiniWebCam:

delphi

procedure TForm1.FormCreate(Sender: TObject);
begin
  Round:= false;
  Height:= 120;
  Width:= MulDiv(Height, 4, 3);
  // Desconecta otra App que use la WebCam
  EnumWindows(@EnumWindowsProc, 0);
 
  hWndC := capCreateCaptureWindowA('Mi Ventana de captura', WS_CHILD or WS_VISIBLE ,0, 0, Width, Height, Handle, 0);
  if hWndC <> 0 then
  begin
    OldWindowProc:= Pointer(SetWindowLong(hWndC, GWL_WNDPROC, LongInt(@NewWindowProc)));
    SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
.......

Saludos.

[verovegah23]

Agregué lo último al código para cerrar todas las aplicaciones que tuvieran la cámara abierta y ni siquiera me ejecuta el exe al mandar llamar a esa Function, que podría ser??

[escafandra]

Agregué lo último al código para cerrar todas las aplicaciones que tuvieran la cámara abierta y ni siquiera me ejecuta el exe al mandar llamar a esa Function, que podría ser??

El código expuesto aquí busca en todas las ventanas y ventanas hijas de todas las aplicaciones tratando de localizar las de la clase "ClsCapWin". Este es el tipo de ventana para captura de webcam. Al encontrarla la desconecta. Esto puede llevar un tiempo que de la sensación de bloqueo de la app. Si haces cambios en EnumWindowsProc debes hacerlos bien para evitar un bloqueo real.

 

El método descrito es válido para casi todas las app que usen webcam pero no funcionará en navegadores que hagan uso de la misma.

 

Saludos.