Всем привет, в 2003 году я занимался созданием своего видеокодека, была мечта передавать видео через обычный 56k модем, который так и остался мечтой. Так-же была возможность проигрывать видео по сети. Видеоплеер выглядел вот так:

Вот сам код на VB6, для проигрывания видео файла, но я забыл уже что тут к чему, но алгоритм простой, читаешь сколько-то байтов из файла, получаешь код цвета, и отображаешь их спомощью SetPixelV:

Option Explicit
Public VideoSeting As Integer
Public videomem(350, 40000) As Long
Public pos(100000) As Long
Public wsz As Long
Public Type Images
    sRGB As Long
    cmd As Byte
End Type

Public Type fileInfo
    frameWidth As Long
    frameHeigh As Long
    framesCount As Long
End Type

Public Type sysInfo
    sysErr As Boolean
    sysFrame As Long
    sysPrevFrame As Long
    sysCache As Long
    sysFrameCant As Long
End Type

Public fileinf As fileInfo
Public sysinf As sysInfo
Public frame As Long

Public v As Long
Public cache As Long
Public img As Images
Public ToHdc As Long
Public ToPic As Form
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Sub Quadrat(ByVal x As Integer, ByVal y As Integer, ByVal sstep As Integer, ByVal clr As Long)
Dim n As Integer, m As Integer, sx As Single, sy As Single

If VideoSeting = 1 Then
    sx = 7 + (5.5 - Rnd * 9.5) + 2
Else
    sx = 1
GoTo STEP
End If
STEP:
    For n = 0 To sstep Step Round(sx)
        If n > frmVideo.Height Then Exit Sub
        For m = 0 To sstep Step 16
            SetPixelV ToHdc, x + m, y + n, clr
            SetPixelV ToHdc, x + m + 1, y + n, clr
            SetPixelV ToHdc, x + m + 2, y + n, clr
            SetPixelV ToHdc, x + m + 3, y + n, clr
            SetPixelV ToHdc, x + m + 4, y + n, clr
            SetPixelV ToHdc, x + m + 5, y + n, clr
            SetPixelV ToHdc, x + m + 6, y + n, clr
            SetPixelV ToHdc, x + m + 7, y + n, clr
            SetPixelV ToHdc, x + m + 8, y + n, clr
            SetPixelV ToHdc, x + m + 9, y + n, clr
            SetPixelV ToHdc, x + m + 10, y + n, clr
            SetPixelV ToHdc, x + m + 11, y + n, clr
            SetPixelV ToHdc, x + m + 12, y + n, clr
            SetPixelV ToHdc, x + m + 13, y + n, clr
            SetPixelV ToHdc, x + m + 14, y + n, clr
            SetPixelV ToHdc, x + m + 15, y + n, clr
        Next m
    Next n
End Sub


Public Sub Quadrat2(ByVal x As Long, ByVal y As Long, ByVal clr As Long)
    SetPixelV ToHdc, x, y, clr
    SetPixelV ToHdc, x + 1, y, clr
    
    SetPixelV ToHdc, x, y + 1, clr
    SetPixelV ToHdc, x + 1, y + 1, clr

    SetPixelV ToHdc, x + 2, y + 2, clr
    SetPixelV ToHdc, x + 3, y + 2, clr

    SetPixelV ToHdc, x + 2, y + 3, clr
    SetPixelV ToHdc, x + 3, y + 3, clr
End Sub

Public Sub AllReset()
frame = 0
v = 1
End Sub

Public Sub ShowFrame(tm As Timer)
Dim i As Long, j As Long, n As Long
cache = cache + 1
If cache >= 99 Then cache = 0
    For j = 0 To 600 Step 9
        For i = 0 To 600 Step 9
START:
            Get #1, v, img
            v = v + 1
            sysinf.sysCache = cache
            sysinf.sysFrame = frame + 1
            If img.cmd = 0 Then v = 1: tm.Enabled = False
            If img.sRGB > 200 Then videomem(cache, n) = img.sRGB
            SetPixelV ToHdc, i / 5, j / 5, videomem(cache, n)
            SetPixelV ToHdc, 1 + i / 5, j / 5, videomem(cache, n)
            SetPixelV ToHdc, i / 5, 1 + j / 5, videomem(cache, n)
            SetPixelV ToHdc, 1 + i / 5, 1 + j / 5, videomem(cache, n)


            SetPixelV ToHdc, 2 + i / 5, 2 + j / 5, videomem(cache, n)
            SetPixelV ToHdc, 3 + i / 5, 2 + j / 5, videomem(cache, n)
            SetPixelV ToHdc, 2 + i / 5, 3 + j / 5, videomem(cache, n)
            SetPixelV ToHdc, 3 + i / 5, 3 + j / 5, videomem(cache, n)
            n = n + 1
        Next i
    Next j
    On Error Resume Next
    pos(frame) = n + pos(frame - 1)
    frame = frame + 1
    pos(frame) = n + pos(frame - 1)
    frame = frame + 1
End Sub

Function CountFrames() As Long
Dim i As Long, j As Long, n As Long
Dim frm As Long
Dim ccc As Long
n = 1
Get #1, n, img
If img.cmd = 110 And img.sRGB = 1000 Then
    MsgBox "Данный кодек отсутствует:" & "IMG-PRO v2.5"
    frmMain.cmdPlay.Enabled = False
    Exit Function
End If
If img.cmd <> 100 Then
    MsgBox "Информация о количестве кадров найдена не была. После подсчёта будет сохранено количество кадров."
Else
    CountFrames = img.sRGB
    Exit Function
End If

Do While Not EOF(1)
    For j = 0 To 600 Step 9
        For i = 0 To 600 Step 9
            ccc = ccc + 1
            If ccc > 100000 Then ccc = 0: DoEvents
            Get #1, n, img
            n = n + 1
            Get #1, n, img
            n = n + 1
            Get #1, n, img
            n = n + 1
            Get #1, n, img
            n = n + 1
            Get #1, n, img
            n = n + 1
        Next i
    Next j
    pos(frm) = n / 5
    frm = frm + 2
    pos(frm) = n / 4
    frm = frm + 2
    pos(frm) = n / 3
    frm = frm + 2
    pos(frm) = n / 2
    frm = frm + 2
    pos(frm) = n
    frm = frm + 2
    frmMain.Label1.Caption = "Подсчет кадров:" & frm
Loop
Seek #1, 1
CountFrames = frm
img.cmd = 100
img.sRGB = frm
Put #1, 1, img
End Function

Public Sub DrawFrame(ByVal cache As Long)
Dim i As Long, j As Long, n As Long
    For j = 0 To 300 Step 9
        For i = 0 To 300 Step 9
            sysinf.sysCache = cache
            sysinf.sysFrame = frame
            Quadrat i, j, 9, videomem(cache, n)
            n = n + 1
        Next i
    Next j
frame = frame + 1
End Sub

Public Sub DrawFrame2(ByVal cache As Long)
Dim i As Long, j As Long, n As Long
    For j = 0 To 300 Step 9
        For i = 0 To 300 Step 9
            Quadrat i, j, 9, videomem(cache, n)
            n = n + 1
        Next i
    Next j
End Sub

Public Sub Sleep()
Dim j As Long, i As Long, n As Long
    For i = 0 To 1000
        For j = 0 To 100
            For n = 0 To 10
                Sin 3
            Next n
        Next j
    Next i
End Sub

Результат работы программы, т.е. проигрывание видео:

Если я кому-то отвечаю, это не значит что я ему симпатизирую, каждый остаётся при своём мнение Дневник тяжелобольного инвалида