| |
Размытие картинки |
|
| |
Данный код демонстрирует размытие картинки.
На форму поместить Picture1 и в него какую нибудь картинку
'Option Explicit
Private Type TColorRGB
Red As Long
Green As Long
Blue As Long
End Type
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single,
y As Single)
If Button <> 1 Then Exit Sub
Dim a1 As TColorRGB
Dim b1 As TColorRGB
Rad = 10
For i = y - Rad To y + Rad
For j = x - Rad To x + Rad
n = 1 - (((j - x) / Rad) ^ 2 + ((i - y) / Rad) ^ 2)
If n <= 0 Then GoTo lab1
sr = 0
sg = 0
sb = 0
For o = i - 1 To i + 1
For k = j - 1 To j + 1
a = Picture1.Point(k, o)
a1 = LongToRGB(a)
sr = a1.Red + sr
sg = a1.Green + sg
sb = a1.Blue + sb
Next
Next
sr = sr / 9
sg = sg / 9
sb = sb / 9
a = Picture1.Point(j, i)
a1 = LongToRGB(a)
r = (sr - a1.Red) * (n) + a1.Red
g = (sg - a1.Green) * (n) + a1.Green
b = (sb - a1.Blue) * (n) + a1.Blue
If r < 0 Then r = 0
If g < 0 Then g = 0
If b < 0 Then b = 0
Picture1.PSet (j, i), RGB(r, g, b)
lab1:
Next
Next
End Sub
Private Function LongToRGB(ByVal Index As Long) As TColorRGB
LongToRGB.Red = Index And 255
LongToRGB.Green = (Index And 65280) \ 256
LongToRGB.Blue = (Index And 16711680) \ 65535
End Function
|
|
| |
|
|
|
|