Webcam Pong v0.01

[madscijr]

Fixed a bug with the saturation calculation. Also, I've added the ability to adjust brightness! Use➕ or ➖ to adjust saturation and ⬆️ and ⬇️ arrows to adjust brightness. Press "R" to reset saturation and brightness.

All great tweaks! I played with it, added some screen text, changed key detection from _KeyHit to _Button which I find more responsive. 

Dropped the resolution to 320x240 which is lofi but more fluid looking & faster for processing.

Took those constraints off saturation and brightness, now they can go upto 255, and you can get it looking pretty funky with high saturation and extreme brightness. Try 22 saturation and .1 brightness! What other fx can we do? 

This is starting to be a DIY video toaster - would be cool to get it saving to AVI or animated GIFs... 

Code: (Select All)

' Webcam Pong v0.01 reply #28
' https://qb64phoenix.com/forum/showthread.php?tid=3497&page=3

' SpriggsySpriggs, Professional Noticer
' 2/28/2025 12:24 PM
' _ScreenMove _Middle appears to have a performance
' issue and doesn't actually move the window to the
' middle of the screen. So I've changed that to a
' calculated value based on
' _DesktopWidth, _DesktopHeight, VIDWIDTH, and VIDHEIGHT.
' Also, _ScreenMove _Middle did not allow me to move
' the window by grabbing the titlebar. Now, it does work.
' [url=https://qb64phoenix.com/forum/member.php?action=profile&uid=6]@SMcNeill[/url], there appears to be a bug with that function.
' Not sure how longstanding it is.

' SpriggsySpriggs, Professional Noticer
' 2/28/2025 12:24 PM
' Hey! I think that also fixed the issue of needing
' GetAsyncKeystate! Now, we don't need it!
' We can use _KeyHit instead. Sweeeeeet.
' Also, there are no more freeze ups.
' Feel free to click, drag, double-click,
' triple-click, etc. to your heart's desire.

' SpriggsySpriggs, Professional Noticer
' 2/28/2025 1:24 PM
' There was some oversight about error catching
' and handling so here is yet another version:

' SpriggsySpriggs, Professional Noticer
' 2/28/2025 1:24 PM
' Fixed another issue that [url=https://qb64phoenix.com/forum/member.php?action=profile&uid=6]@SMcNeill[/url] pointed out.
' Minimizing or tabbing away would cause a freeze
' or crash of the program. No more!

' SpriggsySpriggs, Professional Noticer
' 2/28/2025 2:24 PM
' I couldn't help myself. I have made a change that
' allows you to increase and decrease the saturation
' using the plus and minus keys on the numpad.
' I've set the limit at double the saturation.

' SpriggsySpriggs, Professional Noticer
' 2/28/2025 4:23 PM
' Fixed a bug with the saturation calculation.
' Also, I've added the ability to adjust brightness!
' Use + or - to adjust saturation
' and up and down arrows to adjust brightness.
' Press "R" to reset saturation and brightness.

Option _Explicit
'$Console
$VersionInfo:Comments=Avicap32 webcam to memory test
'Using $VersionInfo so we get modern controls
'------------------------------------------------------------------------------------------------------------------------------
'Capture Driver Constants
Const WM_CAP_START = &H0400
Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61
Const WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25
Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45
Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41
Const WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5
Const CF_DIB = &H0008

Const PM_REMOVE = &H0001
Const WS_EX_NOACTIVATE = &H08000000

Const FPS = 30 'Not recommended to set this higher than frame rate of webcam/video device

Const VIDWIDTH = 320
Const VIDHEIGHT = 240

' _BUTTON key codes
Const KeyCode_Escape = 2
Const KeyCode_Spacebar = 58
Const KeyCode_0 = 12
Const KeyCode_1 = 3
Const KeyCode_2 = 4
Const KeyCode_3 = 5
Const KeyCode_4 = 6
Const KeyCode_5 = 7
Const KeyCode_6 = 8
Const KeyCode_7 = 9
Const KeyCode_8 = 10
Const KeyCode_9 = 11
Const KeyCode_A = 31
Const KeyCode_B = 49
Const KeyCode_C = 47
Const KeyCode_D = 33
Const KeyCode_E = 19
Const KeyCode_F = 34
Const KeyCode_G = 35
Const KeyCode_H = 36
Const KeyCode_I = 24
Const KeyCode_J = 37
Const KeyCode_K = 38
Const KeyCode_L = 39
Const KeyCode_M = 51
Const KeyCode_N = 50
Const KeyCode_O = 25
Const KeyCode_P = 26
Const KeyCode_Q = 17
Const KeyCode_R = 20
Const KeyCode_S = 32
Const KeyCode_T = 21
Const KeyCode_U = 23
Const KeyCode_V = 48
Const KeyCode_W = 18
Const KeyCode_X = 46
Const KeyCode_Y = 22
Const KeyCode_Z = 45
Const KeyCode_Up = 329
Const KeyCode_Down = 337
Const KeyCode_Left = 332
Const KeyCode_Right = 334
Const KeyCode_Minus = 13
Const KeyCode_Equal = 14
Const KeyCode_BkSp = 15
Const KeyCode_Ins = 339
Const KeyCode_Del = 340
Const KeyCode_Home = 328
Const KeyCode_End = 336
Const KeyCode_PgUp = 330
Const KeyCode_PgDn = 338

' UDTs
Type BITMAPINFOHEADER
    As _Unsigned Long biSize
    As Long biWidth, biHeight
    As _Unsigned Integer biPlanes, biBitCount
    As _Unsigned Long biCompression, biSizeImage
    As Long biXPelsPerMeter, biYPelsPerMeter
    As _Unsigned Long biClrUsed, biClrImportant
End Type

Type BITMAPINFO
    As BITMAPINFOHEADER bmiHeader
End Type

Type POINT
    As Long x, y
End Type

Type MSG
    As _Offset hwnd
    As _Unsigned Long message
    $If 64BIT Then
        As String * 4 padding1
    $End If
    As _Unsigned _Offset wParam
    As _Offset lParam
    As _Unsigned Long time
    $If 64BIT Then
        As String * 4 padding2
    $End If
    As POINT pt
    As _Unsigned Long lPrivat
End Type

Declare Dynamic Library "Avicap32"
    Function CreateCaptureWindow& Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As _Offset, ByVal dwStyle As _Unsigned Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As _Offset, ByVal nId As Long)
End Declare

Declare CustomType Library
    Sub SendMessage Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
    Function SendMessage& Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
    Function PeekMessage& Alias "PeekMessageA" (ByVal lpMsg As _Offset, ByVal hWnd As _Offset, ByVal wMsgFilterMin As _Unsigned Long, ByVal wMsgFilterMax As _Unsigned Long, ByVal wRemoveMsg As _Unsigned Long)
    Sub TranslateMessage (ByVal lpMsg As _Offset)
    Sub DispatchMessage (ByVal lpMsg As _Offset)
    Sub DestroyWindow (ByVal hWnd As _Offset)
    Function mmioStringToFOURCC& (sz As String, ByVal uFlags As _Unsigned Long)
    Function OpenClipboard& (ByVal hWndNewOwner As _Offset)
    Function GetClipboardData%& (ByVal uFormat As _Unsigned Long)
    Sub CloseClipboard ()
    Function GlobalLock%& (ByVal hMem As _Offset)
    Function GlobalUnlock& (ByVal hMem As _Offset)
    Function LoadLibrary%& (lpLibFileName As String)
    Function GetProcAddress%& (ByVal hModule As _Offset, lpProcName As String)
End Declare

Declare Library ".\internal\c\c_compiler\include\vfw"
End Declare

Declare Library "framecallback"
End Declare

Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

Dim Shared As Single SATURATION_LEVEL: SATURATION_LEVEL = 1.00 '0.00 for greyscale, 1.00 for normal, and >1.00 for oversaturation
Dim Shared As Single BRIGHTNESS_LEVEL: BRIGHTNESS_LEVEL = 1.00

Screen _NewImage(VIDWIDTH, VIDHEIGHT, 32)
_Delay 0.2 'Just in case

_ScreenMove (_DesktopWidth / 2) - VIDWIDTH / 2, (_DesktopHeight / 2) - VIDHEIGHT / 2

Dim As String captureWinText: captureWinText = "Webcam API Test  - Child" + Chr$(0)
Dim As _Offset childID

Dim As _Offset childWin: childWin = CreateCaptureWindow(_Offset(captureWinText), WS_EX_NOACTIVATE, 0, 0, VIDWIDTH, VIDHEIGHT, _WindowHandle, childID)
If childWin = 0 Then
    Print "Couldn't create capture window."
    End
End If
_Title "Webcam API Test - Parent"
SetupDriver childWin, _TRUE 'change _FALSE to _TRUE to use default settings

Print "Previewing... Press Space bar to stop"
Print "Press escape to kill the window"
Dim Shared As _MEM frame
Dim As _Integer64 k
Dim As MSG msg

Dim IsReset As Integer: IsReset = _TRUE
Dim As _MEM clippedFrame
Dim imgCamera As Long
Dim imgText As Long
Dim ShowText As Integer: ShowText = _TRUE
Dim tx, ty, tc As Integer

InitImage imgText, VIDWIDTH, VIDHEIGHT, cEmpty

Do
    If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
        TranslateMessage _Offset(msg)
        DispatchMessage _Offset(msg)
    Else
        GrabFrame childWin
    End If

    'Screen frame.IMAGE
    imgCamera = frame.IMAGE
   
    While _DeviceInput(1): Wend ' clear and update the keyboard buffer
    If _Button(KeyCode_Escape) Then
        KillDriver childWin
        Exit Do
    ElseIf _Button(KeyCode_Spacebar) Then
        If ShowText = _TRUE Then ShowText = _FALSE Else ShowText = _TRUE
    ElseIf _Button(KeyCode_S) Then
        _SaveImage _
            m_ProgramPath$ + m_ProgramName$ + "." + _
            GetCurrentDateTime$("{yyyy}{mm}{dd}_{rr}{nn}{ss}") + _
            ".bmp", frame.IMAGE, "BMP"
    ElseIf _Button(KeyCode_Equal) Or _Button(KeyCode_Right) Then
        'If SATURATION_LEVEL < 2.00 Then
        If SATURATION_LEVEL <= 254.9 Then
            SATURATION_LEVEL = SATURATION_LEVEL + .10
            IsReset = _FALSE
        End If
    ElseIf _Button(KeyCode_Minus) Or _Button(KeyCode_Left) Then
        If SATURATION_LEVEL >= 0.10 Then
            SATURATION_LEVEL = SATURATION_LEVEL - .10
            IsReset = _FALSE
        End If

    ElseIf _Button(KeyCode_Up) Then
        'If BRIGHTNESS_LEVEL < 3 Then
        If BRIGHTNESS_LEVEL <= 254.9 Then
            BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL + .10
            IsReset = _FALSE
        End If

    ElseIf _Button(KeyCode_Down) Then
        If BRIGHTNESS_LEVEL >= 0.10 Then
            BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL - .10
            IsReset = _FALSE
        End If
    ElseIf _Button(KeyCode_R) Then
        BRIGHTNESS_LEVEL = 1.00
        SATURATION_LEVEL = 1.00
        IsReset = _TRUE
    End If


    ' SHOW VALUES + INSTRUCTIONS
    _Dest imgText: Cls , cEmpty
    If ShowText = _TRUE Then
        Color cRed, cGray: Locate 10, 2: Print " LEFT and RIGHT ";
        Color cRed, cLightGray: Locate 10, 18: Print "SATURATION_LEVEL: ";
        Color cRed, cWhite: Locate 10, 36: Print Left$(SngRoundedToStr$(SATURATION_LEVEL, 1) + "    ", 4);

        Color cBlue, cGray: Locate 11, 2: Print "   UP and  DOWN ";
        Color cBlue, cLightGray: Locate 11, 18: Print "BRIGHTNESS_LEVEL: ";
        Color cBlue, cWhite: Locate 11, 36: Print Left$(SngRoundedToStr$(BRIGHTNESS_LEVEL, 1) + "    ", 4);

        Color cDarkGold, cGray: Locate 12, 2: Print "              S ";
        Color cDarkGold, cLightGray: Locate 12, 18: Print "SAVE STILL FRAME  ";
        Color cDarkGold, cWhite: Locate 12, 36: Print "    ";

        'If IsReset = _FALSE Then
        Color cOrange, cGray: Locate 13, 2: Print "              R ";
        Color cOrange, cLightGray: Locate 13, 18: Print "RESET ALL VALUES  ";
        Color cOrange, cWhite: Locate 13, 36: Print "    ";
        'End If

        Color cGray, cPurple: Locate 14, 2: Print "       SPACEBAR ";
        Color cPurple, cLightGray: Locate 14, 18: Print "TOGGLE SHOW TEXT  ";
        Color cPurple, cWhite: Locate 14, 36: Print "    ";

        Color cGray, cLime: Locate 15, 2: Print "            ESC ";
        Color cGreen, cLightGray: Locate 15, 18: Print "QUIT              ";
        Color cGreen, cWhite: Locate 15, 36: Print "    ";
       
       
        tc = 1
        Color cCyan, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 1, tx + tc * 1
        Color cGreen, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 2, tx + tc * 2
        Color cDarkGold, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 3, tx + tc * 3
        Color cOrange, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 4, tx + tc * 4
        Color cRed, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 5, tx + tc * 5
        Color cMagenta, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 6, tx + tc * 6
        Color cPurple, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 7, tx + tc * 7
        Color cDeepPurple, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 8, tx + tc * 8
        Color cBlue, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 9, tx + tc * 9
        Color cDodgerBlue, cEmpty: PrintString 0, 15, "WebCam fun", ty + tc * 10, tx + tc * 10
    End If
   
    ' ADD LAYERS
    _Dest 0: _PutImage , imgCamera, 0 ' Add camera layer
    _Dest 0: _PutImage , imgText, 0 ' Add text layer

    ' CLEAR KEYBOARD BUFFER
    _KeyClear
   
    ' UPDATE SCREEN
    _Display
    _Limit FPS
Loop
_AutoDisplay ' RETURN TO AUTODISPLAY

' HOW TO SAVE STILL TO FILE:
'GrabFrameToClipboard childWin, clippedFrame
'_ClipboardImage = frame.IMAGE
'_SaveImage "myimage.bmp", frame.IMAGE, "BMP"

Print "Disconnecting Driver"
KillDriver childWin

_MemFree frame
'_MemFree clippedFrame

FreeImage imgCamera
FreeImage imgText

Sleep

' /////////////////////////////////////////////////////////////////////////////

Sub SetupDriver (hwnd As _Offset, defaultSource As _Byte)
    Dim As _Offset libload: libload = LoadLibrary(Command$(0))
    Dim As _Offset myCallback: myCallback = GetProcAddress(libload, "CapVideoCallback")
    If myCallback = 0 Then
        Print "Can't find callback pointer"
        End
    End If
    Dim As BITMAPINFO format
    SendMessage hwnd, WM_CAP_DRIVER_CONNECT, 0, 0
    SendMessage hwnd, WM_CAP_SET_SCALE, _FALSE, 0
    'SendMessage hwnd, WM_CAP_SET_PREVIEWRATE, 1000 / FPS, 0
    SendMessage hwnd, WM_CAP_SET_PREVIEW, _FALSE, 0

    Dim As _Unsigned Long formatSize: formatSize = SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
    If Len(format) <> formatSize Then
        KillDriver hwnd
        Print "Wrong size"
        Print formatSize, Len(format)
        End
    End If

    If SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, Len(format), _Offset(format)) = 0 Then
        KillDriver hwnd
        Print "Couldn't get format"
        End
    End If
    format.bmiHeader.biSize = Len(format)
    format.bmiHeader.biWidth = VIDWIDTH
    format.bmiHeader.biHeight = VIDHEIGHT
    format.bmiHeader.biPlanes = 1
    format.bmiHeader.biBitCount = 16 'yuy2 format
    format.bmiHeader.biSizeImage = VIDWIDTH * VIDHEIGHT * 2
    format.bmiHeader.biCompression = mmioStringToFOURCC("YUY2" + Chr$(0), &H00000010) 'MUST BE YUY2 FORMAT
    If SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, Len(format), _Offset(format)) = 0 Then
        KillDriver hwnd
        Print "Failed to set video format"
        End
    End If
    If defaultSource = _FALSE Then
        SendMessage hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0 'PICK YUY2!!!
        SendMessage hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0
    End If
    SendMessage hwnd, WM_CAP_GET_VIDEOFORMAT, 0, _Offset(format)
    SendMessage hwnd, WM_CAP_SET_CALLBACK_FRAME, 0, myCallback
End Sub

' /////////////////////////////////////////////////////////////////////////////

Sub KillDriver (hwnd As _Offset)
    SendMessage hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
    DestroyWindow hwnd
End Sub

' /////////////////////////////////////////////////////////////////////////////

Sub SaveBMP (hwnd As _Offset, filename As String)
    filename = filename + Chr$(0)
    SendMessage hwnd, WM_CAP_FILE_SAVEDIB, 0, _Offset(filename)
End Sub

' /////////////////////////////////////////////////////////////////////////////

Sub GrabFrame (hwnd As _Offset)
    SendMessage hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
End Sub

' /////////////////////////////////////////////////////////////////////////////

Sub GrabFrameToClipboard (hwnd As _Offset, image As _MEM)
    Dim As _Unsigned Long frameSize: frameSize = SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
    If frameSize = 0 Then
        Print "Failed to get video format size"
        KillDriver hwnd
        End
    End If
    SendMessage hwnd, WM_CAP_EDIT_COPY, 0, 0
    If OpenClipboard(0) = 0 Then
        Print "Couldn't open clipboard"
        KillDriver hwnd
        End
    End If
    Dim As _Offset hDIB: hDIB = GetClipboardData(CF_DIB)
    If hDIB = 0 Then
        Print "Failed to retrieve bitmap from clipboard"
        CloseClipboard
        KillDriver hwnd
        End
    End If
    Dim As _Offset pDIB: pDIB = GlobalLock(hDIB)
    If pDIB = 0 Then
        Print "Failed to lock the clipboard"
        CloseClipboard
        KillDriver hwnd
        End
    End If
    CloseClipboard
    Dim As _MEM p: p = _Mem(pDIB, 4)
    Dim As _Unsigned Long biSize: biSize = _MemGet(p, p.OFFSET, _Unsigned Long)
    Dim As _MEM pBI: pBI = _Mem(pDIB, biSize)
    Dim As BITMAPINFO bi
    _MemGet pBI, pBI.OFFSET, bi
    _MemFree pBI
    _MemFree p
    Dim As Long bytesPerPixel: bytesPerPixel = (bi.bmiHeader.biBitCount + 7) \ 8
    Dim As Long stride: stride = (((bi.bmiHeader.biWidth * bi.bmiHeader.biBitCount) + 31) And Not 31) \ 8
    Dim As _MEM m: m = _Mem(pDIB + Len(bi), bi.bmiHeader.biSizeImage)
    Dim As Long y, x, t
    Dim As _Unsigned _Byte pixel24(0 To 2)
    Dim As _Unsigned _Byte pixel32(0 To 3)
    Dim As _Offset pScanLine
    Dim As _Unsigned Long q
    Dim As Long i: i = _NewImage(bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 32)
    _Dest i

    If bi.bmiHeader.biHeight > 0 Then
        For y = 0 To Abs(bi.bmiHeader.biHeight) - 1
            pScanLine = m.OFFSET + (y * stride)
            For x = 0 To bi.bmiHeader.biWidth - 1
                If bi.bmiHeader.biBitCount = 24 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel24()
                    q = _RGB32(pixel24(2), pixel24(1), pixel24(0))
                ElseIf bi.bmiHeader.biBitCount = 32 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel32()
                    q = _RGBA32(pixel32(2), pixel32(1), pixel32(0), pixel32(3))
                Else
                    q = _RGB32(255, 255, 255)
                End If
                PSet (x, Abs(bi.bmiHeader.biHeight) - 1 - y), q
            Next x
        Next y
    Else
        For y = 0 To Abs(bi.bmiHeader.biHeight) - 1
            pScanLine = m.OFFSET + (y * stride)
            For x = 0 To bi.bmiHeader.biWidth - 1
                If bi.bmiHeader.biBitCount = 24 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel24()
                    q = _RGB32(pixel24(2), pixel24(1), pixel24(0))
                ElseIf bi.bmiHeader.biBitCount = 32 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel32()
                    q = _RGBA32(pixel32(2), pixel32(1), pixel32(0), pixel32(3))
                Else
                    q = _RGB32(255, 255, 255)
                End If
                PSet (x, y), q
            Next
        Next
    End If
    _Dest 0
    image = _MemImage(i)
    Dim As Long a: a = GlobalUnlock(pDIB)
End Sub

' /////////////////////////////////////////////////////////////////////////////

Function CapVideoCallback%& (hWnd As _Offset, lpVHdr As _Offset)
    Type VIDEOHDR
        As _Offset lpData
        As _Unsigned Long dwBufferLength, dwBytesUsed, dwTimeCaptured
        As String * 4 padding1
        As _Unsigned _Offset dwUser
        As _Unsigned Long dwFlags
        As String * 4 padding2
        As _Offset dwReserved1, dwReserved2, dwReserved3, dwReserved4
    End Type
    Dim As VIDEOHDR vhdr
    Dim As _MEM pVhdr: pVhdr = _Mem(lpVHdr, Len(vhdr))
    _MemGet pVhdr, pVhdr.OFFSET, vhdr
    _MemFree pVhdr
    Dim As _Unsigned Long frameSize: frameSize = SendMessage(hWnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
    If frameSize = 0 Then
        Print "Failed to get video format size"
        'KillDriver hWnd
        'End
    End If
    Dim As BITMAPINFO bi
    SendMessage hWnd, WM_CAP_GET_VIDEOFORMAT, frameSize, _Offset(bi)
    'Print bi.bmiHeader.biHeight
    Dim As _MEM lpData: lpData = _Mem(vhdr.lpData, vhdr.dwBufferLength)
    If _MemExists(frame) Then _MemFree frame
    Dim As Long bitsPerPixel: bitsPerPixel = bi.bmiHeader.biBitCount
    Dim As Long bytesPerPixel: bytesPerPixel = (bitsPerPixel + 7) \ 8
    Dim As _Unsigned Long stride: stride = (((bi.bmiHeader.biWidth * bi.bmiHeader.biBitCount) + 31) And Not 31) \ 8
    Dim As Long y, x
    Dim As _Unsigned _Byte yuy2(0 To 3)
    Dim As _Offset pScanLine
    Dim As _Unsigned _Integer64 converted
    Dim As _Unsigned _Byte r, g, b
    Dim As _Offset pixelOffset
    Dim As Long i: i = _NewImage(bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 32)
    _Dest i
    For y = 0 To bi.bmiHeader.biHeight - 1
        pScanLine = lpData.OFFSET + (y * stride)
        For x = 0 To bi.bmiHeader.biWidth - bytesPerPixel Step bytesPerPixel
            pixelOffset = pScanLine + (x * bytesPerPixel)
            _MemGet lpData, pixelOffset, yuy2()
            converted = ConvertYUY2toRGB(yuy2())
            PSet (x, y), converted And &HFFFFFFFF
            PSet (x + 1, y), _ShR(converted, 32) And &HFFFFFFFF
        Next
    Next
    _Dest 0
    frame = _MemImage(i)
End Function

' /////////////////////////////////////////////////////////////////////////////

Function ConvertYUY2toRGB~&& (yuy2() As _Unsigned _Byte)
    Dim As _Unsigned _Byte r1, g1, b1, r2, g2, b2
    Dim As Double Y1, Y2, U, V

    ' Extract values
    Y1 = yuy2(0) * BRIGHTNESS_LEVEL
    Y2 = yuy2(2) * BRIGHTNESS_LEVEL
    U = (yuy2(1) - 128) * SATURATION_LEVEL
    V = (yuy2(3) - 128) * SATURATION_LEVEL

    ' Convert first pixel
    r1 = _Clamp(Y1 + 1.13983 * V, 0, 255)
    g1 = _Clamp(Y1 - 0.39465 * U - 0.58060 * V, 0, 255)
    b1 = _Clamp(Y1 + 2.03211 * U, 0, 255)

    ' Convert second pixel
    r2 = _Clamp(Y2 + 1.13983 * V, 0, 255)
    g2 = _Clamp(Y2 - 0.39465 * U - 0.58060 * V, 0, 255)
    b2 = _Clamp(Y2 + 2.03211 * U, 0, 255)

    ' Pack pixels into a single return value
    ConvertYUY2toRGB = _RGB32(r1, g1, b1) Or _ShL(_RGB32(r2, g2, b2), 32)
End Function

' /////////////////////////////////////////////////////////////////////////////
' ROUNDING FUNCTIONS FOR TYPE SINGLE

Function RoundSingle! (num!, digits%)
    RoundSingle! = Int(num! * 10 ^ digits% + .5) / 10 ^ digits%
End Function

' NOTE: not sure this one works: when digits%=3, it rounds .31 to .32
Function RoundUpSingle! (num!, digits%)
    RoundUpSingle! = _Ceil(num! * 10 ^ digits%) / 10 ^ digits%
End Function

Function RoundDownSingle! (num!, digits%)
    RoundDownSingle! = Int(num! * 10 ^ digits%) / 10 ^ digits%
End Function

Function RoundScientificSingle! (num!, digits%)
    RoundScientificSingle! = _Round(num! * 10 ^ digits%) / 10 ^ digits%
End Function

' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation

' Example: A string function that displays extremely small or large exponential decimal values.

Function SngToStr$ (n!)
    Dim result$: result$ = ""
    Dim value$
    Dim Xpos%
    Dim expo%
    Dim sign$
    Dim valu$
    Dim dot%
    Dim L%
    Dim add$
    Dim min$
    Dim DP$
    Dim n%
    Dim num$

    value$ = UCase$(LTrim$(Str$(n!)))
    Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
    If Xpos% Then
        expo% = Val(Mid$(value$, Xpos% + 1))
        If Val(value$) < 0 Then
            sign$ = "-"
            valu$ = Mid$(value$, 2, Xpos% - 2)
        Else
            valu$ = Mid$(value$, 1, Xpos% - 1)
        End If
        dot% = InStr(valu$, ".")
        L% = Len(valu$)
        If expo% > 0 Then
            add$ = String$(expo% - (L% - dot%), "0")
        End If
        If expo% < 0 Then
            min$ = String$(Abs(expo%) - (dot% - 1), "0")
            DP$ = "."
        End If
        For n% = 1 To L%
            If Mid$(valu$, n%, 1) <> "." Then
                num$ = num$ + Mid$(valu$, n%, 1)
            End If
        Next n%
        result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
    Else
        result$ = value$
    End If

    SngToStr$ = result$
End Function ' SngToStr$

' /////////////////////////////////////////////////////////////////////////////

Function SngRoundedToStr$ (sngValue As Single, intNumPlaces As Integer)
    Dim sngNew As Single
    sngNew = RoundSingle!(sngValue, intNumPlaces)
    SngRoundedToStr$ = SngToStr$(sngNew)
End Function ' SngRoundedToStr$

' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.qb64.org)
'   Revision: 1.6
'   Updated:  5/28/2012

'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.

Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.

    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1

    lngLocation = InStr(1, Text2, Find2)

    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)

        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))

        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter

        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)

        ' Next instance of [Find2]...
    Wend

    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$

' /////////////////////////////////////////////////////////////////////////////
' Simple timestamp function
' Format: {YYYY}-{MM}-{DD} {hh}:[mm}:{ss}

' Uses:
'     TIME$
'         The TIME$ Function returns a STRING representation
'         of the current computer time in a 24 hour format.
'         https://qb64phoenix.com/qb64wiki/index.php/TIME$
'     DATE$
'         The DATE$ function returns the current computer date
'         as a string in the format "mm-dd-yyyy".
'         https://qb64phoenix.com/qb64wiki/index.php/DATE$
'
' TODO: support template where
'       {yyyy} = 4 digit year
'       {mm}   = 2 digit month
'       {dd}   = 2 digit day
'       {hh}   = 2 digit hour (12-hour)
'       {rr}   = 2 digit hour (24-hour)
'       {nn}   = 2 digit minute
'       {ss}   = 2 digit second
'       {ampm} = AM/PM

' We got the nn for minute from Microsoft > Office VBA Reference > DateDiff function
' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/datediff-function

' PRINT "Current date time (simple format) = " + Chr$(34) + GetCurrentDateTime$("{yyyy}-{mm}-{dd} {rr}:{nn}:{ss}") + Chr$(34)
' PRINT "Current date time (US format)     = " + Chr$(34) + GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}") + Chr$(34)
' PRINT "Filename timestamp                = " + Chr$(34) + GetCurrentDateTime$("{yyyy}{mm}{dd}_{rr}{nn}{ss}") + Chr$(34)

Function GetCurrentDateTime$ (sTemplate$)
    Dim sDate$: sDate$ = Date$
    Dim sTime$: sTime$ = Time$
    Dim sYYYY$: sYYYY$ = Mid$(sDate$, 7, 4)
    Dim sMM$: sMM$ = Mid$(sDate$, 1, 2)
    Dim sDD$: sDD$ = Mid$(sDate$, 4, 2)
    Dim sHH24$: sHH24$ = Mid$(sTime$, 1, 2)
    Dim sHH$: sHH$ = ""
    Dim sMI$: sMI$ = Mid$(sTime$, 4, 2)
    Dim sSS$: sSS$ = Mid$(sTime$, 7, 2)
    Dim iHour%: iHour% = Val(sHH24$)
    Dim sAMPM$: sAMPM$ = ""
    Dim result$: result$ = ""

    ' FIGURE OUT AM/PM
    If InStr(sTemplate$, "{ampm}") > 0 Then
        If iHour% = 0 Then
            sAMPM$ = "AM"
            iHour% = 12
        ElseIf iHour% > 0 And iHour% < 12 Then
            sAMPM$ = "AM"
        ElseIf iHour% = 12 Then
            sAMPM$ = "PM"
        Else
            sAMPM$ = "PM"
            iHour% = iHour% - 12
        End If
        sHH$ = Right$("00" + _Trim$(Str$(iHour%)), 2)
    End If

    ' POPULATE TEMPLATE
    result$ = sTemplate$
    result$ = Replace$(result$, "{yyyy}", sYYYY$)
    result$ = Replace$(result$, "{mm}", sMM$)
    result$ = Replace$(result$, "{dd}", sDD$)
    result$ = Replace$(result$, "{hh}", sHH$)
    result$ = Replace$(result$, "{rr}", sHH24$)
    result$ = Replace$(result$, "{nn}", sMI$)
    result$ = Replace$(result$, "{ss}", sSS$)
    result$ = Replace$(result$, "{ampm}", sAMPM$)

    ' RETURN RESULT
    GetCurrentDateTime$ = result$
End Function ' GetCurrentDateTime$

' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column.
' iRow and iCol are 0-based.
' See also: PrintString1

Sub PrintString (iRow As Integer, iCol As Integer, MyString As String, RowOffset As Integer, ColOffset As Integer)
    Dim iX As Integer
    Dim iY As Integer
    iX = (_FontWidth * iCol) + ColOffset
    iY = (_FontHeight * iRow) + RowOffset
    _PrintString (iX, iY), MyString
End Sub ' PrintString

' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.

' Note: random-number generator should be initialized with Randomize Timer

Function RandomNumber% (Min%, Max%)
    Dim NumSpread%
    NumSpread% = (Max% - Min%) + 1
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%

' /////////////////////////////////////////////////////////////////////////////

Sub InitImage (ThisImage&, iWidth&, iHeight&, bgColor~&)
    If ThisImage& = -1 Or ThisImage& = 0 Then
        ThisImage& = _NewImage(iWidth&, iHeight&, 32)
        _Dest ThisImage&: Cls , bgColor~&
    End If
End Sub ' InitImage

' /////////////////////////////////////////////////////////////////////////////

Sub FreeImage (ThisImage&)
    If ThisImage& < -1 Or ThisImage& > 0 Then _FreeImage ThisImage&
End Sub ' FreeImage

' /////////////////////////////////////////////////////////////////////////////

Function cRed~& ()
    cRed = _RGB32(255, 0, 0)
End Function

Function cOrange~& ()
    cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&

Function cGold~& ()
    cGold = _RGB32(255, 215, 0)
End Function ' cGold~&

Function cDarkGold~& ()
    cDarkGold = _RGB32(232, 192, 0)
End Function ' cGold~&

Function cYellow~& ()
    cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&

Function cLime~& ()
    cLime = _RGB32(0, 255, 0)
End Function ' cLime~&

Function cCyan~& ()
    cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&

Function cDodgerBlue~& ()
    cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&

Function cSeaBlue~& ()
    cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&

Function cBlue~& ()
    cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&

Function cMagenta~& ()
    cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&

Function cGreen~& ()
    cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&

Function cPurple~& ()
    cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&

Function cDeepPurple~& ()
    cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&

Function cBlack~& ()
    cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&

Function cGray~& ()
    cGray = _RGB32(128, 128, 128)
End Function ' cGray~&

Function cLightGray~& ()
    cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&

Function cWhite~& ()
    cWhite = _RGB32(255, 255, 255)
End Function ' cWhite~&

Function cEmpty~& ()
    cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&

' /////////////////////////////////////////////////////////////////////////////