Posts: 1
Threads: 0
Joined: Mar 2025
Reputation:
0
(03-01-2025, 09:44 PM)madscijr Wrote: (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, I found something about using FFMPEG for turning a bunch of still images into a movie, so maybe that could work (just saving each frame to a file and then shelling 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 having 2 laptops each with a webcam, and having laptop #2 send its pictures over a LAN to laptop #1 and merging them in some funky way. I don't know what kind of throughput it would need for 320x240 resolution at 30 FPS? This stuff is fun to play with, that's for sure :-) For merging the camera feeds in real-time, you’d likely need a solid network connection between the two laptops. For 320x240 at 30 FPS, the required bandwidth would be around 1.5 Mbps (assuming uncompressed video). You could probably get away with even lower if you compress the video a bit.
Posts: 867
Threads: 122
Joined: Apr 2022
Reputation:
21
03-01-2025, 10:50 PM
(This post was last modified: 03-01-2025, 10:52 PM by madscijr.)
(03-01-2025, 10:29 PM)Reddic Wrote: For merging the camera feeds in real-time, you’d likely need a solid network connection between the two laptops. For 320x240 at 30 FPS, the required bandwidth would be around 1.5 Mbps (assuming uncompressed video). You could probably get away with even lower if you compress the video a bit.
Yeah, this would be over a wired LAN connection with 2 (or maybe 3-4?) laptops sitting near each other. All each would really need to do is continually save the current frame of video to an image file in a folder on laptop #1, and it would just keep reading them in and displaying them. The code already does the saving to a BMP file and QB64PE can load an image from a file, so it would just need 2 or more of these programs running and saving files over the LAN. It shouldn't be hard to make a proof of concept when I get a minute at the PC...
Hey @SpriggsySpriggs, is there a way to get it to save the single frame to a compressed format like JPG instead of BMP?
Posts: 331
Threads: 52
Joined: May 2022
Reputation:
43
03-01-2025, 11:13 PM
(This post was last modified: 03-01-2025, 11:13 PM by Petr.)
@madscijr wrote: is there a way to get it to save the single frame to a compressed format like JPG instead of BMP?
Of course. Open BMP file with the _Loadimage function and save it as a JPG with the _SaveImage function.
Posts: 867
Threads: 122
Joined: Apr 2022
Reputation:
21
03-01-2025, 11:50 PM
(This post was last modified: 03-01-2025, 11:58 PM by madscijr.)
(03-01-2025, 11:13 PM)Petr Wrote: @madscijr wrote: is there a way to get it to save the single frame to a compressed format like JPG instead of BMP?
Of course. Open BMP file with the _Loadimage function and save it as a JPG with the _SaveImage function. That's definitely a way! Though the point was to compress the file so it could be sent to the other computer faster (30 FPS per camera), so I'm not sure if the round trip of loading / saving will actually speed anything up? Then again, maybe it would, with that happening on the local hard drive*, where the compressed image getting sent over the wire opens the bottleneck? Only one way to find out! 
*What if the local file operations were done on a virtual RAM drive**, would that add any speed? Then again, these days with SSDs, which pretty much ARE RAM drives, are we already doing that? Do I enjoy overthinking this crap?? Never mind... carry on!
**Are those even a thing anymore?
Posts: 822
Threads: 35
Joined: Apr 2022
Reputation:
57
03-02-2025, 01:45 AM
(This post was last modified: 03-02-2025, 01:45 AM by SpriggsySpriggs.)
The idea for making AVI using an image sequence would be a little silly at this point. Might as well make it from scratch from frame data and such. As for sending over TCP/IP, you'd probably want super low resolution and to use a good compression algorithm. Maybe _DEFLATE$. Remember, all the frame data is lossless.
The noticing will continue
Posts: 822
Threads: 35
Joined: Apr 2022
Reputation:
57
03-02-2025, 01:52 AM
(This post was last modified: 03-02-2025, 01:55 AM by SpriggsySpriggs.)
Yeah, zoom with using the dialog ain't too bad
This version allows for changing video source or adjusting camera settings using "Z". The changes you make don't happen live. Once you click "OK" on the dialog, the window will reflect the changes.
Code: (Select All)
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_SET_SCALE = WM_CAP_START + 53
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_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 = 60 '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 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
_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 As Long i
$Checking:Off
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
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("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
Case Asc("5")
PALETTE_SWAP = 5
Case Asc("6")
PALETTE_SWAP = 6
Case Asc("Z"), Asc("z")
SendMessage childWin, WM_CAP_DLG_VIDEOSOURCE, 0, 0
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
$Checking:On
Print "Disconnecting Driver"
KillDriver childWin
_MemFree frame
'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
' 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) * COLOR_TEMP_WARM, 0, 255)
g1 = _Clamp((Y1 - 0.39465 * U - 0.58060 * V) * COLOR_GREEN, 0, 255)
b1 = _Clamp((Y1 + 2.03211 * U) * COLOR_TEMP_COOL, 0, 255)
' Convert second pixel
r2 = _Clamp((Y2 + 1.13983 * V) * COLOR_TEMP_WARM, 0, 255)
g2 = _Clamp((Y2 - 0.39465 * U - 0.58060 * V) * COLOR_GREEN, 0, 255)
b2 = _Clamp((Y2 + 2.03211 * U) * COLOR_TEMP_COOL, 0, 255)
If NEGATIVE Then
r1 = 255 - r1: g1 = 255 - g1: b1 = 255 - b1
r2 = 255 - r2: g2 = 255 - g2: b2 = 255 - b2
End If
If PALETTE_SWAP > 0 Then
Select Case PALETTE_SWAP
Case 1
''Dobra
r3 = _Clamp(r1 * 0.989 + g1 * 1.000 + b1 * 0.510, 0, 255)
g3 = _Clamp(r1 * 0.157 + g1 * 0.500 + b1 * 0.400, 0, 255)
b3 = _Clamp(r1 * 0.278 + g1 * 0.000 + b1 * 0.267, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.989 + g2 * 1.000 + b2 * 0.510, 0, 255)
g3 = _Clamp(r2 * 0.157 + g2 * 0.500 + b2 * 0.400, 0, 255)
b3 = _Clamp(r2 * 0.278 + g2 * 0.000 + b2 * 0.267, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 2
''Roden
r3 = _Clamp(r1 * 0.545 + g1 * 0.0902 + b1 * 0.804, 0, 255)
g3 = _Clamp(r1 * 0.412 + g1 * 0.502 + b1 * 0.522, 0, 255)
b3 = _Clamp(r1 * 0.412 + g1 * 0.427 + b1 * 0.247, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.545 + g2 * 0.0902 + b2 * 0.804, 0, 255)
g3 = _Clamp(r2 * 0.412 + g2 * 0.502 + b2 * 0.522, 0, 255)
b3 = _Clamp(r2 * 0.412 + g2 * 0.427 + b2 * 0.247, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 3
''Flowers
r3 = _Clamp(r1 * 0.753 + g1 * 1.000 + b1 * 0.000, 0, 255)
g3 = _Clamp(r1 * 0.000 + g1 * 1.000 + b1 * 0.000, 0, 255)
b3 = _Clamp(r1 * 0.000 + g1 * 1.000 + b1 * 1.000, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.753 + g2 * 1.000 + b2 * 0.000, 0, 255)
g3 = _Clamp(r2 * 0.000 + g2 * 1.000 + b2 * 0.000, 0, 255)
b3 = _Clamp(r2 * 0.000 + g2 * 1.000 + b2 * 1.000, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 4
''GBR
r3 = _Clamp(r1 * 0 + g1 * 0 + b1 * 1, 0, 255)
g3 = _Clamp(r1 * 1 + g1 * 0 + b1 * 0, 0, 255)
b3 = _Clamp(r1 * 0 + g1 * 1 + b1 * 0, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0 + g2 * 0 + b2 * 1, 0, 255)
g3 = _Clamp(r2 * 1 + g2 * 0 + b2 * 0, 0, 255)
b3 = _Clamp(r2 * 0 + g2 * 1 + b2 * 0, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 5
''Sepia
r3 = _Clamp((r1 * 0.393) + (g1 * 0.769) + (b1 * 0.189), 0, 255)
g3 = _Clamp((r1 * 0.349) + (g1 * 0.686) + (b1 * 0.168), 0, 255)
b3 = _Clamp((r1 * 0.272) + (g1 * 0.534) + (b1 * 0.131), 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp((r2 * 0.393) + (g2 * 0.769) + (b2 * 0.189), 0, 255)
g3 = _Clamp((r2 * 0.349) + (g2 * 0.686) + (b2 * 0.168), 0, 255)
b3 = _Clamp((r2 * 0.272) + (g2 * 0.534) + (b2 * 0.131), 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 6
''High contrast
r3 = _Clamp((r1 - 128) * 1.5 + 128, 0, 255)
g3 = _Clamp((g1 - 128) * 1.5 + 128, 0, 255)
b3 = _Clamp((b1 - 128) * 1.5 + 128, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp((r2 - 128) * 1.5 + 128, 0, 255)
g3 = _Clamp((g2 - 128) * 1.5 + 128, 0, 255)
b3 = _Clamp((b2 - 128) * 1.5 + 128, 0, 255)
r2 = r3
g2 = g3
b2 = b3
End Select
End If
' Pack pixels into a single return value
ConvertYUY2toRGB = _RGB32(r1, g1, b1) Or _ShL(_RGB32(r2, g2, b2), 32)
End Function
The noticing will continue
Posts: 822
Threads: 35
Joined: Apr 2022
Reputation:
57
03-02-2025, 02:46 AM
(This post was last modified: 03-02-2025, 02:47 AM by SpriggsySpriggs.)
Added the ability to have a scanline effect by pressing "/". You can skip every other vertical pixel by pressing "\". Press ";" to enable both and leave behind an afterimage for taking some fun photos with yourself. Press "T" to enable a ghosting effect.
Code: (Select All)
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_SET_SCALE = WM_CAP_START + 53
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_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 = 60 '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 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
Dim Shared As _Byte EVERY_OTHER_H: EVERY_OTHER_H = _FALSE
Dim Shared As _Byte EVERY_OTHER_V: EVERY_OTHER_V = _FALSE
Dim Shared As _Byte GHOST: GHOST = _FALSE
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 As Long i
$Checking:Off
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
FLIPPED_H = _FALSE
FLIPPED_V = _FALSE
COLOR_TEMP_WARM = 1.00
COLOR_TEMP_COOL = 1.00
COLOR_GREEN = 1.00
PALETTE_SWAP = 0
EVERY_OTHER_H = _FALSE
EVERY_OTHER_V = _FALSE
GHOST = _FALSE
Cls
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("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", _Display, "PNG"
i = i + 1
Case Asc("C"), Asc("c")
_ClipboardImage = _Display
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
Case Asc("5")
PALETTE_SWAP = 5
Case Asc("6")
PALETTE_SWAP = 6
Case Asc("Z"), Asc("z")
SendMessage childWin, WM_CAP_DLG_VIDEOSOURCE, 0, 0
Case Asc("\")
EVERY_OTHER_V = Not EVERY_OTHER_V
Cls
Case Asc("/")
EVERY_OTHER_H = Not EVERY_OTHER_H
Cls
Case Asc(";")
EVERY_OTHER_V = _TRUE
EVERY_OTHER_H = _TRUE
Case Asc("T"), Asc("t")
GHOST = Not GHOST
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
$Checking:On
Print "Disconnecting Driver"
KillDriver childWin
_MemFree frame
'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
If EVERY_OTHER_H Then y = y + 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
If Not EVERY_OTHER_V Then
PSet (x + 1, y), _ShR(converted, 32) And &HFFFFFFFF
End If
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
' 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) * COLOR_TEMP_WARM, 0, 255)
g1 = _Clamp((Y1 - 0.39465 * U - 0.58060 * V) * COLOR_GREEN, 0, 255)
b1 = _Clamp((Y1 + 2.03211 * U) * COLOR_TEMP_COOL, 0, 255)
' Convert second pixel
r2 = _Clamp((Y2 + 1.13983 * V) * COLOR_TEMP_WARM, 0, 255)
g2 = _Clamp((Y2 - 0.39465 * U - 0.58060 * V) * COLOR_GREEN, 0, 255)
b2 = _Clamp((Y2 + 2.03211 * U) * COLOR_TEMP_COOL, 0, 255)
If NEGATIVE Then
r1 = 255 - r1: g1 = 255 - g1: b1 = 255 - b1
r2 = 255 - r2: g2 = 255 - g2: b2 = 255 - b2
End If
If PALETTE_SWAP > 0 Then
Select Case PALETTE_SWAP
Case 1
''Dobra
r3 = _Clamp(r1 * 0.989 + g1 * 1.000 + b1 * 0.510, 0, 255)
g3 = _Clamp(r1 * 0.157 + g1 * 0.500 + b1 * 0.400, 0, 255)
b3 = _Clamp(r1 * 0.278 + g1 * 0.000 + b1 * 0.267, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.989 + g2 * 1.000 + b2 * 0.510, 0, 255)
g3 = _Clamp(r2 * 0.157 + g2 * 0.500 + b2 * 0.400, 0, 255)
b3 = _Clamp(r2 * 0.278 + g2 * 0.000 + b2 * 0.267, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 2
''Roden
r3 = _Clamp(r1 * 0.545 + g1 * 0.0902 + b1 * 0.804, 0, 255)
g3 = _Clamp(r1 * 0.412 + g1 * 0.502 + b1 * 0.522, 0, 255)
b3 = _Clamp(r1 * 0.412 + g1 * 0.427 + b1 * 0.247, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.545 + g2 * 0.0902 + b2 * 0.804, 0, 255)
g3 = _Clamp(r2 * 0.412 + g2 * 0.502 + b2 * 0.522, 0, 255)
b3 = _Clamp(r2 * 0.412 + g2 * 0.427 + b2 * 0.247, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 3
''Flowers
r3 = _Clamp(r1 * 0.753 + g1 * 1.000 + b1 * 0.000, 0, 255)
g3 = _Clamp(r1 * 0.000 + g1 * 1.000 + b1 * 0.000, 0, 255)
b3 = _Clamp(r1 * 0.000 + g1 * 1.000 + b1 * 1.000, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.753 + g2 * 1.000 + b2 * 0.000, 0, 255)
g3 = _Clamp(r2 * 0.000 + g2 * 1.000 + b2 * 0.000, 0, 255)
b3 = _Clamp(r2 * 0.000 + g2 * 1.000 + b2 * 1.000, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 4
''GBR
r3 = _Clamp(r1 * 0 + g1 * 0 + b1 * 1, 0, 255)
g3 = _Clamp(r1 * 1 + g1 * 0 + b1 * 0, 0, 255)
b3 = _Clamp(r1 * 0 + g1 * 1 + b1 * 0, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0 + g2 * 0 + b2 * 1, 0, 255)
g3 = _Clamp(r2 * 1 + g2 * 0 + b2 * 0, 0, 255)
b3 = _Clamp(r2 * 0 + g2 * 1 + b2 * 0, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 5
''Sepia
r3 = _Clamp((r1 * 0.393) + (g1 * 0.769) + (b1 * 0.189), 0, 255)
g3 = _Clamp((r1 * 0.349) + (g1 * 0.686) + (b1 * 0.168), 0, 255)
b3 = _Clamp((r1 * 0.272) + (g1 * 0.534) + (b1 * 0.131), 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp((r2 * 0.393) + (g2 * 0.769) + (b2 * 0.189), 0, 255)
g3 = _Clamp((r2 * 0.349) + (g2 * 0.686) + (b2 * 0.168), 0, 255)
b3 = _Clamp((r2 * 0.272) + (g2 * 0.534) + (b2 * 0.131), 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 6
''High contrast
r3 = _Clamp((r1 - 128) * 1.5 + 128, 0, 255)
g3 = _Clamp((g1 - 128) * 1.5 + 128, 0, 255)
b3 = _Clamp((b1 - 128) * 1.5 + 128, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp((r2 - 128) * 1.5 + 128, 0, 255)
g3 = _Clamp((g2 - 128) * 1.5 + 128, 0, 255)
b3 = _Clamp((b2 - 128) * 1.5 + 128, 0, 255)
r2 = r3
g2 = g3
b2 = b3
End Select
End If
' Pack pixels into a single return value
If GHOST Then
ConvertYUY2toRGB = _RGBA32(r1, g1, b1, 175) Or _ShL(_RGBA32(r2, g2, b2, 175), 32)
Else
ConvertYUY2toRGB = _RGB32(r1, g1, b1) Or _ShL(_RGB32(r2, g2, b2), 32)
End If
End Function
Tried capturing myself with ghosting enabled.
And a video showing the kind of retro effect you can get with the scanline effect, green cranked up, and ghosting enabled. You may need to watch the video in full-screen mode to see the effect properly.
The noticing will continue
Posts: 867
Threads: 122
Joined: Apr 2022
Reputation:
21
(03-02-2025, 01:45 AM)SpriggsySpriggs Wrote: The idea for making AVI using an image sequence would be a little silly at this point. Might as well make it from scratch from frame data and such. As for sending over TCP/IP, you'd probably want super low resolution and to use a good compression algorithm. Maybe _DEFLATE$. Remember, all the frame data is lossless.
Making an AVI from scratch from frame data seems like a non-trivial task, and I wasn't finding any QB64 examples, but lookie here - are Microsoft's APIs coming to the rescue once again? There's an example at
https://www.wischik.com/lu/programmer/avi_utils.html
that references "avi_utils.h". I'll have to give it a try...
Posts: 822
Threads: 35
Joined: Apr 2022
Reputation:
57
I don't think we'll be able to use that. It has interfaces and I have yet to get a single interface thing to work in QB64.
The noticing will continue
Posts: 867
Threads: 122
Joined: Apr 2022
Reputation:
21
(03-02-2025, 02:23 PM)SpriggsySpriggs Wrote: I don't think we'll be able to use that. It has interfaces and I have yet to get a single interface thing to work in QB64. Damn, cuz if @SpriggsySpriggs can't do it, I don't know who can! 
Maybe one of the usual suspects can help figure it out? (@Petr has done some nice work with sound files, so he'd be the horse I'd bet on for figuring out how to write an AVI from scratch - but that all depends on his actually being interested!)
Me, I'm just a lowly BASIC programmer, which is why I'd resort to something like FFMPEG to make a movie from still images! LoL
I'll post a seperate question for this, and see if anyone bites...
|
