Time Lapse Display or Animation Creation.
THe GUI shown here allows you to save a new image whenever you click a button, which works well if you are creating Aardman-type plasticine animations. This is easily changed to 'after a preset time' if you want to create time-lapse. A nice one is to point your webcam out the window and capture the daylight view every 15 minutes of daylight...
This image was assembled from a series of stills, using v4w_e.bas and LBCam.dll. Thanks to snoopy11, Alyce Watson, Stefan Pendl and others. And Carl Gundel, author of LB!
To use the code you need a copy of LBCam.dll, & have installed ImageMagick. See my relevant webpages, or search on the LB Forum!
Note, the version given here does not delete the individual images. I usually run it so it saves to RAMdisk, which is emptied automatically whaen I close down. Easily changed. I should also really change weach stored 'still' to a gif, since storing as bmp's is wildly extravagant on space. Another easy change..
' ***************************************************************************
' v4w_e.bas JohnF tenochtitlanuk Nov 13 2011
' ***************************************************************************
' Display live webcam in lefthand; on demand copy to righthand..
' On demand, create a gif animation of the saved frames...
' ... and display in web browser.
nomainwin
UpperLeftX = 20
UpperLeftY = 20
WindowWidth = 850
WindowHeight = 360
graphicbox #main.gb1, 40, 60, 320, 210
graphicbox #main.gb3, 460, 40, 350, 250
button #main.b0, "Quit", [quit], LR, 430, 70
button #main.b1, ">--Save-->", [SaveStatic], LR, 452, 150
button #main.b2, "Animate", [Animate], LR, 437, 115
groupbox #main.gb, "Webcam views", 25, 10, 810, 295
struct Rect, leftX as long, upperY as long, rightX as long, lowerY as long
open "LBCam.dll" for dll as #webcam
open "v4w Webcam sequence capture software" for window_nf as #main
#main "trapclose [quit]"
open "atl" for dll as #atl
calldll #atl, "AtlAxWinInit", Ret as void
hBox = hWnd( #main.gb3)
hMain = hWnd( #main)
edition = 1
calldll #user32, "GetWindowLongA", hBox as ulong, _GWL_HINSTANCE as ulong, hInst as ulong
calldll #user32, "GetClientRect", hMain as ulong, Rect as struct, r as ulong
cw = Rect.rightX.struct
ch = Rect.lowerY.struct
#main.gb1 "place 1 1 ; color black ; size 4 ; down ; boxfilled 320 210 ; flush"
#main.gb3 "down ; fill black ; color red ; backcolor black ; flush"
left = 40 'x coordinate inside main window of camera live display
top = 60 'y coordinate inside main window
right = 320 'size of cam window
bottom = 210 'size of cam window
calldll #webcam, "CameraConnect", hMain as ulong, left as long, top as long, right as long, bottom as long, hRet as ulong
calldll #webcam, "CameraShow", hRet as ulong, result as void
wait
[SaveStatic]
#main.gb1 "getbmp scr 0 0 319 209"
#main.gb3 "drawbmp scr 14 15"
#main.gb3 "flush"
#main.gb3 "getbmp scr 0 0 349 249"
name$ ="Screen" +str$( edition) +".bmp"
bmpsave "scr", name$
edition =edition +1
#main.gb3 "place 90 242"
#main.gb3 "\"; time$(); " "; name$
unloadbmp "scr"
wait
[Animate]
im$ =""
for j =1 to edition
im$ =im$ +"Screen" +str$( j) +".bmp "
next j
command$ ="convert -delay 100 -dispose None "; im$; " -loop 0 timelapse.gif"
call RunWait "cmd.exe", "/c "; command$, ""
address$ ="TimeLapse.html"
run "explorer.exe "; address$
goto [quit]
sub IM command$, delay
run "cmd.exe /c "; chr$( 34); command$; chr$( 34), HIDE
calldll #kernel32, "Sleep", delay as long, re as void
end sub
sub RunWait file$, para$, dir$
' sub to open an application or file
'
' Usage:
' call RunWait {filename}, {parameters}, {startfolder}
'
' filename ...... full path to file or executable
' parameters .... if file is a document this should be empty
' if file is an executable any parameters
' that should be passed to it
' startfolder ... initial folder, can be empty
SEE.MASK.NOCLOSEPROCESS = hexdec("40")
SEE.MASK.FLAG.DDEWAIT = hexdec("100")
' http://msdn.microsoft.com/en-us/library/bb759784(VS.85).aspx
struct ExecInfo, _
Size as ulong, _
fMask as ulong, _
hwnd as ulong, _
Verb$ as ptr, _
File$ as ptr, _
Parameters$ as ptr, _
Directory$ as ptr, _
Show as long, _
InstApp as ulong, _
IDList as ulong, _
Class$ as ptr, _
keyClass as ulong, _
HotKey as ulong, _
Icon as ulong, _
Process as ulong
ExecInfo.fMask.struct = SEE.MASK.NOCLOSEPROCESS or SEE.MASK.FLAG.DDEWAIT
ExecInfo.File$.struct = file$ + chr$(0)
ExecInfo.Parameters$.struct = para$ + chr$(0)
ExecInfo.Directory$.struct = dir$ + chr$(0)
ExecInfo.Show.struct = _SW_SHOWNORMAL
ExecInfo.Size.struct = len(ExecInfo.struct)
' http://msdn.microsoft.com/en-us/library/bb762154(VS.85).aspx
calldll #shell32, "ShellExecuteExA", _
ExecInfo as struct, _
result as long
if result then
Handle = ExecInfo.Process.struct
Milliseconds = _INFINITE
' http://msdn.microsoft.com/en-us/library/ms687032(VS.85).aspx
calldll #kernel32, "WaitForSingleObject", _
Handle as ulong, _
Milliseconds as ulong, _
result as ulong
end if
end sub
[quit]
calldll #webcam, "CameraOff", hRet as ulong, result as void
close #main
close #webcam
close #atl
end