WebCamCapture

Share your advanced PureBasic knowledge/code with the community.
infratec
Always Here
Always Here
Posts: 7591
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

WebCamCapture

Post by infratec »

Hi together,

since I had to check and to store pictures of a person who want to greet me in front of a webcam, I wrote a small program for this:

Code: Select all

;
; WebCamCapture (c) by BKK
;
; V1.00 initial release
; V1.01 do picture stuff only when get was successfull
; V1.02 now with commandlineparameters
;       http:// is not longer neccessary
; V1.03 if the first receive fails, give a hint to check the URL
;       now also a negative next scan time is avoided

#VERSION = "V1.03"

#CRLF = Chr(13) + Chr(10)


Procedure Usage()
 Text$ = "WebCamCapture " + #VERSION + #CRLF
 Text$ + #CRLF
 Text$ + "usage: WebCamCapture [-u url][-i interval][-d directory]"
 MessageRequester("WebCamCapture", Text$)
EndProcedure




UseJPEGImageDecoder()

If InitNetwork()

 OpenWindow(0, 0, 0, 660, 590, "WebCamCapture " + #VERSION, #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
 
 TextGadget(0, 10, 13, 35, 20, "http://")
 StringGadget(1, 45, 10, 400, 20, "")
 
 TextGadget(2, 525, 13, 40, 20, "Interval:")
 StringGadget(3, 570, 10, 50, 20, "60", #PB_String_Numeric)
 TextGadget(4, 625, 13, 20, 20, "sec.")
 
 ButtonGadget(5, 10, 40, 50, 20, "Start")
 
 ImageGadget(6, 10, 100, 640, 480, 0, #PB_Image_Border)
 
 TextGadget(7, 80, 43 , 110, 20, "")
 
 ButtonGadget(8, 200, 40, 100, 20, "Directory")
 TextGadget(9, 320, 40, 330, 20, GetCurrentDirectory(), #PB_Text_Border)
 
 For i = 0 To CountProgramParameters() - 1
  If ProgramParameter(i) = "-u"
   i + 1
   SetGadgetText(1, ProgramParameter(i))
  ElseIf ProgramParameter(i) = "-d"
   i + 1
   If Right(ProgramParameter(i), 1) <> "\"
    SetGadgetText(9, ProgramParameter(i) + "\")
   Else
    SetGadgetText(9, ProgramParameter(i))
   EndIf
  ElseIf ProgramParameter(i) = "-i"
   i + 1
   SetGadgetText(3, ProgramParameter(i))
  Else
   Usage()
  EndIf
 Next i
 
 If Len(GetGadgetText(1)) = 0 Or Len(GetGadgetText(3)) = 0
  DisableGadget(5, 1)
 EndIf
 
 Exit = #False
 
 Repeat
 
  Event = WaitWindowEvent(100)
 
 
  If Event = #PB_Event_Gadget
   
   Select EventGadget()
   
    Case 1, 3
     If Len(GetGadgetText(1)) And Len(GetGadgetText(3))
      DisableGadget(5, 0)
     Else
      DisableGadget(5, 1)
     EndIf
     
    Case 5
     If GetGadgetText(5) = "Start"
      StartTime = 1
      SetGadgetText(5, "Stop")
     Else
      StartTime = 0
      SetGadgetText(5, "Start")
      SetGadgetText(7, "")
     EndIf
     
    Case 8
     Path$ = PathRequester("", GetGadgetText(9))
     If Path$
      SetGadgetText(9, Path$)
     EndIf

   EndSelect
  Else
   If Event = #PB_Event_CloseWindow : Exit = #True : EndIf
  EndIf
 
  If StartTime
   If ElapsedMilliseconds() - StartTime >= Val(GetGadgetText(3)) * 1000
    Filename$ = GetGadgetText(9) + "WebCamCapture_" + FormatDate("%yyyy.%mm.%dd_%hh-%ii-%ss", Date()) + ".jpg"
    URL$ = GetGadgetText(1)
    If FindString(URL$, "http://", 1) = 0
     URL$ = "http://" + URL$
    EndIf
    If ReceiveHTTPFile(URL$, Filename$)
     If IsImage(0) : FreeImage(0) : EndIf
     LoadImage(0, Filename$, #PB_Image_DisplayFormat)
     If ImageWidth(0) > 640 Or ImageHeight(0) > 480
      ResizeImage(0, 640, 480)
     EndIf
     SetGadgetState(6, ImageID(0))
     StartTime = ElapsedMilliseconds()
    Else
     If StartTime = 1
      StartTime = ElapsedMilliseconds()
      MessageRequester("WebCamCapture", "Receive error! Please check the URL.")
     EndIf
    EndIf
   EndIf
   
   SetGadgetText(7, "next capture in " + Str(Val(GetGadgetText(3)) - ((ElapsedMilliseconds() - StartTime) / 1000)) + " sec.")
   
  EndIf
 
 Until Exit
 
Else
 MessageRequester("WebCamCapture", "Can not init network!")
EndIf
Maybe it is also useful for someone else.

Best regards,

Bernd
Last edited by infratec on Tue Jul 28, 2009 8:50 am, edited 6 times in total.
infratec
Always Here
Always Here
Posts: 7591
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Post by infratec »

A new version.

Since the webcam failed from time to time, I do the picture stuff now
only when the receive was ok.

Bernd
infratec
Always Here
Always Here
Posts: 7591
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Post by infratec »

Now you can use commandline parameters,
'http://' in the URL field is not longer neccessary.

Bernd
infratec
Always Here
Always Here
Posts: 7591
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Post by infratec »

Hm,

since this topic have some readers, I think it make sense to update the software.

Now V1.03 is out.

I noticed that when the URL is wrong, this results in a negative value for the next capture time.

This is fixed now, and a hint appears to check the URL.

Bernd
Post Reply