const
 AVICAPDLL   = 'AVICAP32.DLL';
 WM_CAP_SET_CALLBACK_FRAME       = WM_CAP_START + 5;
 WM_CAP_DRIVER_CONNECT           = WM_CAP_START + 10;
 WM_CAP_SET_SCALE                = WM_CAP_START + 53;
 WM_CAP_SAVEDIB                  = WM_CAP_START + 25;
 WM_CAP_SET_OVERLAY              = WM_CAP_START + 51;
var
h_cam : HDC;
vin:integer=0;
Bt    : BITMAPINFO;

function    capCreateCaptureWindowA(lpszWindowName: LPCSTR; dwStyle: DWORD; x, y: Integer;nWidth, nHeight: Integer; hwndParent: HWND;nID: Integer): HWND; stdcall; external AVICAPDLL;

procedure TForm1.ConnectClick(Sender: TObject);
begin
h_cam := capCreateCaptureWindowA('WDC', WS_CHILD or WS_VISIBLE, 2, 10, 640, 480, DC, 0);
if h_cam <> 0 then begin

if SendMessage(h_cam, WM_CAP_DRIVER_CONNECT, vin, 0) <> 0 then
 begin
   Bt.bmiHeader.biWidth    := 640;//640;
   Bt.bmiHeader.biHeight   := 480;
   Bt.bmiHeader.biSize     := SizeOf(Bt.bmiHeader);
   Bt.bmiHeader.biPlanes   := 1;  
   Bt.bmiHeader.biBitCount := 24;
   SendMessage(h_cam, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@FrameCallbackA));
   SendMessage(h_cam,WM_CAP_SET_SCALE,1,1);
   SendMessage(h_cam,WM_CAP_SET_OVERLAY,0,0);

   SendMessage(h_cam,WM_CAP_SAVEDIB,0,longint(pchar('obr.bmp')));
 end else
 begin
   MessageBox(h_cam, 'Не удалось инициализировать драйвер', nil, MB_ICONHAND);
   Exit;
 end;
 end;

end;

function initialVideo(Handle:THandle):hresult;
begin

ResetGraph;
ShowMessage('Шаг 2');
hr:=E_Fail;
hr:=CoCreateInstance(CLSID_FilterGraph,nil,CLSCTX_INPROC_SERVER,
IID_IGraphBuilder,FGraphBuilder);
if FaIled(hr) then
                begin
                ShowMessage('Ошибка построения графа фильтров');
                Exit;
                end;
hr:=CoCreateInstance(CLSID_CaptureGraphBuilder2,nil,CLSCTX_INPROC_SERVER,
IID_ICaptureGraphBuilder2,FCaptureGraphBuilder);
if FaIled(hr) then
                begin
                ShowMessage('Ошибка построения графа захвата');
                Exit;
                end;

hr:=FCaptureGraphBuilder.SetFiltergraph(FGraphBuilder);
if FaIled(hr) then
                begin
                ShowMessage('Ошибка задания графа фильтов в построении графа захвата');
                Exit;
                end;
////////////////////////////////////////////////////////////////////////////////////1
ShowMessage('Шаг 3');
//////////////////////////////////////////////////////////////////////////////////////1
FvideoCaptureFilter:=devices(CLSID_VideoInputDeviceCategory,VideoCaptureDeviceNa me,Nil,true);
FaudioCaptureFilter:=devices(CLSID_AudioInputDeviceCategory,AudioCaptureDeviceNa me,Nil,true);
FvideoCompressFilter:=devices(CLSID_VideoCompressorCategory,VideoCompressDeviceN ame,Nil,true);
//FaudioCompressFilter:=devices(CLSID_AudioCompressorCategory,AudioCompressDeviceN ame,Nil,true);
if FVideoCaptureFilter<>NIL then FGraphBuilder.AddFilter(FVideoCaptureFilter,'VideoCaptureFilter');
if FaudioCaptureFilter<>NIL then FGraphBuilder.AddFilter(FaudioCaptureFilter,'AudioCaptureFilter');
if FVideoCompressFilter<>NIL then FGraphBuilder.AddFilter(FVideoCompressFilter,'VideoCompressFilter');

ShowMessage('Шаг 4');
hr:=FCaptureGraphBuilder.RenderStream(@Pin_Category_Preview,@MediaType_Video,FVi deoCaptureFilter,nil,nil);
if Failed(hr) then
               begin        
                ShowMessage('Ошибка в построении видео для фильтра');
                Exit;
                end;
-------------------------------------------------------
функция поиска устройств
function devices(const clsidDeviceClass:TGUID;DevName:WIdestring;DevList:Tstrings;
           GetFirst:boolean):IBaseFilter;
var
DeviceName: OleVariant;
PropertyName: IPropertyBag;
pDevEnum: ICreateDevEnum;
pEnum:IEnumMoniker;
pFilter: IBaseFilter;
pMoniker: IMoniker;
hr: Hresult;
begin
pMoniker:=NIL;
pFilter:=NIL;
PropertyName:=NIL;
pDevEnum:=NIL;
pEnum:=NIL;
Result:=Nil;
hr:=CoCreateInstance(CLSID_SystemDeviceEnum,NIL,CLSCTX_INPROC_SERVER,IID_ICreate DevEnum,pDevEnum);
if Failed(hr) then Exit;
hr:=pDevEnum.CreateClassEnumerator(clsidDeviceClass,pEnum,0);
if (hr<>S_OK) then Exit;
While (S_OK=pEnum.Next(1,pMoniker,Nil)) do
begin
 if not GetFirst then
 begin
 hr:=pMoniker.BindToStorage(NIL,NIl,IPropertyBag,PropertyName);
 if Failed(hr) then Continue;
 hr:=PropertyName.Read('FriendlyName',DeviceName,NIL);
 if Failed(hr) then Continue;
 if DevList<>Nil then DevList.Add(DeviceName);
 end
 else begin
 if DevName<>'' then
 begin
   hr:=pMoniker.BindtoStorage(nil,nil,IPropertyBag,PropertyName);
   if Failed(hr) then Continue;
   hr:=PropertyName.read('FriendlyName',DeviceName,Nil);
   if Failed(hr) then Continue;
   if (DeviceName<>DevName) then Continue;
 end;
 hr:=pMoniker.BindToObject(nil,nil,IID_IBaseFilter,pFilter);
 if SuCCeeded(hr) then
   begin
   result:=pFilter;
   pEnum:=nil;
   pDevenum:=NIL;
   pMoniker:=nil;
   PropertyName:=nil;
   Exit;
 end;
end;
end;
pEnum:=nil;
pDevenum:=NIL;
pMoniker:=nil;
PropertyName:=nil;
pFilter:=NIl;
end;

hr:=FCaptureGraphBuilder.RenderStream(@Pin_Category_Preview,@MediaType_Video,FVi  deoCaptureFilter,nil,nil);
if Failed(hr) then
              begin        
               ShowMessage('Ошибка в построении видео для фильтра');
               Exit;
               end;