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:
- Brightness
- Contrast
- Saturation
- GaussianBlur
- EdgeDetect
- Sharpen
- Emboss
- Minimum
- Maximum
- 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 '