Un simple programa que graba todos los registros de la webcam en un video con formato avi.

Tenia pensado usarlo como camara de vigilancia en el frente de mi casa pero todavia le faltan varios (mas bien muchos) retoques.

Una imagen :



El codigo.

// The WatchMan 0.4
// (C) Doddy Hackman 2013
// Credits : Based on
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-i.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-ii.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
// Thanks to Javier Par
 
unit the;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, ComCtrls, sStatusBar, sPageControl, StdCtrls,
  sGroupBox, sButton, sRadioButton, sEdit, sListView, ExtCtrls, ShellApi, acPNG,
  sLabel;
 
type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sPageControl1: TsPageControl;
    sStatusBar1: TsStatusBar;
    sTabSheet1: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sTabSheet4: TsTabSheet;
    sGroupBox2: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sGroupBox4: TsGroupBox;
    sRadioButton3: TsRadioButton;
    sEdit1: TsEdit;
    sRadioButton4: TsRadioButton;
    sGroupBox6: TsGroupBox;
    sListView1: TsListView;
    Guardar: TSaveDialog;
    Image1: TImage;
    sGroupBox3: TsGroupBox;
    Image2: TImage;
    sLabel1: TsLabel;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 
    procedure sListView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  toyaca: hwnd;
 
const
 
  control = WM_USER;
  conec = control + 10;
  uno = control + 52;
  dos = control + 50;
 
  tres = control + 20;
  cuatro = control + 62;
  chau = control + 11;
 
implementation
 
uses tiny, full;
 
FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint;
  x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: hwnd;
  nId: integer): hwnd;
STDCALL EXTERNAL 'AVICAP32.DLL';
{$R *.dfm}
  procedure TForm1.FormCreate(Sender: TObject);
  var
    dir: string;
    busqueda: TSearchRec;
  begin
 
    sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName)
      + 'Data';
    sSkinManager1.SkinName := 'matrix';
    sSkinManager1.Active := True;
 
    dir := ExtractFilePath(Application.ExeName) + '/captures';
 
    if not(DirectoryExists(dir)) then
    begin
      CreateDir(dir);
    end;
 
    ChDir(dir);
 
    FindFirst(dir + '\*.avi', faAnyFile + faReadOnly, busqueda);
 
    with sListView1.Items.Add do
    begin
      Caption := ExtractFileName(busqueda.Name);
      SubItems.Add(dir + '/' + busqueda.Name);
    end;
 
    while FindNext(busqueda) = 0 do
    begin
 
      with sListView1.Items.Add do
      begin
        Caption := ExtractFileName(busqueda.Name);
        SubItems.Add(dir + '/' + busqueda.Name);
      end;
 
    end;
    FindClose(busqueda);
 
  end;
 
  procedure TForm1.sButton1Click(Sender: TObject);
  begin
 
    sStatusBar1.Panels[0].Text := '[+] Recording';
    Form1.sStatusBar1.Update;
 
    Form2.Show;
 
    toyaca := capCreateCaptureWindowA('Unknown_888', WS_CHILD OR WS_VISIBLE,
      Form2.Image1.Left, Form2.Image1.Top, Form2.Image1.Width,
      Form2.Image1.Height, Form2.Handle, 0);
 
    SendMessage(toyaca, conec, 0, 0);
    SendMessage(toyaca, uno, 40, 0);
    SendMessage(toyaca, dos, 1, 0);
 
    SendMessage(toyaca, tres, 0, longint(PCHAR('tt')));
 
    SendMessage(toyaca, cuatro, 0, 0);
 
  end;
 
  procedure TForm1.sButton2Click(Sender: TObject);
  var
    fecha: TDateTime;
    fechafinal: string;
    nombrefecha: string;
 
  BEGIN
 
    sStatusBar1.Panels[0].Text := '[+] Stopped';
    Form1.sStatusBar1.Update;
 
    SendMessage(toyaca, chau, 0, 0);
 
    Form2.Hide;
 
    if (sRadioButton3.Checked) then
    begin
      RenameFile('t', sEdit1.Text);
    end;
 
    if (sRadioButton4.Checked) then
    begin
      fecha := now();
      fechafinal := DateTimeToStr(fecha);
      nombrefecha := fechafinal + '.avi';
 
      nombrefecha := StringReplace(nombrefecha, '/', ':', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ' ', '', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ':', '_', [rfReplaceAll,
        rfIgnoreCase]);
 
      RenameFile('t', nombrefecha);
 
    end;
 
  end;
 
  procedure TForm1.sListView1DblClick(Sender: TObject);
  begin
 
    ShellExecute(0, nil, PCHAR(sListView1.Selected.SubItems[0]), nil, nil,
      SW_SHOWNORMAL);
 
  end;
 
end.
 
// The End ?
 

Si lo quieren bajar lo pueden hacer de aca.