; Acquérire une photo grace à une WebCam ou autre périphérique d'acquisition

; code original de je sais plus qui
; modifié par Dobro

; Pour pouvoir choisir la source d'acquisition, décommenter la partie lignes 62-65

UseJPEGImageEncoder()
UseJPEGImageDecoder()
Enumeration
 
  #Window_0
  #Button_capture
  #Button_quit
  #Button_affiche
  #Button_4
  #viewer1
  #gadget1
  #counter
  #counter1
  #name
  #takebut
  #viewbut
  #quitbut
EndEnumeration

Dim snapshot.l(50)
Global  saver$
i = 1
If OpenWindow(#Window_0, 100, 100, 408, 338, "Little Camera", #PB_Window_SystemMenu |  #PB_Window_MinimizeGadget     )
  If CreateGadgetList(WindowID(#Window_0))
    ButtonGadget(#Button_capture, 150, 280, 50, 25, "Capture")
    ButtonGadget(#Button_quit, 250, 280, 50, 25, "Quit")
    ButtonGadget(#Button_affiche, 200, 280, 50, 25, "Show")
  EndIf
EndIf
 
Global hWndC.l
Global snapshot.l
Procedure.b initcam()
  pcvs.b = 0
  CreateImage(0, 400, 400)
  #WM_CAP_START = #WM_USER
  #WM_CAP_DRIVER_CONNECT = #WM_CAP_START + 10
  #WM_CAP_DRIVER_DISCONNECT = #WM_CAP_START + 11
  #WM_CAP_DRIVER_GET_CAPS = #WM_CAP_START + 14
  #WM_CAP_EDIT_COPY = #WM_CAP_START + 30
  #WM_CAP_SET_PREVIEW = #WM_CAP_START + 50
  #WM_CAP_SET_PREVIEWRATE = #WM_CAP_START + 52
  #WM_CAP_STOP = #WM_CAP_START + 68
  #WM_CAP_SET_SCALE = #WM_CAP_START + 53
  If OpenLibrary(0, "avicap32.dll")
    *capAddress = GetFunction(0, "capCreateCaptureWindowA")
    hWndC = CallFunctionFast(*capAddress, "My Capture Window", #WS_CHILD | #WS_VISIBLE, 50, 38, 310, 230, WindowID(0), 0)
   
    SendMessage_(hWndC, #WM_CAP_DRIVER_CONNECT, 0, 0)
    SendMessage_(hWndC, #WM_CAP_SET_PREVIEW, #True, 0)
    SendMessage_(hWndC, #WM_CAP_SET_PREVIEWRATE, 1, 0)
    SendMessage_(hWndC, #WM_CAP_SET_SCALE, #True, 0)
    pcvs = 1
    ; ;............................................(pour afficher l'option)
    ; #WM_CAP_START = #WM_USER
    ; #WM_CAP_DLG_VIDEOSOURCE = #WM_CAP_START + 42
    ; ;............................................
    ; SendMessage_(hWndC, #WM_CAP_DLG_VIDEOSOURCE, 0, 0)
  EndIf
  ProcedureReturn pcvs
EndProcedure
Procedure.b capcam()
  pcvs.b = 0
  SendMessage_(hWndC, #WM_CAP_EDIT_COPY, 0, 0)
  snapshot = GetClipboardImage(#PB_Any)
  If snapshot
    saver$ = "snapshot.jpg"
    SaveImage(snapshot, saver$, #PB_ImagePlugin_JPEG, 10)
    ; FreeImage(snapshot)
    pcvs = 1
  EndIf
  ProcedureReturn pcvs
EndProcedure
Procedure destroycam()
  SendMessage_(hWndC, #WM_CAP_STOP, 0, 0)
  SendMessage_(hWndC, #WM_CAP_DRIVER_DISCONNECT, 0, 0)
  DestroyWindow_(hWndC)
  CloseLibrary(0)
EndProcedure
initcam()

 ; HideWindow(0,1)
Repeat
  Event = WaitWindowEvent(10)
 
  Select Event
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button_capture
          capcam()
        Case #Button_quit
          SendMessage_(hWndC, #WM_CAP_STOP, 0, 0)
          SendMessage_(hWndC, #WM_CAP_DRIVER_DISCONNECT, 0, 0)
          DestroyWindow_(hWndC)
          CloseLibrary(0)
          End
        Case #Button_affiche
          If OpenWindow(#viewer1, 10, 10, 340, 270, "ImageGadget", #PB_Window_ScreenCentered|#PB_Window_BorderLess    )
            StickyWindow(#viewer1, 1)
            If CreateGadgetList((WindowID(#viewer1)))
             
              existimage =  LoadImage(0, saver$)     ; Path/filename of the image
              If existimage
                ImageGadget(#gadget1,  10, 10, 310, 230, ImageID(0), #PB_Image_Border)                      ; imagegadget standard
              Else
                ResizeWindow(#viewer1, #PB_Ignore , #PB_Ignore , 10, 10)
               
                MessageRequester("No Image", "image doesn,t exist", #PB_MessageRequester_Ok)
                CloseWindow(#viewer1)
                Quit = 1
              EndIf
             
            EndIf
           
            Repeat
              Event2 = WaitWindowEvent()
              bugger = EventType()
              Select bugger
                Case #PB_EventType_RightClick
                  CloseWindow(#viewer1)
                  Quit = 1
                 
              EndSelect
            Until Quit = 1
          EndIf
          Quit = 0
         
      EndSelect
  EndSelect
 
 
 
Until Event = #PB_Event_CloseWindow

destroycam()

End