capture کردن اطلاعات webcam با توابع api به صورت stream

[a_b_toops]

من می خوام با webcam ارتباط برقرار کنم و اطلاعات دریافتی را با indy به client های دیگر ارسال کنم مشکل من دریافت اطلاعات از webcam است من با tavcomponent این کار را کردم ولی مشکل آن در این است بعد از باز کردن چند webcam تصاویر دیگر مشکل دار می شود و بعد با TVideoGrabber کار کردم و مشکل آن دیلی زیاد آن است و در انتها تصمیم گرفتم با توابع api ویندوز این کار رو انجام بدم اگر دوستان کار کرده اند من را راهنمایی کنند (capmci)

[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.LoadFromStream(s);
image1.Picture.graphic:=pic;
finally
s.Free;
pic.free;
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?p=318049#post318049

[a_b_toops]

من تمام مشکلاتم در این زمینه حل شده و نرم افزار ویدئو کنفراس شهری من با موفقیت به اتمام رسید.