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.
Si lo quieren bajar lo pueden hacer de aca.
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:
// 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 ?