Hello everyone! Today I will talk about yet another method of writing multithreaded programs on VB6, namely the creation of threads in the Native DLL. In principle, there is nothing complicated, passing the function "CreateThread" address exported function and it will be performed in another thread. All is good, but standard, documented features VB6 not create native DLL. But not all that bad, there are a few tricks you can use to create a native DLL, from the substitution of the linker and ending undocumented sections in vbp-file. Just last method we will use to create the DLL. First you need to decide what we all want from DLL, so you can use multithreading. The last time I did download the file, now I decided to pay attention to computing. Ie a new thread we will perform calculations, and the main thread will serve GUI. For the test I developed a DLL for working with graphics, or to be more precise in the DLL will be a function that converts bitmap - impose a variety of effects.
Once upon a time, when I started programming, and studied on the basis of convolution filters, then I really did not like the "slowness" of these techniques. It is now possible to thrust calculation in another thread without blocking the main. I created 10 functions to be exported:
  1. Brightness
  2. Contrast
  3. Saturation
  4. GaussianBlur
  5. EdgeDetect
  6. Sharpen
  7. Emboss
  8. Minimum
  9. Maximum
  10. FishEye

Code:
' modEffects.bas  - функции для обработки изображений
' © Кривоус Анатолий Анатольевич (The trick), 2014
 
Option Explicit
 
' Передаем эту структуру в поток
Private Type ThreadData
    pix()       As Byte     ' Двухмерный массив пикселей рисунка (w-1,h-1)
    value       As Single   ' Значение эффекта
    percent     As Single   ' Процент выполнения 0..1
End Type
 
' // Функция изменения яркости
Public Function Brightness(dat As ThreadData) As Long
    Dim col()   As Byte
    Dim x       As Long
    Dim y       As Long
    Dim tmp     As Long
    Dim value   As Single
    
    On Error GoTo ERRORLABEL
    
    value = dat.value
    If value < -1 Then value = -1
    If value > 1 Then value = 1
    
    ReDim col(255)
    
    For x = 0 To 255
        tmp = x + value * 255
        If tmp > 255 Then tmp = 255 Else If tmp < 0 Then tmp = 0
        col(x) = tmp
    Next
    
    For y = 0 To UBound(dat.pix, 2)
        For x = 0 To UBound(dat.pix, 1)
            dat.pix(x, y) = col(dat.pix(x, y))
        Next
        dat.percent = y / UBound(dat.pix, 2)
    Next
 
    dat.percent = 1
    Brightness = 1
    
ERRORLABEL:
 
End Function
 
' // Функция изменения контрастности
Public Function Contrast(dat As ThreadData) As Long
    Dim col()   As Byte
    Dim x       As Long
    Dim y       As Long
    Dim tmp     As Long
    Dim value   As Single
    
    On Error GoTo ERRORLABEL
    
    value = dat.value
    If value < 0 Then value = 0
    If value > 100 Then value = 100
    
    ReDim col(255)
    
    For x = 0 To 255
        tmp = 128 + (value ^ 3) * (x - 128)
        If tmp > 255 Then tmp = 255 Else If tmp < 0 Then tmp = 0
        col(x) = tmp
    Next
    
    For y = 0 To UBound(dat.pix, 2)
        For x = 0 To UBound(dat.pix, 1)
            dat.pix(x, y) = col(dat.pix(x, y))
        Next
        dat.percent = y / UBound(dat.pix, 2)
    Next
 
    dat.percent = 1
    Contrast = 1
    
ERRORLABEL:
 
End Function
 
' // Функция изменения насыщенности
Public Function Saturation(dat As ThreadData) As Long
    Dim x       As Long
    Dim y       As Long
    Dim w       As Long
    Dim h       As Long
    Dim tmp     As Long
    Dim r       As Long
    Dim g       As Long
    Dim b       As Long
    Dim br      As Long
    Dim value   As Single
    
    On Error GoTo ERRORLABEL
    
    value = dat.value
    If value > 1 Then value = 1
    If value < 0 Then value = 0
    
    w = UBound(dat.pix, 1) \ 4
    h = UBound(dat.pix, 2)
    
    For y = 0 To h
        For x = 0 To w
            b = dat.pix(x * 4, y)
            g = dat.pix(x * 4 + 1, y)
            r = dat.pix(x * 4 + 2, y)
            br = 0.3 * r + 0.59 * g + 0.11 * b
            r = r * value + br * (1 - value)
            g = g * value + br * (1 - value)
            b = b * value + br * (1 - value)
            dat.pix(x * 4, y) = b
            dat.pix(x * 4 + 1, y) = g
            dat.pix(x * 4 + 2, y) = r
        Next
        dat.percent = y / h
    Next
 
    dat.percent = 1
    Saturation = 1
    
ERRORLABEL:
 
End Function
 
' // Функция размытия по Гауссу
Public Function GaussianBlur(dat As ThreadData) As Long
    Dim kernel()    As Single
    Dim size        As Long
    Dim half        As Long
    Dim weight      As Long
    Dim gx          As Single
    Dim tmp()       As Byte
    Dim x           As Long
    Dim y           As Long
    Dim w           As Long
    Dim h           As Long
    Dim index       As Long
    Dim acc         As Long
    Dim wFrom       As Long
    Dim wTo         As Long
    Dim norm()      As Single
    Dim lnorm       As Single
    Dim px          As Long
    Dim value       As Single
    
    On Error GoTo ERRORLABEL
    
    value = dat.value
    If value < 0 Then value = 0
    If value > 255 Then value = 255
    
    size = CLng(value) * 2
    half = -Int(-size / 2)
    ReDim kernel(size)
    
    kernel(half) = 1
    ReDim norm(half)
    lnorm = 1
    For weight = 1 To half
        gx = 3 * weight / half
        kernel(half - weight) = Exp(-gx * gx / 2)
        kernel(half + weight) = kernel(half - weight)
        lnorm = lnorm + kernel(half + weight) * 2
    Next
    
    For x = 0 To half
        norm(x) = lnorm
        lnorm = lnorm - kernel(x)
    Next
    
    w = UBound(dat.pix, 1) \ 4
    h = UBound(dat.pix, 2)
    ReDim tmp(w * 4, h)
 
    For y = 0 To h
        For x = 0 To w - 1
            If x < half Then wFrom = x Else wFrom = half
            If x > w - half Then wTo = w - x Else wTo = half
            
            For px = 0 To 3
                acc = 0
                For index = -wFrom To wTo
                    acc = acc + dat.pix((x + index) * 4 + px, y) * kernel(index + half)
                Next
                acc = acc / norm(half * 2 - (wTo + wFrom))
                If acc > 255 Then acc = 255
                tmp(x * 4 + px, y) = acc
            Next
        Next
        dat.percent = y / h / 2
    Next
    
    For x = 0 To w - 1
        For y = 0 To h
            If y < half Then wFrom = y Else wFrom = half
            If y > h - half Then wTo = h - y Else wTo = half
            For px = 0 To 4
                acc = 0
                For index = -wFrom To wTo
                    acc = acc + tmp(x * 4 + px, y + index) * kernel(index + half)
                Next
                acc = acc / norm(half * 2 - (wTo + wFrom))
                If acc > 255 Then acc = 255
                dat.pix(x * 4 + px, y) = acc
            Next
        Next
        dat.percent = x / w / 2 + 0.5
    Next
    
    dat.percent = 1
    GaussianBlur = 1
    
ERRORLABEL:
    
End Function
 
' // Минимум
Public Function Minimum(dat As ThreadData) As Long
    Dim x       As Long
    Dim y       As Long
    Dim w       As Long
    Dim h       As Long
    Dim px      As Long
    Dim hlf     As Long
    Dim fx      As Long
    Dim fy      As Long
    Dim tx      As Long
    Dim ty      As Long
    Dim dx      As Long
    Dim dy      As Long
    Dim acc     As Byte
    Dim tmp()   As Byte
    Dim value   As Single
    
    On Error GoTo ERRORLABEL
    
    value = dat.value
    If value < 0 Then value = 0
    If value > 255 Then value = 255
    
    w = UBound(dat.pix, 1) \ 4
    h = UBound(dat.pix, 2)
    hlf = CLng(dat.value)
    tmp = dat.pix
    
    For y = 0 To h
    
        If y < hlf Then fy = y Else fy = hlf
        If y > h - hlf Then ty = h - y Else ty = hlf
        
        For x = 0 To w
        
            If x < hlf Then fx = x Else fx = hlf
            If x > w - hlf Then tx = w - x Else tx = hlf
            
            For px = 0 To 3
                acc = 255
                
                For dx = -fx To tx: For dy = -fy To ty
                    If tmp((x + dx) * 4 + px, y + dy) < acc Then acc = tmp((x + dx) * 4 + px, y + dy)
                Next: Next
                
                dat.pix(x * 4 + px, y) = acc
                
            Next
            
        Next
        
        dat.percent = y / h
        
    Next
    
    dat.percent = 1
    Minimum = 1
    
ERRORLABEL:
    
End Function
 
' // Максимум
Public Function Maximum(dat As ThreadData) As Long
    Dim x       As Long
    Dim y       As Long
    Dim w       As Long
    Dim h       As Long
    Dim px      As Long
    Dim hlf     As Long
    Dim fx      As Long
    Dim fy      As Long
    Dim tx      As Long
    Dim ty      As Long
    Dim dx      As Long
    Dim dy      As Long
    Dim acc     As Byte
    Dim tmp()   As Byte
    Dim value   As Single
    
    On Error GoTo ERRORLABEL
    
    value = dat.value
    If value < 0 Then value = 0
    If value > 255 Then value = 255
 
    w = UBound(dat.pix, 1) \ 4
    h = UBound(dat.pix, 2)
    hlf = CLng(dat.value)
    tmp = dat.pix
    
    For y = 0 To h
    
        If y < hlf Then fy = y Else fy = hlf
        If y > h - hlf Then ty = h - y Else ty = hlf
        
        For x = 0 To w
        
            If x < hlf Then fx = x Else fx = hlf
            If x > w - hlf Then tx = w - x Else tx = hlf
            
            For px = 0 To 3
                acc = 0
                
                For dx = -fx To tx: For dy = -fy To ty
                    If tmp((x + dx) * 4 + px, y + dy) > acc Then acc = tmp((x + dx) * 4 + px, y + dy)
                Next: Next
                
                dat.pix(x * 4 + px, y) = acc
                
            Next
            
        Next
        
        dat.percent = y / h
        
    Next
    
    dat.percent = 1
    Maximum = 1
    
ERRORLABEL:
    
End Function
 
' // Тиснение
Public Function Emboss(dat As ThreadData) As Long
    Dim kernel()    As Single
    Dim value       As Single
    
    value = dat.value
    ReDim kernel(2, 2)
    
    kernel(0, 0) = -value ^ 2:  kernel(1, 0) = -value:          kernel(2, 0) = 0
    kernel(0, 1) = -value:      kernel(1, 1) = 9:               kernel(2, 1) = value
    kernel(0, 2) = 0:           kernel(1, 2) = value:           kernel(2, 2) = value ^ 2
    
    Emboss = Convolution(dat, kernel)
End Function
 
' // Выделение краев
Public Function EdgeDetect(dat As ThreadData) As Long
    Dim kernel() As Single
    Dim value       As Single
    
    value = dat.value
    ReDim kernel(2, 2)
    
    kernel(0, 0) = 0:           kernel(1, 0) = -value:          kernel(2, 0) = 0
    kernel(0, 1) = -value:      kernel(1, 1) = value * 4:       kernel(2, 1) = -value
    kernel(0, 2) = 0:           kernel(1, 2) = -value:          kernel(2, 2) = 0
    
    EdgeDetect = Convolution(dat, kernel)
 
End Function
 
' // Резкость
Public Function Sharpen(dat As ThreadData) As Long
    Dim kernel()    As Single
    Dim value       As Single
    
    value = dat.value
    ReDim kernel(2, 2)
    
    kernel(0, 0) = 0:           kernel(1, 0) = -value:          kernel(2, 0) = 0
    kernel(0, 1) = -value:      kernel(1, 1) = value * 4 + 9:   kernel(2, 1) = -value
    kernel(0, 2) = 0:           kernel(1, 2) = -value:          kernel(2, 2) = 0
    
    Sharpen = Convolution(dat, kernel)
 
End Function
 
' // Рыбий глаз
Public Function FishEye(dat As ThreadData) As Long
    Dim x       As Long
    Dim y       As Long
    Dim cx      As Single
    Dim cy      As Single
    Dim nx      As Long
    Dim ny      As Long
    Dim r       As Single
    Dim tmp()   As Byte
    Dim w       As Long
    Dim h       As Long
    Dim value   As Single
    Dim px      As Long
    
    On Error GoTo ERRORLABEL
    
    w = UBound(dat.pix, 1) \ 4 + 1
    h = UBound(dat.pix, 2) + 1
    value = dat.value
    
    If value > 1 Then value = 1
    If value < 0 Then value = 0
    
    tmp = dat.pix
    
    For y = 0 To h - 1
        For x = 0 To w - 1
            cx = x / w - 0.5: cy = y / h - 0.5
            r = Sqr(cx * cx + cy * cy)
            nx = (cx + 0.5 + value * cx * ((r - 1) / 0.5)) * (w - 1)
            ny = (cy + 0.5 + value * cy * ((r - 1) / 0.5)) * (h - 1)
            For px = 0 To 3
                dat.pix(x * 4 + px, y) = tmp(nx * 4 + px, ny)
            Next
        Next
        dat.percent = y / h
    Next
    
    dat.percent = 1
    FishEye = 1
    
ERRORLABEL:
End Function
 
' // Фильтрация с помощью свертки
Private Function Convolution(dat As ThreadData, kernel() As Single) As Long
    Dim x       As Long
    Dim y       As Long
    Dim w       As Long
    Dim h       As Long
    Dim dx      As Long
    Dim dy      As Long
    Dim tmp()   As Byte
    Dim valFx   As Long
    Dim valFy   As Long
    Dim valTx   As Long
    Dim valTy   As Long
    Dim acc     As Long
    Dim px      As Long
    Dim hlfSize As Long
    
    On Error GoTo ERRORLABEL
    
    w = UBound(dat.pix, 1)
    h = UBound(dat.pix, 2)
    hlfSize = UBound(kernel) \ 2
    
    tmp = dat.pix
    
    For y = 0 To h
        If y < hlfSize Then valFy = y Else valFy = hlfSize
        If y > h - hlfSize Then valTy = h - y Else valTy = hlfSize
        For x = 0 To w
            px = x \ 4
            If px < hlfSize Then valFx = px Else valFx = hlfSize
            If px > w \ 4 - hlfSize Then valTx = w \ 4 - px Else valTx = hlfSize
            acc = 0
            For dy = -valFy To valTy
                For dx = -valFx To valTx
                    acc = acc + tmp(x + dx * 4, y + dy) * kernel(dx + hlfSize, dy + hlfSize)
                Next
            Next
            acc = acc \ ((valFx + valTx + 1) * (valFy + valTy + 1))
            If acc > 255 Then acc = 255 Else If acc < 0 Then acc = 0
            dat.pix(x, y) = acc
        Next
        dat.percent = y / h
    Next
    
    Convolution = 1
    dat.percent = 1
ERRORLABEL:
    
End Function '