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.


    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


    #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"

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

    calldll #webcam, "CameraOff", hRet as ulong, result as void
    close   #main
    close   #webcam
    close   #atl