PureBasic

Forums PureBasic
Nous sommes le Dim 21/Juil/2019 20:23

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 19 messages ]  Aller à la page Précédente  1, 2
Auteur Message
 Sujet du message: Re: [Résolus] Comment activer et désactiver ça webcam ?
MessagePosté: Dim 13/Mai/2018 20:52 
Hors ligne

Inscription: Mer 04/Nov/2015 17:39
Messages: 1016
celtic88 c'est du russe !!!
Je ne parle pas ruse, et moi arrive pas à lancer ste machin !

_________________
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.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Comment activer et désactiver ça webcam ?
MessagePosté: Dim 13/Mai/2018 20:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 12/Sep/2015 14:31
Messages: 310
Localisation: Alger
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
:D

_________________
.....i Love Pb :)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: [Résolus] Comment activer et désactiver ça webcam ?
MessagePosté: Dim 13/Mai/2018 20:54 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 12/Sep/2015 14:31
Messages: 310
Localisation: Alger
Shadow a écrit:
celtic88 c'est du russe !!!
Je ne parle pas ruse, et moi arrive pas à lancer ste machin !


mais tu parle purebasic?

voilla le code:
Code:
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 :)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: [Résolus] Comment activer et désactiver ça webcam ?
MessagePosté: Dim 13/Mai/2018 21:31 
Hors ligne

Inscription: Mer 04/Nov/2015 17:39
Messages: 1016
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 !

_________________
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.


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 19 messages ]  Aller à la page Précédente  1, 2

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye