Code archives/Graphics/Image FX - neighbour pixels

This code has been declared by its author to be Public Domain code.

Download source code

Image FX - neighbour pixels by Matt Merkulov2007
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