02-28-2025, 09:26 PM (This post was last modified: 02-28-2025, 09:29 PM by SpriggsySpriggs.)
I realized I'm kind of hijacking Madscijr's thread so here's my own. This uses the Windows API Avicap32 to capture RAW pixel data. Adjust brightness with up and down arrow keys. Adjust saturation with plus and minus keys on the numpad. "N" will toggle the negative filter on and off. "S" will toggle the sepia filter on and off. "R" will reset all values to default.
Pressing space will stop the loop and capture the last frame to clipboard and to a BMP using _SaveImage.
Download the framecallback.h file to make this work:
framecallback.h (Size: 355 bytes / Downloads: 17)
Const FPS = 30 'Not recommended to set this higher than frame rate of webcam/video device
Const VIDWIDTH = 640
Const VIDHEIGHT = 480
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 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
Dim Shared As _Byte NEGATIVE: NEGATIVE = _FALSE
Dim Shared As _Byte SEPIA: SEPIA = _FALSE
Screen _NewImage(VIDWIDTH, VIDHEIGHT, 32)
_Delay 0.2 'Just in case
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
Do
k = _KeyHit
Select Case k
Case 32
Exit Do
Case 27
KillDriver childWin
End
Case 43
If SATURATION_LEVEL < 2.00 Then
SATURATION_LEVEL = SATURATION_LEVEL + .10
'_Echo _ToStr$(SATURATION_LEVEL)
End If
Case 45
If SATURATION_LEVEL > 0.00 Then
SATURATION_LEVEL = SATURATION_LEVEL - .10
'_Echo _ToStr$(SATURATION_LEVEL)
End If
Case 18432
If BRIGHTNESS_LEVEL < 2 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL + .10
'_Echo _ToStr$(BRIGHTNESS_LEVEL)
End If
Case 20480
If BRIGHTNESS_LEVEL > 0.00 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL - .10
'_Echo _ToStr$(BRIGHTNESS_LEVEL)
End If
Case Asc("R"), Asc("r") 'Reset
BRIGHTNESS_LEVEL = 1.00
SATURATION_LEVEL = 1.00
NEGATIVE = _FALSE
SEPIA = _FALSE
Case Asc("N"), Asc("n") 'negative filter toggle
NEGATIVE = Not NEGATIVE
Case Asc("S"), Asc("s") 'sepia filter toggle
SEPIA = Not SEPIA
End Select
If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
TranslateMessage _Offset(msg)
DispatchMessage _Offset(msg)
Else
GrabFrame childWin
End If
Screen frame.IMAGE
_Display
_Limit FPS
Loop
Dim As _MEM clippedFrame
'GrabFrameToClipboard childWin, clippedFrame
_ClipboardImage = frame.IMAGE
_SaveImage "myimage.bmp", frame.IMAGE, "BMP"
Print "Disconnecting Driver"
KillDriver childWin
_MemFree frame
'_MemFree clippedFrame
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
Added another feature. While the camera is previewing, press "P" to capture the current frame to a uniquely named PNG. Press "C" to capture the current frame to the clipboard.
Const FPS = 30 'Not recommended to set this higher than frame rate of webcam/video device
Const VIDWIDTH = 640
Const VIDHEIGHT = 480
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 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
Dim Shared As _Byte NEGATIVE: NEGATIVE = _FALSE
Dim Shared As _Byte SEPIA: SEPIA = _FALSE
Screen _NewImage(VIDWIDTH, VIDHEIGHT, 32)
_Delay 0.2 'Just in case
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 As Long i
Do
k = _KeyHit
Select Case k
Case 32
Exit Do
Case 27
KillDriver childWin
End
Case 43
If SATURATION_LEVEL < 2.00 Then
SATURATION_LEVEL = SATURATION_LEVEL + .10
'_Echo _ToStr$(SATURATION_LEVEL)
End If
Case 45
If SATURATION_LEVEL > 0.00 Then
SATURATION_LEVEL = SATURATION_LEVEL - .10
'_Echo _ToStr$(SATURATION_LEVEL)
End If
Case 18432
If BRIGHTNESS_LEVEL < 2 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL + .10
'_Echo _ToStr$(BRIGHTNESS_LEVEL)
End If
Case 20480
If BRIGHTNESS_LEVEL > 0.00 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL - .10
'_Echo _ToStr$(BRIGHTNESS_LEVEL)
End If
Case Asc("R"), Asc("r") 'Reset
BRIGHTNESS_LEVEL = 1.00
SATURATION_LEVEL = 1.00
NEGATIVE = _FALSE
SEPIA = _FALSE
Case Asc("N"), Asc("n") 'negative filter toggle
NEGATIVE = Not NEGATIVE
Case Asc("S"), Asc("s") 'sepia filter toggle
SEPIA = Not SEPIA
Case Asc("P"), Asc("p")
If _FileExists("capture(" + _ToStr$(i) + ").png") Then
While _FileExists("capture(" + _ToStr$(i) + ").png")
i = i + 1
Wend
End If
_SaveImage "capture(" + _ToStr$(i) + ").png", frame.IMAGE, "PNG"
i = i + 1
Case Asc("C"), Asc("c")
_ClipboardImage = frame.IMAGE
End Select
If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
TranslateMessage _Offset(msg)
DispatchMessage _Offset(msg)
Else
GrabFrame childWin
End If
Screen frame.IMAGE
_Display
_Limit FPS
Loop
Dim As _MEM clippedFrame
Print "Disconnecting Driver"
KillDriver childWin
_MemFree frame
'_MemFree clippedFrame
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
03-01-2025, 12:47 AM (This post was last modified: 03-01-2025, 12:51 AM by SpriggsySpriggs.)
Added the ability to flip the video horizontally with "H" and vertically with "V". Also, removed old Clipboard and Save functions as those are not necessary.
Const FPS = 30 'Not recommended to set this higher than frame rate of webcam/video device
Const VIDWIDTH = 640
Const VIDHEIGHT = 480
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 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
Dim Shared As _Byte NEGATIVE: NEGATIVE = _FALSE
Dim Shared As _Byte SEPIA: SEPIA = _FALSE
Dim Shared As _Byte FLIPPED_H: FLIPPED_H = _FALSE
Dim Shared As _Byte FLIPPED_V: FLIPPED_V = _FALSE
Screen _NewImage(VIDWIDTH, VIDHEIGHT, 32)
_Delay 0.2 'Just in case
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 As Long i
Do
k = _KeyHit
Select Case k
Case 32
Exit Do
Case 27
KillDriver childWin
End
Case 43
If SATURATION_LEVEL < 2.00 Then
SATURATION_LEVEL = SATURATION_LEVEL + .10
'_Echo _ToStr$(SATURATION_LEVEL)
End If
Case 45
If SATURATION_LEVEL > 0.00 Then
SATURATION_LEVEL = SATURATION_LEVEL - .10
'_Echo _ToStr$(SATURATION_LEVEL)
End If
Case 18432
If BRIGHTNESS_LEVEL < 2 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL + .10
'_Echo _ToStr$(BRIGHTNESS_LEVEL)
End If
Case 20480
If BRIGHTNESS_LEVEL > 0.00 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL - .10
'_Echo _ToStr$(BRIGHTNESS_LEVEL)
End If
Case Asc("R"), Asc("r") 'Reset
BRIGHTNESS_LEVEL = 1.00
SATURATION_LEVEL = 1.00
NEGATIVE = _FALSE
SEPIA = _FALSE
FLIPPED_H = _FALSE
FLIPPED_V = _FALSE
Case Asc("N"), Asc("n") 'negative filter toggle
NEGATIVE = Not NEGATIVE
Case Asc("S"), Asc("s") 'sepia filter toggle
SEPIA = Not SEPIA
Case Asc("P"), Asc("p")
If _FileExists("capture(" + _ToStr$(i) + ").png") Then
While _FileExists("capture(" + _ToStr$(i) + ").png")
i = i + 1
Wend
End If
_SaveImage "capture(" + _ToStr$(i) + ").png", frame.IMAGE, "PNG"
i = i + 1
Case Asc("C"), Asc("c")
_ClipboardImage = frame.IMAGE
Case Asc("H"), Asc("h")
FLIPPED_H = Not FLIPPED_H
Case Asc("V"), Asc("v")
FLIPPED_V = Not FLIPPED_V
End Select
If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
TranslateMessage _Offset(msg)
DispatchMessage _Offset(msg)
Else
GrabFrame childWin
End If
_PutImage , frame.IMAGE, _Dest
_Display
_Limit FPS
Loop
Dim As _MEM clippedFrame
Print "Disconnecting Driver"
KillDriver childWin
_MemFree frame
'_MemFree clippedFrame
'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_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 GrabFrame (hwnd As _Offset)
SendMessage hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
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
If FLIPPED_H Then
Dim As Long hi: hi = _CopyImage(i)
_PutImage , hi, i, (bi.bmiHeader.biWidth - 1, 0)-(0, bi.bmiHeader.biHeight - 1)
_FreeImage hi
End If
If FLIPPED_V Then
Dim As Long vi: vi = _CopyImage(i)
_PutImage , vi, i, (bi.bmiHeader.biWidth - 1, bi.bmiHeader.biHeight - 1)-(0, 0)
_FreeImage vi
End If
_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
03-01-2025, 01:57 AM (This post was last modified: 03-01-2025, 01:58 AM by SpriggsySpriggs.)
Added the ability to individually increase and decrease the R, G, and B values. Hit "r" to decrease, hold shift and press "R" to increase. And so on and so forth, etc.
Const FPS = 30 'Not recommended to set this higher than frame rate of webcam/video device
Const VIDWIDTH = 640
Const VIDHEIGHT = 480
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 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
Dim Shared As _Byte NEGATIVE: NEGATIVE = _FALSE
Dim Shared As _Byte SEPIA: SEPIA = _FALSE
Dim Shared As _Byte FLIPPED_H: FLIPPED_H = _FALSE
Dim Shared As _Byte FLIPPED_V: FLIPPED_V = _FALSE
Dim Shared As Single COLOR_TEMP_WARM: COLOR_TEMP_WARM = 1.00
Dim Shared As Single COLOR_TEMP_COOL: COLOR_TEMP_COOL = 1.00
Dim Shared As Single COLOR_GREEN: COLOR_GREEN = 1.00
Screen _NewImage(VIDWIDTH, VIDHEIGHT, 32)
_Delay 0.2 'Just in case
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 As Long i
Do
k = _KeyHit
Select Case k
Case 32 'Space bar
Exit Do
Case 27 'Escape - Reset
BRIGHTNESS_LEVEL = 1.00
SATURATION_LEVEL = 1.00
NEGATIVE = _FALSE
SEPIA = _FALSE
FLIPPED_H = _FALSE
FLIPPED_V = _FALSE
COLOR_TEMP_WARM = 1.00
COLOR_TEMP_COOL = 1.00
COLOR_GREEN = 1.00
Case 43 'numpad plus key
If SATURATION_LEVEL < 2.00 Then
SATURATION_LEVEL = SATURATION_LEVEL + .10
End If
Case 45 'numpad minus key
If SATURATION_LEVEL > 0.00 Then
SATURATION_LEVEL = SATURATION_LEVEL - .10
End If
Case 18432 'arrow key up
If BRIGHTNESS_LEVEL < 2 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL + .10
End If
Case 20480 'arrow key down
If BRIGHTNESS_LEVEL > 0.00 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL - .10
End If
Case Asc("N"), Asc("n") 'negative filter toggle
NEGATIVE = Not NEGATIVE
Case Asc("S"), Asc("s") 'sepia filter toggle
SEPIA = Not SEPIA
Case Asc("P"), Asc("p")
If _FileExists("capture(" + _ToStr$(i) + ").png") Then
While _FileExists("capture(" + _ToStr$(i) + ").png")
i = i + 1
Wend
End If
_SaveImage "capture(" + _ToStr$(i) + ").png", frame.IMAGE, "PNG"
i = i + 1
Case Asc("C"), Asc("c")
_ClipboardImage = frame.IMAGE
Case Asc("H"), Asc("h")
FLIPPED_H = Not FLIPPED_H
Case Asc("V"), Asc("v")
FLIPPED_V = Not FLIPPED_V
Case Asc("R")
If COLOR_TEMP_WARM < 2.00 Then
COLOR_TEMP_WARM = COLOR_TEMP_WARM + .10
End If
Case Asc("r")
If COLOR_TEMP_WARM > 0 Then
COLOR_TEMP_WARM = COLOR_TEMP_WARM - .10
End If
Case Asc("G")
If COLOR_GREEN < 2.00 Then
COLOR_GREEN = COLOR_GREEN + .10
End If
Case Asc("g")
If COLOR_GREEN > 0 Then
COLOR_GREEN = COLOR_GREEN - .10
End If
Case Asc("B")
If COLOR_TEMP_COOL < 2.00 Then
COLOR_TEMP_COOL = COLOR_TEMP_COOL + .10
End If
Case Asc("b")
If COLOR_TEMP_COOL > 0 Then
COLOR_TEMP_COOL = COLOR_TEMP_COOL - .10
End If
End Select
If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
TranslateMessage _Offset(msg)
DispatchMessage _Offset(msg)
Else
GrabFrame childWin
End If
_PutImage , frame.IMAGE, _Dest
_Display
_Limit FPS
Loop
Dim As _MEM clippedFrame
Print "Disconnecting Driver"
KillDriver childWin
_MemFree frame
'_MemFree clippedFrame
'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_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 GrabFrame (hwnd As _Offset)
SendMessage hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
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
If FLIPPED_H Then
Dim As Long hi: hi = _CopyImage(i)
_PutImage , hi, i, (bi.bmiHeader.biWidth - 1, 0)-(0, bi.bmiHeader.biHeight - 1)
_FreeImage hi
End If
If FLIPPED_V Then
Dim As Long vi: vi = _CopyImage(i)
_PutImage , vi, i, (bi.bmiHeader.biWidth - 1, bi.bmiHeader.biHeight - 1)-(0, 0)
_FreeImage vi
End If
_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
Const FPS = 30 'Not recommended to set this higher than frame rate of webcam/video device
Const VIDWIDTH = 640
Const VIDHEIGHT = 480
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 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
Dim Shared As _Byte NEGATIVE: NEGATIVE = _FALSE
Dim Shared As _Byte SEPIA: SEPIA = _FALSE
Dim Shared As _Byte FLIPPED_H: FLIPPED_H = _FALSE
Dim Shared As _Byte FLIPPED_V: FLIPPED_V = _FALSE
Dim Shared As Single COLOR_TEMP_WARM: COLOR_TEMP_WARM = 1.00
Dim Shared As Single COLOR_TEMP_COOL: COLOR_TEMP_COOL = 1.00
Dim Shared As Single COLOR_GREEN: COLOR_GREEN = 1.00
Dim Shared As _Unsigned _Byte PALETTE_SWAP: PALETTE_SWAP = 0
Screen _NewImage(VIDWIDTH, VIDHEIGHT, 32)
_Delay 0.2 'Just in case
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 As Long i
Do
k = _KeyHit
Select Case k
Case 32 'Space bar
Exit Do
Case 27 'Escape - Reset
BRIGHTNESS_LEVEL = 1.00
SATURATION_LEVEL = 1.00
NEGATIVE = _FALSE
SEPIA = _FALSE
FLIPPED_H = _FALSE
FLIPPED_V = _FALSE
COLOR_TEMP_WARM = 1.00
COLOR_TEMP_COOL = 1.00
COLOR_GREEN = 1.00
PALETTE_SWAP = 0
Case 43 'numpad plus key
If SATURATION_LEVEL < 2.00 Then
SATURATION_LEVEL = SATURATION_LEVEL + .10
End If
Case 45 'numpad minus key
If SATURATION_LEVEL > 0.00 Then
SATURATION_LEVEL = SATURATION_LEVEL - .10
End If
Case 18432 'arrow key up
If BRIGHTNESS_LEVEL < 2 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL + .10
End If
Case 20480 'arrow key down
If BRIGHTNESS_LEVEL > 0.00 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL - .10
End If
Case Asc("N"), Asc("n") 'negative filter toggle
NEGATIVE = Not NEGATIVE
Case Asc("S"), Asc("s") 'sepia filter toggle
SEPIA = Not SEPIA
Case Asc("P"), Asc("p")
If _FileExists("capture(" + _ToStr$(i) + ").png") Then
While _FileExists("capture(" + _ToStr$(i) + ").png")
i = i + 1
Wend
End If
_SaveImage "capture(" + _ToStr$(i) + ").png", frame.IMAGE, "PNG"
i = i + 1
Case Asc("C"), Asc("c")
_ClipboardImage = frame.IMAGE
Case Asc("H"), Asc("h")
FLIPPED_H = Not FLIPPED_H
Case Asc("V"), Asc("v")
FLIPPED_V = Not FLIPPED_V
Case Asc("R")
If COLOR_TEMP_WARM < 2.00 Then
COLOR_TEMP_WARM = COLOR_TEMP_WARM + .10
End If
Case Asc("r")
If COLOR_TEMP_WARM > 0 Then
COLOR_TEMP_WARM = COLOR_TEMP_WARM - .10
End If
Case Asc("G")
If COLOR_GREEN < 2.00 Then
COLOR_GREEN = COLOR_GREEN + .10
End If
Case Asc("g")
If COLOR_GREEN > 0 Then
COLOR_GREEN = COLOR_GREEN - .10
End If
Case Asc("B")
If COLOR_TEMP_COOL < 2.00 Then
COLOR_TEMP_COOL = COLOR_TEMP_COOL + .10
End If
Case Asc("b")
If COLOR_TEMP_COOL > 0 Then
COLOR_TEMP_COOL = COLOR_TEMP_COOL - .10
End If
Case Asc("1")
PALETTE_SWAP = 1
Case Asc("2")
PALETTE_SWAP = 2
Case Asc("3")
PALETTE_SWAP = 3
Case Asc("4")
PALETTE_SWAP = 4
End Select
If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
TranslateMessage _Offset(msg)
DispatchMessage _Offset(msg)
Else
GrabFrame childWin
End If
_PutImage , frame.IMAGE, _Dest
_Display
_Limit FPS
Loop
Dim As _MEM clippedFrame
Print "Disconnecting Driver"
KillDriver childWin
_MemFree frame
'_MemFree clippedFrame
'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_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 GrabFrame (hwnd As _Offset)
SendMessage hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
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
If FLIPPED_H Then
Dim As Long hi: hi = _CopyImage(i)
_PutImage , hi, i, (bi.bmiHeader.biWidth - 1, 0)-(0, bi.bmiHeader.biHeight - 1)
_FreeImage hi
End If
If FLIPPED_V Then
Dim As Long vi: vi = _CopyImage(i)
_PutImage , vi, i, (bi.bmiHeader.biWidth - 1, bi.bmiHeader.biHeight - 1)-(0, 0)
_FreeImage vi
End If
_Dest 0
frame = _MemImage(i)
End Function
Function ConvertYUY2toRGB~&& (yuy2() As _Unsigned _Byte)
Dim As _Unsigned _Byte r1, g1, b1, r2, g2, b2, r3, g3, b3
Dim As Double Y1, Y2, U, V
Bro this is very cool.
The new era of QB64 may start now - AI in QB64.
We can just make a better camera app...
We can make an app for live video recording... maybe for annotations from camera
It is very good.
(03-01-2025, 05:41 PM)madscijr Wrote: @SpriggsySpriggs, can we control camera zoom with the API?
We're grabbing raw pixel data but we're not really controlling the camera itself. Now, if we open the camera dialog again during preview, we can use Windows' sliders to adjust zoom and such.
03-01-2025, 09:44 PM (This post was last modified: 03-01-2025, 10:34 PM by madscijr.)
(03-01-2025, 06:38 PM)SpriggsySpriggs Wrote:
(03-01-2025, 05:41 PM)madscijr Wrote: @SpriggsySpriggs, can we control camera zoom with the API?
We're grabbing raw pixel data but we're not really controlling the camera itself. Now, if we open the camera dialog again during preview, we can use Windows' sliders to adjust zoom and such.
Gotcha... maybe if the camera's software itself has an API, but not that important for anything I'd be looking to do. You've done quite enough, thank you! :-D
I did some googling on generating an AVI, and found something about using FFMPEG for turning a bunch of still images into a movie, so maybe that could work (just save each frame to a file and then shell out to FFMPEG)?
I'll play with this stuff later. One thing I want to try is "video echo"... Merging the images from the camera as they come in with what's already on the screen... Maybe it will show trails or look trippy. Another idea is: connect 2 or more laptops each with a webcam, where the other laptops send pictures over a LAN to laptop #1 which merges them in some funky way. I don't know what kind of throughput it would need for 1 or more streams of 320x240 resolution at 30 FPS? This stuff is fun to play with, that's for sure :-)
framecallback.h (Size: 355 bytes / Downloads: 17)
