celtic88 c'est du russe !!!
Je ne parle pas ruse, et moi arrive pas à lancer ste machin !
[Résolus] Comment activer et désactiver sa webcam ?
Re: [Résolus] Comment activer et désactiver ça webcam ?
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.
PureBasic: 5.60 x64 Bits.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.
PureBasic: 5.60 x64 Bits.
Re: Comment activer et désactiver ça webcam ?
Shadow a écrit :...
Juste, on peut pas désactiver la LED de la Cam par du code ?
pour ça il faut tout d'abord apprendre le c ou l'ASM jusqu'à que t'arrive à un niveau expert[/u] .ensuite, tu dois pour chaque webcam créé son driver
,.... Bonne chance
.....i Love Pb 
Re: [Résolus] Comment activer et désactiver ça webcam ?
mais tu parle purebasic?Shadow a écrit :celtic88 c'est du russe !!!
Je ne parle pas ruse, et moi arrive pas à lancer ste machin !
voilla le code:
Code : Tout sélectionner
Structure GdiplusStartupInput
GdiPlusVersion.l
*DebugEventCallback.DebugEventProc
SuppressBackgroundThread.l
SuppressExternalCodecs.l
EndStructure
;- CodecInfo\MimeType
#Jpeg_Encoder = "image/jpeg"
;#Gif_Encoder = "image/gif"
;#Bmp_Encoder = "image/bmp"
;#Png_Encoder = "image/png"
;#Tif_Encoder = "image/tiff"
Structure ImageCodecInfo
clsid.CLSID
formatID.GUID
*codecName
*dllName
*formatDescription
*filenameExtension
*mimeType
flags.l
version.l
sigCount.l
sigSize.l
*sigPattern;.byte
*sigMask ;.byte
EndStructure
Procedure GetEncoderClsid(format$, *Clsid.CLSID)
Protected number, Size , *pImageCodecInfo.ImageCodecInfo
Protected i, *memory
CallFunction(1,"GdipGetImageEncodersSize",@number, @Size)
If Size = 0
ProcedureReturn -1
EndIf
*memory = AllocateMemory(Size)
If *memory = #Null
ProcedureReturn -1
EndIf
*pImageCodecInfo = *memory
CallFunction(1,"GdipGetImageEncoders",number, Size, *pImageCodecInfo)
For i = 1 To number
If format$ = PeekS(*pImageCodecInfo\MimeType, -1, #PB_Unicode)
CopyMemory(*pImageCodecInfo\clsid, *Clsid, SizeOf(CLSID))
FreeMemory(*memory)
ProcedureReturn i
EndIf
*pImageCodecInfo + SizeOf(ImageCodecInfo)
Next
FreeMemory(*memory)
ProcedureReturn -1
EndProcedure
Procedure StringToBStr (string$) ; By Zapman Inspired by Fr34k
Protected Unicode$ = Space(Len(String$)* 2 + 2)
Protected bstr_string.l
PokeS(@Unicode$, String$, -1, #PB_Unicode)
bstr_string = SysAllocString_(@Unicode$)
ProcedureReturn bstr_string
EndProcedure
Procedure SaveImgJPG(sFile$, hBmp) ;полное имя файла
Protected res=1 ;ошибка
;Gdiplus_New(version = 1, *hEventCB = #Null, Codecs = #False, bgThread = #False)
OpenLibrary(1, "gdiplus.dll")
Protected *token=0, input.GdiplusStartupInput, *image=0, encoderCLSID.GUID
With input
\GdiPlusVersion = 1
\DebugEventCallback = #Null
\SuppressExternalCodecs = #False
\SuppressBackgroundThread = #False
EndWith
If CallFunction(1, "GdiplusStartup", @*token, @input, #Null)=0 ;: Debug "startup ok"
If CallFunction(1,"GdipCreateBitmapFromHBITMAP", hBmp, $00FFFFFF, @*Image) = 0 ;: Debug "image created"
If GetEncoderClsid(#Jpeg_Encoder, @encoderCLSID) <> -1 ;: Debug "CLSID ok"
Protected BSTRsFile=StringToBStr(sFile$)
res = CallFunction(1,"GdipSaveImageToFile",*Image, BSTRsFile, @encoderCLSID, 0) ;все, если там будет не ноль, то оно вернется в res
;Debug res
SysFreeString_(BSTRsFile) ; !!! освобождаем память
EndIf
EndIf
EndIf
If *image : CallFunction(1,"GdipDisposeImage", *image):*image=0 : EndIf
If *token : CallFunction(1,"GdiplusShutdown",*token):*token=0 : EndIf
CloseLibrary(1) : ProcedureReturn res
EndProcedure
Macro DefineGUID(IID, Data1, Data2, Data3, Data4, Data5, Data6, Data7, Data8, Data9, Data10, Data11)
DataSection
IID:
Data.l Data1
Data.w Data2, Data3
Data.b Data4, Data5, Data6, Data7, Data8, Data9, Data10, Data11
EndDataSection
EndMacro
Macro DefineGUIDStruct(STRUCT, GUID)
STRUCT\Data1=PeekL(?GUID)
STRUCT\Data2=PeekW(?GUID+4)
STRUCT\Data3=PeekW(?GUID+6)
For idx=0 To 7
STRUCT\Data4[idx]=PeekB(?GUID+8+idx)
Next
EndMacro
#CLSCTX_INPROC_SERVER = 1
DefineGUID(CLSID_SystemDeviceEnum, $62BE5D10, $60EB, $11D0, $BD, $3B, $00, $A0, $C9, $11, $CE, $86)
DefineGUID(IID_ICreateDevEnum, $29840822, $5B84, $11D0, $BD, $3B, $00, $A0, $C9, $11, $CE, $86)
DefineGUID(CLSID_VideoInputDeviceCategory,$860BB310,$5D01,$11D0,$BD,$3B,$00,$A0,$C9,$11,$CE,$86);
DefineGUID(IID_IPropertyBag,$55272A00,$42CB,$11CE,$81,$35,$00,$AA,$00,$4B,$B8,$51)
DefineGUID(CLSID_FilterGraph,$E436EBB3,$524F,$11CE,$9F,$53,$00,$20,$AF,$0B,$A7,$70);
DefineGUID(IID_IGraphBuilder,$56A868A9,$0AD4,$11CE,$B0,$3A,$00,$20,$AF,$0B,$A7,$70);
DefineGUID(CLSID_SampleGrabber,$C1F400A0,$3F08,$11D3,$9F,$0B,$00,$60,$08,$03,$9E,$37);
DefineGUID(IID_IBaseFilter,$56A86895,$0AD4,$11CE,$B0,$3A,$00,$20,$AF,$0B,$A7,$70) ;
DefineGUID(CLSID_CaptureGraphBuilder2,$BF87B6E1,$8C27,$11d0,$B3,$F0,$00,$AA,$00,$37,$61,$C5);
DefineGUID(IID_ICaptureGraphBuilder2,$93E5A4E0,$2D50,$11d2,$AB,$FA,$00,$A0,$C9,$C6,$E3,$8D) ;
DefineGUID(IID_ISampleGrabber,$6B652FFF,$11FE,$4FCE,$92,$AD,$02,$66,$B5,$D7,$C7,$8F) ;
DefineGUID(PIN_CATEGORY_PREVIEW,$FB6C4282,$0353,$11D1,$90,$5F,$00,$00,$C0,$CC,$16,$BA) ;
DefineGUID(IID_IVideoWindow,$56A868B4,$0AD4,$11CE,$B0,$3A,$00,$20,$AF,$0B,$A7,$70) ;
DefineGUID(IID_IMediaControl,$56A868B1,$0AD4,$11CE,$B0,$3A,$00,$20,$AF,$0B,$A7,$70) ;
DefineGUID(MEDIATYPE_Video,$73646976,$0000,$0010,$80,$00,$00,$AA,$00,$38,$9B,$71) ;
DefineGUID(MEDIASUBTYPE_RGB24,$E436EB7D,$524F,$11CE,$9F,$53,$00,$20,$AF,$0B,$A7,$70) ;
DefineGUID(FORMAT_VideoInfo,$05589F80,$C356,$11CE,$BF,$01,$00,$AA,$00,$55,$59,$5A) ;
DeviceName.VARIANT;
PropertyName.IPropertyBag;
pDevEnum.ICreateDEvEnum ;
pEnum.IEnumMoniker ;
pMoniker.IMoniker ;
;//Список моникеров, из которго мы потом будем получать необходмый ;MArray1: Array of IMoniker;
;//интерфейсы
FGraphBuilder.IGraphBuilder;
FCaptureGraphBuilder.ICaptureGraphBuilder2;
FMux.IBaseFilter ;
FSink.IFileSinkFilter ;
FMediaControl.IMediaControl ;
FVideoWindow.IVideoWindow ;
FVideoCaptureFilter.IBaseFilter ;
FAudioCaptureFilter.IBaseFilter ;
;//область вывода изображения ;FVideoRect.RECT;: TRect;
FBaseFilter.IBaseFilter ;
Global FSampleGrabber.ISampleGrabber ;
Structure AM_MEDIA_TYPE ;
majortype.GUID ;: TGUID;
subtype.GUID ;: TGUID;
bFixedSizeSamples.l ;: BOOL; - 4 байта в Delphi! (BOOL = LongBOOL)
bTemporalCompression.l ;: BOOL;
lSampleSize.l ;: ULONG;
formattype.GUID ;: TGUID;
pUnk.IUnknown ;: IUnknown;
cbFormat.l ;: ULONG;
pbFormat.l ;: Pointer;
EndStructure ;
Structure VIDEOINFOHEADER
rcSource.RECT; // The bit we really want to use
rcTarget.RECT; // Where the video should go
dwBitRate.l ;: DWORD; // Approximate bit data rate
dwBitErrorRate.l ;: DWORD; // Bit error rate for this stream
AvgTimePerFrame.q;: TReferenceTime = LONGLONG = Int64; // Average time per frame (100ns units)
bmiHeader.BITMAPINFOHEADER;
EndStructure
Procedure.l CaptureBitmap() ;: HBitmap; stdcall; //HResult;
Protected bSize.l ;: integer;
Protected *pVideoHeader.VIDEOINFOHEADER
Protected MediaType.AM_MEDIA_TYPE
Protected MyBitmapInfo.BITMAPINFO ;: TBitmapInfo;
Protected *Buffer ;: Pointer;
;Protected Dim tmp.b(0) ;: Array of byte;
Protected BMP.l ;:HBitmap;
Debug "Capturing..."
BMP=0; Result:=0; //Result := E_FAIL ;// Результат по умолчанию
If FSampleGrabber = #Null ;// Если отсутствует интерфейс фильтра перехвата изображения, то завершаем работу
ProcedureReturn 0
EndIf
Result = FSampleGrabber\GetCurrentBuffer(@bSize, #Null) ;// Получаем размер кадра
If (bSize <= 0) Or (Result<>#S_OK)
ProcedureReturn 0
EndIf
Debug "Buffer size is "+Str(bSize)
;// Получаем тип медиа потока на входе у фильтра перехвата
;ZeroMemory(@MediaType, SizeOf(TAMMediaType));
Result=FSampleGrabber\GetConnectedMediaType(MediaType)
If Result<>#S_OK
ProcedureReturn 0
EndIf
;// Копируем заголовок изображения
*pVideoHeader=MediaType\pbFormat ;Debug *pVideoHeader
Debug "Copying bmi header..."
CopyMemory(*pVideoHeader\bmiHeader, MyBitmapInfo\bmiHeader, SizeOf(BITMAPINFOHEADER));
*tmp=AllocateMemory(bSize) ;: Debug *Buffer
;// Выделяем память во временном массиве
;ReDim tmp(bSize);;SetLength(tmp, bSize);
;// Читаем изображение из медиа потока во временный буфер
Result=FSampleGrabber\GetCurrentBuffer(@bSize, *tmp) ;
If (bSize <= 0) Or (Result<>#S_OK)
ProcedureReturn 0
EndIf ;Debug "Buffer was read again, size: "+Str(bSize)
*Buffer = #Null
;// Создаем побитовое изображение
BMP=CreateDIBSection_(0, MyBitmapInfo, #DIB_RGB_COLORS, @*Buffer, 0, 0);
If BMP=0
Debug "DIB create error!" : FreeMemory(*tmp) : ProcedureReturn 0
EndIf
CopyMemory(*tmp, *Buffer, MediaType\lSampleSize)
GdiFlush_() : FreeMemory(*tmp)
ProcedureReturn BMP
EndProcedure;
CoInitialize_(#Null);// инициализировать OLE COM
OpenWindow(0, 0, 0, 320, 380, "pbwebcam - Video Preview", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
PanelGadget(0,0,0,320,240) : CloseGadgetList()
ButtonGadget(1, 115, 300, 100, 20, "CAP")
;CreateImage(0,640,480) : ImageGadget(123,250,300,50,40,ImageID(0))
;//Создаем объект для перечисления устройств
Result=CoCreateInstance_(?CLSID_SystemDeviceEnum, #Null, #CLSCTX_INPROC_SERVER, ?IID_ICreateDevEnum, @pDevEnum);
If Result<>#S_OK : End : EndIf
;//Перечислитель устройств Video
Result=pDevEnum\CreateClassEnumerator(?CLSID_VideoInputDeviceCategory, @pEnum, 0);
If Result<>#S_OK : End : EndIf
;setlength(MArray1,0);//Обнуляем массив в списке моникеров
;//Пускаем массив по списку устройств
While pEnum\Next(1,@pMoniker,#Null)=#S_OK
Debug "VideoDevice found:"
;setlength(MArray1,length(MArray1)+1); //Увеличиваем массив на единицу
;MArray1[length(MArray1)-1]:=pMoniker; //Запоминаем моникер в масиве
;//Линкуем моникер устройства к формату хранения IPropertyBag
Result=pMoniker\BindToStorage(#Null, #Null, ?IID_IPropertyBag, @PropertyName)
;If FAILED(Result) then Continue; - не нашел нигде, что это есть такое
If Result<>#S_OK : Debug "Can't query device" : Continue : EndIf
b.s = Space(255)
PokeS(@b,"FriendlyName",-1,#PB_Unicode)
Result=PropertyName\Read(@b, @DeviceName, #Null); //Получаем имя устройства
;Debug Result
If Result<>#S_OK : Debug "Can't get device name" : Continue : EndIf
Debug PeekS(DeviceName\bstrVal,-1,#PB_Unicode)
;//Listbox1.Items.Add(DeviceName); //Добавляем имя устройства в списки
PropertyName\Release()
pMoniker\Release()
Wend
pEnum\Reset()
;============= Процедура поиска завершена. Будем работать с последним найденным девайсом.
;//Создаем объект для графа фильтров
Result=CoCreateInstance_(?CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, ?IID_IGraphBuilder, @FGraphBuilder);
;// Создаем объект для граббинга
Result=CoCreateInstance_(?CLSID_SampleGrabber, #Null, #CLSCTX_INPROC_SERVER, ?IID_IBaseFilter, @FBaseFilter) ;
;//Создаем объект для графа захвата
Result=CoCreateInstance_(?CLSID_CaptureGraphBuilder2, #Null, #CLSCTX_INPROC_SERVER, ?IID_ICaptureGraphBuilder2, @FCaptureGraphBuilder);
b.s = Space(255)
PokeS(@b,"GRABBER",-1,#PB_Unicode)
Result=FGraphBuilder\AddFilter(FBaseFilter, @b); // Добавляем фильтр в граф
;// Получаем интерфейс фильтра перехвата
Result=FBaseFilter\QueryInterface(?IID_ISampleGrabber, @FSampleGrabber);
If FSampleGrabber <> #Null
Debug "Filter is ok"
MediaType.AM_MEDIA_TYPE
With MediaType
DefineGUIDStruct(\majortype, MEDIATYPE_Video) ; - а есть ли лучший способ заполнить поля???
DefineGUIDStruct(\subtype, MEDIASUBTYPE_RGB24)
DefineGUIDStruct(\formattype, FORMAT_VideoInfo)
EndWith;
FSampleGrabber\SetMediaType(MediaType);// Данные будут записаны в буфер в том виде, в котором они проходят через фильтр
FSampleGrabber\SetBufferSamples(#True);// Граф не будет остановлен для получения кадра
FSampleGrabber\SetOneShot(#False) ;
EndIf ;
Debug "Setting filter graph"
Result=FCaptureGraphBuilder\SetFiltergraph(FGraphBuilder); //Задаем граф фильтров
Debug Result
; ===============================================================
;//получаем устройство для захвата видео из списка моникеров (берем последнее)
; FVideoCaptureFilter);
Debug "Binding to object"
Result=pMoniker\BindToObject(#Null, #Null, ?IID_IBaseFilter, @FVideoCaptureFilter);
;//добавляем устройство в граф фильтров
b.s = Space(255)
PokeS(@b,"VideoCaptureFilter",-1,#PB_Unicode)
Debug "Adding filter"
Result=FGraphBuilder\AddFilter(FVideoCaptureFilter, @b); //Получаем фильтр графа захвата
;//Задаем, что откуда будем получать и куда оно должно выводиться
Debug "Rendering stream"
Result=FCaptureGraphBuilder\RenderStream(?PIN_CATEGORY_PREVIEW, #Null, FVideoCaptureFilter, FBaseFilter, #Null)
;//Получаем интерфейс управления окном видео
Result=FGraphBuilder\QueryInterface(?IID_IVideoWindow, @FVideoWindow);
;//Задаем размеры окна во всю панель
wnd=GadgetID(0)
GetWindowRect_(wnd, FVideoRect.RECT);wndrect.RECT);
;CopyMemory(@wndrect,@FVideoRect,SizeOf(RECT)); //Panel1.ClientRect;
;Вот так было в Delphi, но здесь так не пашет, окно куда-то "уходит" или становится слишком маленьким?
;FVideoWindow\SetWindowPosition(FVideoRect\Left,FVideoRect\Top, FVideoRect\Right - FVideoRect\Left,FVideoRect\Bottom - FVideoRect\Top);
FVideoWindow\SetWindowPosition(0,0, FVideoRect\Right - FVideoRect\Left,FVideoRect\Bottom - FVideoRect\Top);
;//Накладываем окно вывода на Panel1
FVideoWindow\put_Owner(wnd) ; //(Panel1.Handle);
;//Задаем стиль окна вывода
FVideoWindow\put_WindowStyle(#WS_CHILD | #WS_CLIPSIBLINGS) ;
FVideoWindow\put_Visible(#True) ; //показываем окно
;//Запрашиваем интерфейс управления графом
Result=FGraphBuilder\QueryInterface(?IID_IMediaControl, @FMediaControl) ;
Result=FMediaControl\Run() ; //Запускаем отображение просмотра с вебкамеры
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
EventGadget = EventGadget()
If EventGadget = 1
hBitmap=CaptureBitmap() ;: Debug hBitmap
If hBitmap
If SaveImgJPG("shot.jpg", HBitmap)
MessageBox_(WindowID(0),"Невозможно сохранить в jpg!","Error",#MB_ICONERROR)
EndIf
DeleteObject_(hBitmap) : RunProgram("shot.jpg")
Else : MessageBox_(WindowID(0),"Невозможно захватить кадр!","Error",#MB_ICONERROR)
EndIf
EndIf
EndSelect
Until Event = #PB_Event_CloseWindow
FMediaControl\Stop() : FMediaControl\Release()
CoUninitialize_()
.....i Love Pb
Re: [Résolus] Comment activer et désactiver ça webcam ?
Oh jolie ce code
190, marche pas si je fais une capture, problème mémoire, peut être lier à 64 bits ?
Plus qua traduire ce super code !
190, marche pas si je fais une capture, problème mémoire, peut être lier à 64 bits ?
Plus qua traduire ce super code !
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.
PureBasic: 5.60 x64 Bits.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.
PureBasic: 5.60 x64 Bits.