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 '