Ajuda com capturar imagem da webcam

25/09/2017

0

Gente preciso da ajuda de vocês, peguei um exemplo da internet de como tirar foto pela webcam e salvar automaticamente...
sendo que preciso que salve com o nome por exemplo "teste01, teste01, teste02, teste03, teste04, teste05, teste06, teste07,, teste08,, teste09, teste10 "
APENAS 10 fotos, após o "teste10" ele volte a salvar como teste01 sobrescrevendo o teste01 antigo...
além disso, ele esta salvando as fotos na pasta onde o sistema esta instalado, sendo que quero deixar um lugar fixo diferente.
olhem o código.

unit Umain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
  Frame_Video, Vcl.StdCtrls;

type
  TForm5 = class(TForm)
    Frame11: TFrame1;
    Timer1: TTimer;
    Button1: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    Displayfotofinal: TPanel;
    fotofinal: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure fotofinalClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    count: integer;
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.Button1Click(Sender: TObject);
begin
  count := 0;
  Frame11.numCam := 3;
  Frame11.StartCam;
  Panel1.Visible := true;
  timer1.Enabled:=true;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  Frame11.InitFrame;
end;

procedure TForm5.fotofinalClick(Sender: TObject);
begin
  Displayfotofinal.Visible := false;
end;

function CountFiles(FilePath: string): integer;
var
  SearchRec: TSearchRec;
  fileCount: integer;
begin
  fileCount := 0;
  if FilePath[Length(FilePath)] <> '\\' then
    FilePath := FilePath + '\\';
  if FindFirst(FilePath + '*.png', faAnyFile and not faDirectory, SearchRec) = 0
  then
  begin
    Inc(fileCount);
    while FindNext(SearchRec) = 0 do
    begin
      Inc(fileCount);
    end;
  end;
  FindClose(SearchRec);
  result := fileCount;
end;

procedure TForm5.Timer1Timer(Sender: TObject);
var
  pastaAplicacao: string;
  NumeroArquivos: integer;
  nomeArquivo: string;
begin
  Inc(count);
  Label1.Caption := inttostr(10 - count);
  if count = 10 then
  begin
    Panel1.Visible := false;
    pastaAplicacao := ExtractFilePath(Application.ExeName);
    NumeroArquivos := CountFiles(pastaAplicacao);
    nomeArquivo := pastaAplicacao + '\\teste' + formatfloat('00000',
      NumeroArquivos) + '.png';
    Frame11.tpng.SaveToFile(nomeArquivo);
    Timer1.Enabled := false;
    Displayfotofinal.Visible := true;
    fotofinal.Picture.LoadFromFile(nomeArquivo);
    Frame11.Stop;
  end;
end;

end.
Michell

Michell

Responder

Posts

25/09/2017

Michell

Gente preciso da ajuda de vocês, peguei um exemplo da internet de como tirar foto pela webcam e salvar automaticamente...
sendo que preciso que salve com o nome por exemplo "teste01, teste01, teste02, teste03, teste04, teste05, teste06, teste07,, teste08,, teste09, teste10 "
APENAS 10 fotos, após o "teste10" ele volte a salvar como teste01 sobrescrevendo o teste01 antigo...
além disso, ele esta salvando as fotos na pasta onde o sistema esta instalado, sendo que quero deixar um lugar fixo diferente.
olhem o código.

unit Umain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
  Frame_Video, Vcl.StdCtrls;

type
  TForm5 = class(TForm)
    Frame11: TFrame1;
    Timer1: TTimer;
    Button1: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    Displayfotofinal: TPanel;
    fotofinal: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure fotofinalClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    count: integer;
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.Button1Click(Sender: TObject);
begin
  count := 0;
  Frame11.numCam := 3;
  Frame11.StartCam;
  Panel1.Visible := true;
  timer1.Enabled:=true;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  Frame11.InitFrame;
end;

procedure TForm5.fotofinalClick(Sender: TObject);
begin
  Displayfotofinal.Visible := false;
end;

function CountFiles(FilePath: string): integer;
var
  SearchRec: TSearchRec;
  fileCount: integer;
begin
  fileCount := 0;
  if FilePath[Length(FilePath)] <> ''\\\\\\\\'' then
    FilePath := FilePath + ''\\\\\\\\'';
  if FindFirst(FilePath + ''*.png'', faAnyFile and not faDirectory, SearchRec) = 0
  then
  begin
    Inc(fileCount);
    while FindNext(SearchRec) = 0 do
    begin
      Inc(fileCount);
    end;
  end;
  FindClose(SearchRec);
  result := fileCount;
end;

procedure TForm5.Timer1Timer(Sender: TObject);
var
  pastaAplicacao: string;
  NumeroArquivos: integer;
  nomeArquivo: string;
begin
  Inc(count);
  Label1.Caption := inttostr(10 - count);
  if count = 10 then
  begin
    Panel1.Visible := false;
    pastaAplicacao := ExtractFilePath(Application.ExeName);
    NumeroArquivos := CountFiles(pastaAplicacao);
    nomeArquivo := pastaAplicacao + ''\\\\\\\\teste'' + formatfloat(''00000'',
      NumeroArquivos) + ''.png'';
    Frame11.tpng.SaveToFile(nomeArquivo);
    Timer1.Enabled := false;
    Displayfotofinal.Visible := true;
    fotofinal.Picture.LoadFromFile(nomeArquivo);
    Frame11.Stop;
  end;
end;

end.

Galera como o código é muito grande irei upar dois blocos de notas no mega para se alguém poder me ajudar, ou então fazer um acesso remoto pelo teamviewer, isso me ajudaria muito, sou iniciante :/
Umain e Frame_Video
Responder

Que tal ter acesso a um e-book gratuito que vai te ajudar muito nesse momento decisivo?

Ver ebook

Recomendado pra quem ainda não iniciou o estudos.

Eu quero
Ver ebook

Recomendado para quem está passando por dificuldades nessa etapa inicial

Eu quero

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar