|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
Сохранить изображение с WebCam в поток
DELETED MESSAGE
Последний раз редактировалось cmepthuk, 19.07.2016 в 19:10. |
#2
|
||||
|
||||
Надо глянуть, что вообще умеет делать AVICAP32.DLL, может у нее есть альтернативные методы вывода.
Можно попытаться выцепить с того окна обработчик сообщений. — Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию Последний раз редактировалось M.A.D.M.A.N., 23.12.2012 в 22:35. |
#3
|
||||
|
||||
Есть вроде в авикапе возможность ставить колбэк-функцию. Ей передается тупо массив байт, по всей видимости прямо так, как приходит с камеры. С одной моей камеры, например, приходил в YUV2, а с другой - в MJPEG кадре.
jmp $ ; Happy End! The Cake Is A Lie. |
#4
|
|||
|
|||
Сам не пробовал, но... по отзывам (пробовал использовать поверхностно), эта библиотека довольно глючна. Как вариант - пользовать DSPack. Есть еще много подобных библиотек (гугл в помощь).
|
#5
|
|||
|
|||
Что то типа ip камеры. Давно дело было. Забросил...
|
#6
|
|||
|
|||
DELETED MESSAGE
Последний раз редактировалось cmepthuk, 19.07.2016 в 19:10. |
#7
|
|||
|
|||
Пример на DirectShow (можно изображение делать зеркальным)
файл проекта: Код:
program Grabber; uses ActiveX, Forms, Unit1 in 'Unit1.pas' {Form1}, ConFilters in 'ConFilters.pas'; {$R *.res} begin Application.Initialize; // Initialize the COM system CoInitialize(nil); Application.CreateForm(TForm1, Form1); Application.Run; // Shut down the COM system CoUninitialize(); end. |
#8
|
|||
|
|||
Код:
unit Unit1; interface uses DirectShow9, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls, AppEvnts, Menus, ActiveX; type TForm1 = class(TForm) btnExit: TButton; StatusBar1: TStatusBar; PanelVideo: TPanel; chbMirror: TCheckBox; MainMenu1: TMainMenu; Devices: TMenuItem; Label1: TLabel; btnPause: TButton; btnRun: TButton; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btnExitClick(Sender: TObject); procedure chbMirrorClick(Sender: TObject); procedure btnPauseClick(Sender: TObject); procedure btnRunClick(Sender: TObject); private { Private declarations } procedure OnSelectDevice(Sender: TObject); procedure Cleanup; public { Public declarations } pBuild: ICaptureGraphBuilder2; pGraph: IGraphBuilder; pEnumCat: IEnumMoniker; pVideoCapture: IBaseFilter; pVmr: IBaseFilter; pVMC: IVMRMixerControl9; pWc: IVMRWindowlessControl9; pControl: IMediaControl; pEvent: IMediaEvent; pGrabberF: IBaseFilter; pGrabber: ISampleGrabber; // pNullRenderer: IBaseFilter; function InitCaptureGraphBuilder: HRESULT; function InitWindowlessVMR: HRESULT; end; var Form1: TForm1; implementation {$R *.dfm} uses DSUtil, // FreeMediaType, IID_IPropertyBag ConFilters; procedure TForm1.FormCreate(Sender: TObject); var hr: HRESULT; pSysDevEnum: ICreateDevEnum; dwFlags: Dword; i: integer; pMoniker: IMoniker; pPropBag: IPropertyBag; varName: OleVARIANT; Device: TMenuItem; begin Label1.Caption:= 'Видеопанель.'#13#10+ 'Выберете устройство видеовхода из меню'#13#10+ 'и подождите несколько секунд для инициализации.'#13#10+ 'Во время просмотра убирайте и ставьте галочку ''Зеркало'''; if Failed(InitCaptureGraphBuilder) then Exit; // Create the System Device Enumerator. hr:= CoCreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC_SERVER, IID_ICreateDevEnum, pSysDevEnum); if FAILED(hr) then Exit; // Obtain a class enumerator for the video capture category. dwFlags:= CDEF_DEVMON_PNP_DEVICE or CDEF_DEVMON_FILTER; // или 0 hr:= pSysDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, pEnumCat, dwFlags); if hr = S_OK then begin // Enumerate the monikers. i:= 0; while pEnumCat.Next(1, pMoniker, nil) = S_OK do begin hr:= pMoniker.BindToStorage(nil, nil, IID_IPropertyBag, pPropBag); if SUCCEEDED(hr) then begin // To retrieve the filter's friendly name, do the following: VariantInit(varName); hr:= pPropBag.Read('FriendlyName', varName, nil); if SUCCEEDED(hr) then begin // Display the name in your UI somehow. Device:= TMenuItem.Create(Devices); Device.Caption:= varName; Device.Tag:= i; Inc(i); Device.OnClick:= OnSelectDevice; Devices.Add(Device); end; VariantClear(varName); pPropBag:= nil; end; pMoniker:= nil; end; // while end; // if pSysDevEnum:= nil; end; // FormCreate function TForm1.InitCaptureGraphBuilder: HRESULT; // FormCreate begin // Create the Capture Graph Builder. Result:= CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, pBuild ); if SUCCEEDED(Result) then begin // Create the Filter Graph Manager. Result:= CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, pGraph); if SUCCEEDED(Result) then // Initialize the Capture Graph Builder. pBuild.SetFiltergraph(pGraph) else begin ShowMessage('DirectShow не установлен'); pBuild:= nil; end; end; end; procedure TForm1.OnSelectDevice(Sender: TObject); var pMoniker: IMoniker; hr: HResult; rcDest: TRect; _hdc: HDC; iBitDepth: Integer; mt: TAMMediaType; begin Label1.Caption:= 'Ждите...'; PanelVideo.Refresh; pEnumCat.Reset; pEnumCat.Skip(TMenuItem(Sender).Tag); pEnumCat.Next(1, pMoniker, nil); // To create an instance of the filter, do the following: hr:= pMoniker.BindToObject(nil, nil, IID_IBaseFilter, pVideoCapture); // Now add the filter to the graph. if Succeeded(hr) then hr:= pGraph.AddFilter(pVideoCapture, 'Video Capture Filter'); pMoniker:= nil; if not Assigned(pVmr) then if FAILED(InitWindowlessVMR) then Exit; // Create the Sample Grabber. hr:= CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pGrabberF); if FAILED(hr) then begin // Return an error. Exit; end; hr:= pGraph.AddFilter(pGrabberF, 'Sample Grabber'); if FAILED(hr) then begin // Return an error. Exit; end; pGrabberF.QueryInterface(IID_ISampleGrabber, pGrabber); // SetMediaType ZeroMemory(@mt, sizeof(AM_MEDIA_TYPE)); { a) mt.majortype = MEDIATYPE_Video; mt.subtype = MEDIASUBTYPE_RGB24; hr = pGrabber->SetMediaType(&mt); } // б) используется свойства монитора // Find the current bit depth. _hdc:= GetDC(0); iBitDepth:= GetDeviceCaps(_hdc, BITSPIXEL); ReleaseDC(0, _hdc); // Set the media type. mt.majortype:= MEDIATYPE_Video; case iBitDepth of 8: mt.subtype:= MEDIASUBTYPE_RGB8; 16: mt.subtype:= MEDIASUBTYPE_RGB555; 24: mt.subtype:= MEDIASUBTYPE_RGB24; 32: mt.subtype:= MEDIASUBTYPE_RGB32; else {Result:= E_FAIL;} Exit; end; hr:= pGrabber.SetMediaType(mt); FreeMediaType(@mt); // Buidl the filter graph hr:= ConnectFilters(pGraph, pVideoCapture, pGrabberF); // a) Buffering mode (копия каждого кадра) { активация: ISampleGrabber.SetBufferSamples(true) } // b) Callback mode (вызов ф-ии на каждом кадре) { два способа: b1) ISampleGrabber.SetCallback(ISampleGrabberCB, 0) -> будет вызываться SampleCB b2) ISampleGrabber.SetCallback(ISampleGrabberCB, 1) -> будет вызываться BufferCB Если ISampleGrabberCB = nil, то режим Callback заканчивается. ISampleGrabberCB содержит методы BufferCB (получает указатель на копию последнего кадра, sample buffer) и SampleCB (получает указатель на кадр, IMediaSample) с) ISampleGrabber.SetOneShot(true) получает один кадр и останавливает граф. Пример. После поиска позиции захватить один кадр: // Set one-shot mode and buffering. hr:= pGrabber.SetOneShot(TRUE); } // Grab the Sample (используем Buffering mode) hr:= pGrabber.SetBufferSamples(TRUE); { hr:= CoCreateInstance(CLSID_NullRenderer, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter, pNullRenderer); hr:= pGraph.AddFilter(pNullRenderer, 'Null Renderer'); hr:= ConnectFilters(pGraph, pGrabberF, pNullRenderer); } hr:= ConnectFilters(pGraph, pGrabberF, pVmr); if Succeeded(hr) then begin rcDest:= PanelVideo.ClientRect; // Set the video position. pWc.SetVideoPosition(nil, @rcDest); end; // Run if Failed(pGraph.QueryInterface(IID_IMediaControl, pControl)) then Exit; if Failed(pGraph.QueryInterface(IID_IMediaEvent, pEvent)) then Exit; pControl.Run(); // Run the graph. btnPause.Enabled:= true; end; function TForm1.InitWindowlessVMR: HRESULT; var pConfig: IVMRFilterConfig9; begin // Create the VMR. Result:= CoCreateInstance(CLSID_VideoMixingRenderer9, nil, CLSCTX_INPROC, IID_IBaseFilter, pVmr); if FAILED(Result) then Exit; // Add the VMR to the filter graph. Result:= pGraph.AddFilter(pVmr, 'Video Mixing Renderer'); if FAILED(Result) then begin pVmr:= nil; Exit; end; // Set the rendering mode. Result:= pVmr.QueryInterface(IID_IVMRFilterConfig9, pConfig); if SUCCEEDED(Result) then begin { Result:=} pConfig.SetRenderingMode(VMR9Mode_Windowless); Result:= pConfig.SetNumberOfStreams(1); pConfig:= nil; end; if SUCCEEDED(Result) then begin Result:= pVmr.QueryInterface(IID_IVMRMixerControl9, pVMC); if Succeeded(Result) then chbMirror.OnClick(nil); // Set the window. Result:= pVmr.QueryInterface(IID_IVMRWindowlessControl9, pWc); if SUCCEEDED(Result) then begin Result:= pWc.SetVideoClippingWindow(PanelVideo.Handle); if SUCCEEDED(Result) then pWc.SetBorderColor($00FF0000) else // An error occurred, so release the interface. pWc:= nil; end; end; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin Cleanup; end; procedure TForm1.btnExitClick(Sender: TObject); begin Close; end; //////////////////////////////////////////////////////////// procedure TForm1.Cleanup; // FormClose begin pControl.Stop; pControl:= nil; pEvent:= nil; pWc:= nil; pVMC:= nil; pVmr:= nil; pVideoCapture:= nil; pEnumCat:= nil; pGraph:= nil; pBuild:= nil; end; // Cleanup procedure TForm1.chbMirrorClick(Sender: TObject); var vmrRect: TNormalizedRect; begin with vmrRect do begin top:= 0; bottom:= 1; if chbMirror.State = cbChecked then begin left:= 1; right:=0 end // зеркало else begin left:= 0; right:=1 end; end; pVMC.SetOutputRect(0, @vmrRect); end; |