گرفتن عکس با WebCam در دلفی7

[mjdeveloper]

سلام به دوستان
امیدوارم به دوستانی که احتیاج به این کد دارن بتونه کمکی بکنه
-------------------------------------

//capture image with WebCam
//design by mehdi jafari
unit CaptureImage;

interface
uses Windows, MMSystem, Messages, Clipbrd, jpeg, Graphics ,SysUtils, Classes ,adodb;
//------------------
const
AVICAPDLL = 'AVICAP32.DLL';

WM_CAP_DRIVER_CONNECT = WM_User + 10;
WM_CAP_DRIVER_DISCONNECT = WM_User + 11;
WM_CAP_SET_PREVIEW = WM_User + 50;
WM_CAP_SET_PREVIEWRATE = WM_User + 52;
WM_CAP_GRAB_FRAME = WM_User + 60;
WM_CAP_FILE_SAVEDIB = WM_User + 25;
WM_CAP_EDIT_COPY = WM_User+ 30;
//------------------
Function capDriverConnect(hwnd:THandle; I: Word) : Bool;
Function capDriverDisconnect(hwnd:THandle):Bool;
Function capPreview(hwnd:THandle; f:Word):Bool;
Function capGrabFrame(hwnd:THandle):Bool;
Function capFileSaveDIB(hwnd:THandle; szName:LPCSTR):Bool;
Function capEditCopy(hwnd:THandle):Bool;
Function capPreviewRate(hwnd:THandle; wMS:Word):Bool;

Function capCreateCaptureWindow(
lpszWindowName : LPCSTR;
dwStyle : DWORD;
x, y : integer;
nWidth, nHeight : integer;
hwndParent : HWND;
nID : integer
): HWND; stdcall;
Function GetPictureAndSave(webcam:THandle):TMemoryStream;

implementation
uses un_dm;
//------------------------------------------------------------------------------
function capCreateCaptureWindow(
lpszWindowName : LPCSTR;
dwStyle : DWORD;
x, y : integer;
nWidth, nHeight : integer;
hwndParent : HWND;
nID : integer
): HWND; stdcall; external AVICAPDLL name 'capCreateCaptureWindowA';
//------------------------------------------------------------------------------
Function capDriverConnect(hwnd:THandle; I: Word) : Bool;
begin
Result := SendMessage(hwnd,WM_CAP_DRIVER_CONNECT,I,0)<>0;
end;
//------------------------------------------------------------------------------
Function capDriverDisconnect(hwnd:THandle):Bool;
begin
Result := SendMessage(hwnd,WM_CAP_DRIVER_DISCONNECT,0,0)<>0;
end;
//------------------------------------------------------------------------------
Function capPreview(hwnd:THandle; f:Word):Bool;
begin
Result := SendMessage(hwnd,WM_CAP_SET_PREVIEW,f,0)<>0;
end;
//------------------------------------------------------------------------------
Function capPreviewRate(hwnd:THandle; wMS:Word):Bool;
begin
Result := SendMessage(hwnd,WM_CAP_SET_PREVIEWRATE,wMS,0)<>0;
end;
//------------------------------------------------------------------------------
Function capGrabFrame(hwnd:THandle):Bool;
begin
Result := SendMessage(hwnd,WM_CAP_GRAB_FRAME,0,0)<>0;
end;
//------------------------------------------------------------------------------
Function capFileSaveDIB(hwnd:THandle; szName:LPCSTR):Bool;
begin
Result := SendMessage(hwnd,WM_CAP_FILE_SAVEDIB,0,LParam(szNa me))<>0;
end;
//------------------------------------------------------------------------------
Function capEditCopy(hwnd:THandle):Bool;
begin
Result := SendMessage(hwnd,WM_CAP_EDIT_COPY,0,0)<>0;
end;
//------------------------------------------------------------------------------
Function GetPictureAndSave(webcam:THandle):TMemoryStream;
var
Bitmap : TBitmap;
m : TJPEGImage;
s : TMemoryStream;
begin
Clipboard.Clear;
capGrabFrame(webcam);
capEditCopy(webcam);
Bitmap := TBitMap.create;
try
if Clipboard.HasFormat(CF_BITMAP) then
Bitmap.LoadFromClipBoardFormat(cf_BitMap ,ClipBoard.GetAsHandle(cf_Bitmap), 0)
else
begin
Result := nil;
exit;
end;
m := TJPEGImage.Create;
s := TMemoryStream.Create;
try
m.CompressionQuality := 50;
m.Assign(Bitmap);
m.SaveToStream(s);
Result := s;
finally
m.Free;
end;
finally
Bitmap.free;
end;
end;
//------------------------------------------------------------------------------
end.

این unit کار فرستادن پیغامهای مربوط به WebCam رو به ویندوز انجام میده.

طریقه استفاده :


unit unit1;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, jpeg, ExtCtrls, StdCtrls, Db, AdoDb,
Buttons, DateUtils;
.
.
.
Protected
procedure InitCamera;
.
.
.
var
webcam :THandle;

implementation
uses CaptureImage;

procedure botton1onClick(sender:Tobject);
var
s:TMemoryStream;
pic:TJPEGImage;
begin
try
InitCamera;
s:=TMemoryStream.Create;
pic:=TJPEGImage.Create;
try
s.LoadFromStream(GetPictureAndSave(webcam));
pic. pic.LoadFromStream(s);
image1.Picture.graphic:=pic;
finally
s.Free;
pic.free;
end;
except
end;
end;
//-------------------------------------------------------------
procedure Tform1.InitCamera;
begin
try
webcam:=capCreateCaptureWindow('my webcam',WS_CHILD or WS_VISIBLE,
0,0,pnlCamera.Width,
pnlCamera.Height,
pnlCamera.Handle,0);
capDriverConnect(webcam,0);
capPreviewRate(webcam,10);
capPreview(webcam,1);
except
end;
end;
//----------------------------------------------------------

در پایان که برنامتون بسته میشه از این تابع استفاده کنید ---- در onClose


capDriverDisconnect(WebCam)


کوچیک شما مهدی جعفری:چشمک:

[DAMAVAND]

سلام
اقا مهدی عزیز ممنون از راهنماییت .
ولی هر پست رو لطفا یک بار تکرار کنید.
قوانین سایت:
http://barnamenevis.org/forum/showthread.php?t=51814
با تشکر

[mjdeveloper]

شرمنده قربان دیگه تکرار نمیشه