|
|
Регистрация | << Правила форума >> | 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; |
#9
|
|||
|
|||
продолжение
Код:
procedure TForm1.btnPauseClick(Sender: TObject); var hr: HResult; cbBuffer: Integer; evCode: Integer; pBuffer: Pointer; // PByteArray pVih: PVIDEOINFOHEADER; mt: TAMMediaType; begin pControl.Pause(); btnRun.Enabled:= true; btnPause.Enabled:= false; { ISampleGrabber.GetCurrentBuffer копирует данные (вызываем 2 раза, первый раз, чтобы узнать размер кадра) в наш буфер } // Find the required buffer size. cbBuffer:= 0; hr:= pGrabber.GetCurrentBuffer(cbBuffer, nil); GetMem(pBuffer, cbBuffer); if not Assigned(pBuffer) then begin // Out of memory. Return an error code. Exit; end; hr:= pGrabber.GetCurrentBuffer(cbBuffer, pBuffer); // The ISampleGrabber::GetConnectedMediaType method returns the format of the buffer: hr:= pGrabber.GetConnectedMediaType(mt); if FAILED(hr) then begin // Return error code. Exit; end; // Examine the format block. if IsEqualGUID(mt.formattype, FORMAT_VideoInfo) and (mt.cbFormat >= sizeof(VIDEOINFOHEADER)) and Assigned(mt.pbFormat) then pVih:= mt.pbFormat else begin // Wrong format. Free the format block and return an error. FreeMediaType(@mt); Exit; //return VFW_E_INVALIDMEDIATYPE; end; // You can use the media type to access the BITMAPINFOHEADRE information. // For example, the following code draws the bitmap using GDI: SetDIBitsToDevice( GetDC(PanelVideo.Handle), 0, 0, pVih.bmiHeader.biWidth, pVih.bmiHeader.biHeight, 0, 0, 0, pVih.bmiHeader.biHeight, pBuffer, PBITMAPINFO(@pVih.bmiHeader)^, DIB_RGB_COLORS ); // Free the format block when you are done: FreeMediaType(@mt); FreeMem(pBuffer, cbBuffer); end; procedure TForm1.btnRunClick(Sender: TObject); begin pControl.Run; btnPause.Enabled:= true; btnRun.Enabled:= false; end; end. Код:
object Form1: TForm1 Left = 277 Top = 160 Width = 768 Height = 576 Caption = 'Видеозахват' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Menu = MainMenu1 OldCreateOrder = False Position = poDefaultPosOnly ScreenSnap = True OnClose = FormClose OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object btnExit: TButton Left = 8 Top = 472 Width = 75 Height = 25 Cancel = True Caption = 'Exit' TabOrder = 0 OnClick = btnExitClick end object StatusBar1: TStatusBar Left = 0 Top = 511 Width = 760 Height = 19 Panels = <> end object PanelVideo: TPanel Left = 100 Top = 16 Width = 640 Height = 480 TabOrder = 2 object Label1: TLabel Left = 36 Top = 36 Width = 32 Height = 13 Caption = 'Label1' end end object chbMirror: TCheckBox Left = 8 Top = 16 Width = 69 Height = 17 Caption = 'Зеркало' Checked = True State = cbChecked TabOrder = 3 OnClick = chbMirrorClick end object btnPause: TButton Left = 8 Top = 148 Width = 75 Height = 25 Caption = 'Pause' Enabled = False TabOrder = 4 OnClick = btnPauseClick end object btnRun: TButton Left = 8 Top = 188 Width = 75 Height = 25 Caption = 'Run' Enabled = False TabOrder = 5 OnClick = btnRunClick end object MainMenu1: TMainMenu Left = 28 Top = 64 object Devices: TMenuItem Caption = 'Видеовход' end end end |
#10
|
|||
|
|||
Код:
unit ConFilters; interface uses DirectShow9; function GetUnconnectedPin( pFilter: IBaseFilter; // Pointer to the filter. PinDir: PIN_DIRECTION; // Direction of the pin to find. out ppPin: IPin // Receives a pointer to the pin. ): HRESULT; function ConnectFilters( pGraph: IGraphBuilder; // Filter Graph Manager. pOut: IPin; // Output pin on the upstream filter. pDest: IBaseFilter // Downstream filter. ): HRESULT; overload; function ConnectFilters( pGraph: IGraphBuilder; pSrc, pDest: IBaseFilter): HRESULT; overload; implementation uses Windows, ActiveX; function GetUnconnectedPin( pFilter: IBaseFilter; PinDir: PIN_DIRECTION; out ppPin: IPin ): HRESULT; var pEnum: IEnumPins; pPin: IPin; ThisPinDir: TPinDirection; pTmp: IPin; begin Result:= pFilter.EnumPins(pEnum); if FAILED(Result) then Exit; while pEnum.Next(1, pPin, nil) = S_OK do begin pPin.QueryDirection(ThisPinDir); if ThisPinDir = PinDir then begin Result:= pPin.ConnectedTo(pTmp); if SUCCEEDED(Result) then // Already connected, not the pin we want. pTmp:= nil else // Unconnected, this is the pin we want. begin pEnum:= nil; ppPin:= pPin; Result:= S_OK; Exit; end; end; pPin:= nil; end; pEnum:= nil; // Did not find a matching pin. Result:= E_FAIL; end; function ConnectFilters( pGraph: IGraphBuilder; // Filter Graph Manager. pOut: IPin; // Output pin on the upstream filter. pDest: IBaseFilter // Downstream filter. ): HRESULT; var pIn: IPin; begin // Find an input pin on the downstream filter. Result:= GetUnconnectedPin(pDest, PINDIR_INPUT, pIn); if FAILED(Result) then Exit; // Try to connect them. Result:= pGraph.Connect(pOut, pIn); pIn:= nil; end; function ConnectFilters( pGraph: IGraphBuilder; pSrc, pDest: IBaseFilter): HRESULT; var pOut: IPin; begin // Find an output pin on the first filter. Result:= GetUnconnectedPin(pSrc, PINDIR_OUTPUT, pOut); if FAILED(Result) then Exit; Result:= ConnectFilters(pGraph, pOut, pDest); pOut:= nil; end; end. |
Этот пользователь сказал Спасибо AlexSku за это полезное сообщение: | ||
angvelem (13.01.2013)
|
#11
|
||||
|
||||
AlexSku, это троллинг такой? Проект вложить не судьба?
Некоторые программисты настолько ленивы, что сразу пишут рабочий код. Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты. |
#12
|
||||
|
||||
С кодом не разбирался, но то ли косяк, то ли фича такая - кнопка "Pause" меняет изображение (уменьшает).
И ещё, очень высокая контрастность. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. Последний раз редактировалось angvelem, 13.01.2013 в 01:24. |
#13
|
||||
|
||||
angvelem, ты спишь когда-нить?
Некоторые программисты настолько ленивы, что сразу пишут рабочий код. Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты. |
#14
|
||||
|
||||
[offtop]
Угу, днём. [/offtop] Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#15
|
|||
|
|||
Цитата:
Что такое троллинг? Я могу вкладывать проект, но сам когда вижу код, то просто его читаю и делаю ^C, ^V, а если вижу вложение, то как правило ленюсь туда лезть (точнее, идёшь на какой-нибудь сайт за информацией, а тебе рекламу с порнушкой кидают). |