Webcam Delphi

Pensei que vc ja tinha pego, pois isso tirei, me dê um retorno se deu tudo certo. ai eu tiro, ok

Olá Henrique eu faço uso do DirectX - www.clootie.ru/delphi, pego a webCam que esta instalada e captura a foto e gravo no banco de dados, tentei usar esse componentes não não deu certo, o que vc predente fazer ?

Experimente utilizar o componente: "Professional Screen Camera Component v.5.2.3.0 " (freeware)

link para download:

[url]http://www.torry.net/vcl/mmedia/video/PSC.v5.2.3.0.zip[/url]

Abração!!

Espero ter ajudado!!!

Emanoel Deivison
Recife - PE

Olá Paulo, então, eu quero pegar a imagem da webcam, mostrala em um timage e grava-la no firebird depois!! No delphi 7 eu consegui salvar a imagem no meu PC e mostrá-la no timage com o componente jvavicapture, mas no delphi xe eu faço exatamente a mesma coisa e não funciona!! Obrigado pela ajuda!!

Vamos lá:

Vc esta usando DBXpress ????

GRAVAR UMA IMAGEM NUM CAMPO BLOB
(a query/dataset deve estar com State in [dsEdit,dsInsert]

procedure GravaFoto(DataSet : TDataSet; BlobFieldName, FileName : String);

GravaFoto(qryCliente,'FOTO','filename.jpg');

qryCliente - é a query/dataset com os dados
'FOTO' - string com o nome do campo blob
'filename' - string com o nome de arquivo jpg ou bmp

** você poderá substituir o 'filename' por: OpenPictureDialog1.FileName

-----

uses
Jpeg,
Graphics,
ExtDlgs,
Classes,
DB,
SysUtils,
ExtCtrls,
Dialogs,
Consts;

const
OffsetMemoryStream : Int64 = 0;

type
TTipoImagem = (tiBitmap, tiJpeg);


procedure GravaFoto(DataSet : TDataSet; BlobFieldName, FileName : String);




procedure GravaFoto(DataSet : TDataSet; BlobFieldName, FileName : String);
var
ext : string;
begin
if (DataSet.State in [dsEdit,dsInsert]) then begin
ext := UpperCase(ExtractFileExt(FileName));
if (ext <> '.BMP') and (ext <> '.JPG') and (ext <> '.JPEG') then begin
raise EAccessViolation.Create('Formado de imagem não suportado! Formato suportado: Jpeg ou Bitmap');
Abort;
end;
try
Jpg := TJpegImage.Create;
MemoryStream := TMemoryStream.Create;
Bitmap := TBitmap.Create;
if (ext = '.BMP') then begin
Bitmap.LoadFromFile(FileName);
Jpg.Assign(Bitmap);
Jpg.Compress;
end else
Jpg.LoadFromFile(FileName);
Jpg.SaveToStream(MemoryStream);
MemoryStream.Position := OffsetMemoryStream;
(DataSet.FieldByName(BlobFieldName) as TBlobField).BlobType := ftTypedBinary;
(DataSet.FieldByName(BlobFieldName) as TBlobField).LoadFromStream(MemoryStream);
finally
MemoryStream.Free;
Bitmap.Free;
Jpg.Free;
end;
end;
end;


Preciso saber o que vai fazer, pois minha Unit faz umas coisa que pra vc nem serve, por exemplo, trato imagens, exibo em webservice via ftp, eu circulo na filmagem da webcam um bloco/setor para detectar movimento ai tiro fotos, estou trabalhando com reconhecimento facial, então essa Unit ta muito grande, vc vai fazer tipo um cadastro de clientes/alunos com foto ???

Segue a Unit que reconhece a WebCam para captura:

unit VideoCaptura;

USES Windows, Messages, SysUtils, Classes, ActiveX, Forms,
{$ifdef DXErr} DXErr9, {$endif}
DirectShow9;


CONST
WM_GRAPHNOTIFY = WM_APP+1;
WM_NewFrame = WM_User+2; // Used to inform application that a new video
// frame has arrived. Necessary only, if
// application hasn't defined a callback
// routine via TVideoSample.SetCallBack(...).


CONST { Copied from OLE2.pas }
{$EXTERNALSYM IID_IUnknown}
IID_IUnknown: TGUID = (
D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));



TYPE
TPLAYSTATE = (PS_Stopped,
{PS_Init,}
PS_Paused,
PS_Running);


FUNCTION StartVideo(CaptureDeviceName: string; Visible: boolean; VAR DeviceSelected: string):HRESULT;
FUNCTION PausaVideo: HResult; // Pause running video
FUNCTION ResumeVideo: HResult; // Re-start paused video
FUNCTION StopVideo: HResult;
function GetImageBuffer(VAR pb : pbytearray; var Size: integer): HResult;
FUNCTION SetPreviewState(nShow: boolean): HRESULT;
FUNCTION ShowPropertyDialog: HResult;
FUNCTION ShowPropertyDialog_CaptureStream: HResult;
FUNCTION GetVideoPropAmpEx( Prop : TVideoProcAmpProperty;
VAR pMin, pMax,
pSteppingDelta,
pDefault : longint;
VAR pCapsFlags : TVideoProcAmpFlags;
VAR pActual : longint): HResult;



FUNCTION VideoCaptura.StartVideo(DeviceName: string; Visible: boolean; VAR DeviceSelected: string):HRESULT;
BEGIN
pIBFVideoSource := nil;
FVisible := Visible;

// Attach the filter graph to the capture graph
Result := pICapGraphBuild2.SetFiltergraph(pIGraphBuilder);
if (FAILED(Result)) then
begin
// Failed to set capture filter graph!
exit;
end;

// Use the system device enumerator and class enumerator to find
// a video capture/preview device, such as a desktop USB video camera.
Result := ConnectToCaptureDevice(CaptureDeviceName, DeviceSelected, pIBFVideoSource);
if (FAILED(Result)) then
begin
exit;
end;

LoadListOfResolution;
Result := RestartVideo;
end;



FUNCTION VideoCaptura.PausaVideo: HResult;
BEGIN
IF g_psCurrent = PS_Paused
then begin
Result := S_OK;
EXIT;
end;
IF g_psCurrent = PS_Running then
begin
Result := pIMediaControl.Pause;
if Succeeded(Result) then
g_psCurrent := PS_Paused;
end
else Result := S_FALSE;
END;


FUNCTION VideoCaptura.ResumeVideo: HResult;
BEGIN
IF g_psCurrent = PS_Running then
begin
Result := S_OK;
EXIT;
end;
IF g_psCurrent = PS_Paused then
begin
Result := pIMediaControl.Run;
if Succeeded(Result) then
g_psCurrent := PS_Running;
end
else Result := S_FALSE;
END;



FUNCTION VideoCaptura.StopVideo: HResult;
BEGIN
// Stop previewing video data
Result := pIMediaControl.StopWhenReady();
g_psCurrent := PS_Stopped;
SetLength(FormatArr, 0);
END;






No seu Form.Active, colque um combox para lsta as WebCams instaladas

var
DeviceList : TStringList;

begin

if Activated then
exit;
Activated := true;


// Listas as webCams ou Cameras IPs
DeviceList := TStringList.Create;
VideoCapture.GetListOfDevices(DeviceList);

if DeviceList.Count < 1 then
begin
// Se não encontrar cameras fecha a aplicação
Caption := 'WVisitante [Não foi encontrado WebCam]';
MessageDlg('Não há serviço de webcam ativo.'#10'Informação...', mtError, [mbOK], 0);

exit;
end else
begin

Combobox1.items.Assign(DeviceList);
Combobox1.ItemIndex := 0;
btnStart.Enabled := true;
end;


Unit CapturaFrames;


interface


USES Windows, Messages, Controls, Forms, SysUtils, Graphics, Classes,
AppEvnts, MMSystem, DirectShow9, JPEG,
VSample;

CONST
CBufferCnt = 3;

procedure GetListOfDevices(DeviceList: TStringList);
procedure VideoStop;
procedure VideoPause;
procedure VideoResume;
function VideoStart(DeviceName: string): integer;
procedure GetBitmap(BMP: TBitmap);
procedure GetJpeg(JPG: TJPEGImage);
procedure SetDisplayCanvas(Canvas: TCanvas);
procedure ShowProperty;
procedure ShowProperty_Stream;


procedure CapturaFrames.GetListOfDevices(DeviceList: TStringList);
begin
GetCaptureDeviceList(DeviceList);
end;


procedure CapturaFrames.VideoPause;
begin
if not assigned(VideoSample) then
exit;
VideoSample.PauseVideo;
end;



procedure CapturaFrames.VideoResume;
begin
if not assigned(VideoSample) then
exit;
VideoSample.ResumeVideo;
end;



procedure CapturaFrames.VideoStop;
begin
fFPS := 0;
if not assigned(VideoSample) then
exit;

try
VideoSample.Free;
VideoSample := nil;
except
end;
fVideoRunning := false;
end;



function CapturaFrames.VideoStart(DeviceName: string): integer;
VAR
hr : HResult;
st : string;
W, H : integer;
FourCC : cardinal;
begin
fSkipCnt := 0;
fFrameCnt := 0;
f30FrameTick := 0;
fFPS := 0;
fImageUnpacked := false;

Result := 0;
if assigned(VideoSample) then
VideoStop;

VideoSample := TVideoSample.Create(Application.MainForm.Handle, false, 0, HR); // Abrindo RGB 24bits
try
hr := VideoSample.StartVideo(DeviceName, false, st) // Não abrir, destruir o display
except
hr := -1;
end;

if Failed(hr)
then begin
VideoStop;
// SpeedButton_RunVideo.Down := false;
// ShowMessage(DXGetErrorDescription9A(hr));
Result := 1;
end
else begin
hr := VideoSample.GetStreamInfo(W, H, FourCC);
IF Failed(HR)
then begin
VideoStop;
Result := 1;
end
else BEGIN
fWidth := W;
fHeight := H;
fFourCC := FourCC;
FBitmap.PixelFormat := pf24bit;
FBitmap.Width := W;
FBitmap.Height := H;
VideoSample.SetCallBack(CallBack); // Modificado Paulo - 27/06/2007
END;
end;
end;


procedure CapturaFrames.GetBitmap(BMP: TBitmap);
begin
IF not fImageUnpacked then
UnpackFrame(fImagePtrSize[fImagePtrIndex], fImagePtr[fImagePtrIndex]);
BMP.Assign(fBitmap);
(*
BMP.PixelFormat := pf24bit;
BMP.Width := fBitmap.Width;
BMP.Height := fBitmap.Height;
move(fBitmap.ScanLine[fBitmap.Height-1]^, BMP.ScanLine[BMP.height-1]^, BMP.Height*BMP.Width*3);
//BMP.Canvas.Draw(0, 0, fBitmap);
*)
end;



procedure CapturaFrames.SetDisplayCanvas(Canvas: TCanvas);
begin
fDisplayCanvas := Canvas;
end;



procedure CapturaFrames.ShowProperty;
begin
VideoSample.ShowPropertyDialog;
end;

procedure CapturaFrames.GetJpeg(JPG: TJPEGImage);
begin
IF not fImageUnpacked then
UnpackFrame(fImagePtrSize[fImagePtrIndex], fImagePtr[fImagePtrIndex]);
JPG.Assign(fJpeg);

end;


End.



Acho que mais facil eu te montar um exemplo, qualquer coisa dá um grito.

Muito obrigado pela ajuda Paulo, a parte que eu não to conseguindo fazer é a de capturar imagem da webcam!! É um cadastro de clientes que eu queria que aparecesse a webcam e tirasse a foto na hora, não que pegasse uma imagem que já existe!! Mas a parte que você mostrou aqui também vai me ajudar muito!! Muito obrigado mesmo, abraços!!

Agora que eu vi que você postou sobre a webcam!! Com exemplo seria mais fácil mesmo, mas não quero te dar trabalho!!! Todas essas funções e procedures são feitas em um formulário só? E não botão para capturar imagem? Desde já agradeço!!

Eu uso Units, chamo elas pelo forms

Beleza, me passa mais ou meno sua tabela de clientes, id, nome, foto(blob) isso mesmo ? vou criar uma similar e criar um exemplo e te mando, mas só posso fazer isso na segunda, ok

É muito simples.

Isso, é um cadastro de clientes com ID, nome e foto(blob) mesmo, não quero te dar trabalho, só se você puder você faz beleza? Muito obrigado mesmo e bom fim de semana!!

Olá Henrique segue exemplo

https://skydrive.live.com/redir?resid=90738B8009A49B94!384&authkey=!AMtAMh_J4ATbudM

Bom dia Paulo, o link que vc me enviou está vazio!!!!

Tenta agora, é que meu Sky, estava cheio, rsrsrs

Pensei que vc ja tinha pego, pois isso tirei, me dê um retorno se deu tudo certo. ai eu tiro, ok

Desculpa a demora pra responder Paulo, mas eu peguei o seu exemplo, muito obrigado mesmo, tá me ajudando bastante!! Eu to analisando os códigos!!Abraços!!

eu sei que eu to abusando de você Paulo, mas eu gostaria de saber se é possível tirar várias fotos com a webcam, lista-las em timages dentro de um scrollbox!! Um exemplo do que eu to falando é o sistema zscan de clínica médica!! Desde já agradeço!!!!!

Olá Paulo...

Será que vc poderia me passar esse exemplo também, estou fazendo um programa para capturar direto de uma webcam e não está indo...

Obrigado

Olá Paulo!

Estou passando pelo mesmo problema, uso delphi 7. Tem como você disponibilizar o exemplo, desde já agradeço.

Olá Paulo,

estou querendo implementar estas units no Delphi XE2, você poderia disponibilizar o seu exemplo?

Obrigado,
Luiz

Bom dia Paulo,

Estou com esse problema também utilizo delphi XE2 e ficaria muito agradecido se puder disponibilizar esse exemplo.

Grande abraço e já agradecendo muito obrigado.

Paulo, vi que vc tem um exemplo de como capturar imagem da webcam, gostaria q se possivel vc me disponibilizasse também, pois ja quebrei minha cabeca e não sai do canto, desde ja agradeco

henrique, vc podia me passar o exemplo do Paulo pra mim poor email ????? oficinamartelosdeouro@gmail.com

Pessoal, vou colocar o exemplo de novo no OneDrive, e aviso.

Bom dia!

Paulo você poderia me passar o código fonte do seu exemplo?

Poderia mandar esse exemplo pra mim ?

Pessoal estou usando delphi xe5 não estou conseguindo capturar a imagem nao estou achando um componente compatível e q funcione corretamente.
alguém tem algum componente que saiba como utilizar qualquer coisa me manda por favor fico no aguardo
até mais

Poderia passar o link novamente ou deixar em um servidor "Não Particular" seu...

Agradeceria muito

Senhores,

poderiam me ajudar a fazer o download do Jvavicapture.

Atenciosamente Christiano Vasconcellos

21 3322 1859

christianovasconcellos0@gmail.com

Boa noite, você poderia me postar o arquivo com o exemplo para capturar a imagem ?
Uso delphi xe5 e sempre tem problemas nesse tipo de evento.
josinaldo.kraft@gmail.com