Deutsch

Воспоминания свой кодек на VB6, 15.05.2024

15.05.24 23:00
Re: Воспоминания свой кодек на VB6, 15.05.2024
 
uscheswoi_82 коренной житель
uscheswoi_82

Я в своём кодеке использовал функцию SetPixelV, потому-что эта функция самая быстрая.

Проведём небольшой эксперимент, вот код Form1.frm:

Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, 
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020

Private Sub Form_Click()
    Dim s As String
    Dim dt As Date, dt2 As Date
    Dim v As Long, x As Long, y As Long
    Dim r As Integer, g As Integer, b As Integer
    
    Me.Cls
    dt = Now
    For y = 0 To Me.ScaleHeight
        For x = 0 To Me.ScaleWidth
            r = Int(Rnd * 255)
            g = Int(Rnd * 255)
            b = Int(Rnd * 255)
            Me.PSet (x, y), RGB(r, g, b)
            DoEvents
        Next x
    Next y
    
    dt2 = Now
    v = DateDiff("s", dt, dt2)
    s = s + "PSET " + CStr(v)
    Me.Caption = s
    
    Me.Cls
    dt = Now
    For y = 0 To Me.ScaleHeight
        For x = 0 To Me.ScaleWidth
            r = Int(Rnd * 255)
            g = Int(Rnd * 255)
            b = Int(Rnd * 255)
            SetPixel Me.hdc, x, y, RGB(r, g, b)
            DoEvents
        Next x
    Next y
    
    dt2 = Now
    v = DateDiff("s", dt, dt2)
    s = s + ", SETPIXEL " + CStr(v)
    Me.Caption = s
    
    Me.Cls
    dt = Now
    For y = 0 To Me.ScaleHeight
        For x = 0 To Me.ScaleWidth
            r = Int(Rnd * 255)
            g = Int(Rnd * 255)
            b = Int(Rnd * 255)
            SetPixelV Me.hdc, x, y, RGB(r, g, b)
            DoEvents
        Next x
    Next y
    
    dt2 = Now
    v = DateDiff("s", dt, dt2)
    s = s + ", SETPIXELV " + CStr(v)
    Me.Caption = s
    
    Me.Picture1.Visible = True
    Me.Cls
    dt = Now
    For y = 0 To Me.ScaleHeight
        For x = 0 To Me.ScaleWidth
            r = Int(Rnd * 255)
            g = Int(Rnd * 255)
            b = Int(Rnd * 255)
            Me.Picture1.BackColor = RGB(r, g, b)
            BitBlt Me.hdc, x, y, 1, 1, Me.Picture1.hdc, 0, 0, SRCCOPY
            DoEvents
        Next x
    Next y
    
    dt2 = Now
    v = DateDiff("s", dt, dt2)
    s = s + ", BITBLT " + CStr(v)
    Me.Caption = s
End Sub

Private Sub Form_Load()
    Me.Picture1.Width = 1
    Me.Picture1.Height = 1
    Me.Picture1.Visible = False
    Me.WindowState = vbMaximized
End Sub


Результаты 1980x1080, pset 21 сек., SetPixel 11 сек., SetPixelV 10 сек., BitBlt 44 сек.:



Анимация, работа теста, 640x480, результат Pset 4, SetPixel 2, SetPixelV 2, BitBlt 9:



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

Перейти на