Code : Tout sélectionner
; code original de je sais plus qui
; modifié par Dobro
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
