Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Webcam API w/ Filters and Adjustments
#21
tranny kpop matrix mod

Code: (Select All)

deflng a-z
'Option _Explicit bubu
'$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 ptype
    c as string * 1
    d as long
    img as long
end type
n = 126-32
dim p(n) as ptype
dim z as _unsigned long

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

''''''''''''
for i=0 to n
    p(i).img = _newimage(8, 16, 32)

    _dest p(i).img
    _source p(i).img

    _printstring (0,0), chr$(i + 32)
    p(i).c = chr$(i + 32)

    sum = 0
    for y=0 to 16-1
    for x=0 to 8-1
        z = point(x, y)
        'pset (x, y), z

        if point(x,y)=_rgb(255,255,255) then sum = sum + 1
    next
    next

    p(i).d = sum
next

for i=1 to ubound(p)
    j = i
    do while (j>0 and p(j-1).d > p(j).d)
        swap p(j), p(j-1)
        j = j - 1
    loop
next

_dest 0
_source 0
'''''''''''''

_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 As _Integer64 k
Dim As MSG msg
'Dim As Long i
Dim Shared As _MEM frame

'$Checking:Off
Do
    k = _KeyHit
    If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
        TranslateMessage _Offset(msg)
        DispatchMessage _Offset(msg)
    Else
        GrabFrame childWin
    End If
    'Screen frame.IMAGE

w = _width(0)
h = _height(0)
_source 0
for y=0 to h/16 - 1
for x=0 to w/8 - 1

    '0.299r + 0.587g + 0.114b
   
    z = point(x*8 + 4, y*16 + 8)
    'z2 = point(x*8 + 4, y*16 + 4)

    r = _red(z)
    g = _blue(z)
    b = _green(z)

    c = 0.299*r + 0.587*g + 0.114*b
    c = (c/255)*n

    'circle (x*8 + 4, y*16 + 8), 3, z
   
    color z ', z2
    'if c > 1*n/4 then
        _printstring (x*8, y*16), p(c).c
    'end if

next
next



    _Display
    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
    _Limit FPS
Loop
'$Checking:On
Print "Disconnecting Driver"
KillDriver childWin


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)
    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
    If _MemExists(frame) Then _MemFree frame
    'Dim As Long i: i = _NewImage(bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 32)
    frame = _MemImage(0)
    Dim As _Offset o: o = frame.OFFSET
    For y = 0 To bi.bmiHeader.biHeight - 1
        If o >= frame.OFFSET + frame.SIZE Then Exit For
        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())

            _MemPut frame, o, _Blue32(converted) As _UNSIGNED _BYTE
            _MemPut frame, o + 1, _Green32(converted) As _UNSIGNED _BYTE
            _MemPut frame, o + 2, _Red32(converted) As _UNSIGNED _BYTE
            'PSet (x, y), converted And &HFFFFFFFF
            o = o + bytesPerPixel + 2
            If Not EVERY_OTHER_V Then
                'PSet (x + 1, y), _ShR(converted, 32) And &HFFFFFFFF
                _MemPut frame, o, _Blue32(_ShR(converted, 32) And &HFFFFFFFF) As _UNSIGNED _BYTE
                _MemPut frame, o + 1, _Green32(_ShR(converted, 32) And &HFFFFFFFF) As _UNSIGNED _BYTE
                _MemPut frame, o + 2, _Red32(_ShR(converted, 32) And &HFFFFFFFF) As _UNSIGNED _BYTE
                o = o + bytesPerPixel + 2
            Else
                o = o + 4
            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
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
Reply
#22
(03-05-2025, 04:39 AM)vince Wrote: tranny kpop matrix mod
...

I look forward to giving this a try, thanks for sharing!

PS are you sure this won't violate the president's no-DEI order? Tongue

PPS that was a joke, I am not looking to talk politics! LoL
Reply
#23
(03-05-2025, 04:39 AM)vince Wrote: tranny kpop matrix mod

I did give this a try, nice! Video to ASCII in realtime! That was on my "to do" list!

Question - did you assign a brightness value to the different ASCII characters, or are they just arbitrarily selected?

I have been meaning to write a simple prog to go through the printable ASCII characters and for each, _PRINTSTRING it to the screen and count the pixels, the # being its "brightness", and save that score, then at the end sort them by score. Then the picture-to-ascii matches the brightness of each pixel (or a given block of pixels) to be approximated by an ASCII char, and does a lookup in the array to find a character with the corresponding brightness.

In the time it took me to write that explanation I could have finished the code, LOL, but it did help clarify it in my mind.
Reply




Users browsing this thread: 27 Guest(s)