[Delphi] The WatchMan 0.4

[BigBear]

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.

Código (delphi) [Seleccionar] Expandir


// 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.