Code archives/Graphics/Image FX - neighbour pixels
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
From Blitz et cetera article Image used: | |||||
;Blur, diffusion, emboss image FX by Matt Merkulov ;Const wid = 2, fx = 1 ;Const wid = 2, fx = 2 Const wid = 2, fx = 3 Const k1 = (wid * 2 + 1) ^ 2, k2 = (wid + 1) ^ 2 - 1 Graphics 640,480,32 i = LoadImage("image3.jpg") DrawBlock i, 0,0 ib = ImageBuffer(i) LockBuffer ib Color 0,0,0 k3 = 1 For n = 0 To wid - 1 Rect n, n, 640 - n * 2,480 - n * 2,0 k3 = k3 + (n + 2) * (n + 2) Next For y = wid To 479 - wid For x = wid To 639 - wid r = 0:g = 0:b = 0 Select fx Case 1;Blur For xx = -wid To wid For yy = -wid To wid p = ReadPixelFast(x + xx, y + yy, ib) r = r + ((p Shr 16) And 255) g = g + ((p Shr 8) And 255) b = b + (p And 255) Next Next WritePixel x, y, Int(b / k1) + Int(g / k1) Shl 8 + Int(r / k1) Shl 16 Case 2;Diffusion WritePixel x, y, ReadPixelFast(x + Rand(-wid, wid), y + Rand(-wid, wid), ib) Case 3;Emboss k = 0 For xx = -wid To 0 For yy = -wid To 0 p = ReadPixelFast(x + xx, y + yy, ib) r = (p Shr 16) And 255 g = (p Shr 8) And 255 b = p And 255 c = .35 * r + .45 * g + .2 * b If xx + yy = 0 Then k = (c - k / k2 + 255) Sar 1 Else k = k + c Next Next If k < 0 Then k = 0 If k > 255 Then k = 255 WritePixel x, y, k * 65793 End Select Next Next WaitKey |
Comments
None.
Code Archives Forum