November 28, 2020, 11:02:12 AM

Author Topic: [bb] Image shader by bytecode77 [ 1+ years ago ]  (Read 845 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Image shader by bytecode77 [ 1+ years ago ]
« on: June 29, 2017, 12:28:43 AM »
Title : Image shader
Author : bytecode77
Posted : 1+ years ago

Description : an image shader i have been working on(for 20 minutes ;-) )
if you wanna see more, click here: <a href="http://projects.dev-ch.com/index.php?article=stuff_imageshader" target="_blank">http://projects.dev-ch.com/index.php?article=stuff_imageshader[/url]


Code :
Code: BlitzBasic
  1. Graphics 1024, 768, 32, 2
  2. SetBuffer BackBuffer()
  3. SetFont LoadFont("Arial", 15)
  4. HidePointer
  5.  
  6. BG = LoadImage("Forest.jpg")
  7. Img = CreateImage(100, 100)
  8.  
  9. num = 1
  10. While Not KeyHit(1)
  11.         DrawBlock BG, 0, 0
  12.         Color 0, 0, 0
  13.         Rect 0, 0, GraphicsWidth(), 20
  14.         Color 255, 255, 255
  15.         Text 10, 2, "Press keys 1-10 and move the mouse to see the effects."
  16.         mx = MouseX() - 50
  17.         my = MouseY() - 50
  18.         CopyRect mx, my, 100, 100, 0, 0, BackBuffer(), ImageBuffer(Img)
  19.         For i = 1 To 4
  20.                 If KeyHit(i + 1) Then num = i
  21.         Next
  22.         Select num
  23.                 Case 1: ShadeImage(Img, "Negative")
  24.                 Case 2: ShadeImage(Img, "Greyscale")
  25.                 Case 3: ShadeImage(Img, "1Bit")
  26.                 Case 4: ShadeImage(Img, "Blur", 3)
  27.         End Select
  28.         DrawBlock Img, mx, my
  29.         Rect mx, my, 100, 100, False
  30.         Flip
  31. Wend
  32. End
  33.  
  34. Dim Pix(-1, -1, -1)
  35. Function ShadeImage(img, effect$, param1 = 0)
  36. w = ImageWidth(img) - 1
  37. h = ImageHeight(img) - 1
  38. ib = ImageBuffer(img)
  39. LockBuffer ib
  40. Select Lower(effect$)
  41.         Case "negative" ;Negative
  42.                 For x = 0 To w
  43.                         For y = 0 To h
  44.                                 rgb = ReadPixelFast(x, y, ib)
  45.                                 WritePixelFast x, y, (255 - (rgb And $FF0000) / $10000) * $10000 + (255 - (rgb And $FF00) / $100) * $100 + (255 - rgb And $FF), ib
  46.                         Next
  47.                 Next
  48.         Case "greyscale" ;Greyscale
  49.                 For x = 0 To w
  50.                         For y = 0 To h
  51.                                 rgb = ReadPixelFast(x, y, ib)
  52.                                 col = Float((rgb And $FF0000) / $10000 + (rgb And $FF00) / $100 + (rgb And $FF)) / 3.0
  53.                                 WritePixelFast x, y, col * $10000 + col * $100 + col, ib
  54.                         Next
  55.                 Next
  56.         Case "1bit" ;Black/white
  57.                 For x = 0 To w
  58.                         For y = 0 To h
  59.                                 rgb = ReadPixelFast(x, y, ib)
  60.                                 col = (Float((rgb And $FF0000) / $10000 + (rgb And $FF00) / $100 + (rgb And $FF)) / 3.0 > 127) * 255
  61.                                 WritePixelFast x, y, col * $10000 + col * $100 + col, ib
  62.                         Next
  63.                 Next
  64.         Case "blur" ;Blur - param1 is the blur radius.
  65.                 Dim Pix(w, h, 2)
  66.                 For x = 0 To w
  67.                         For y = 0 To h
  68.                                 rgb = ReadPixelFast(x, y, ib)
  69.                                 Pix(x, y, 0) = (rgb And $FF0000) / $10000
  70.                                 Pix(x, y, 1) = (rgb And $FF00) / $100
  71.                                 Pix(x, y, 2) = rgb And $FF
  72.                         Next
  73.                 Next
  74.                 For x = 0 To w
  75.                         For y = 0 To h
  76.                                 r = 0
  77.                                 g = 0
  78.                                 b = 0
  79.                                 For x2 = -param1 To param1
  80.                                         For y2 = -param1 To param1
  81.                                                 rx = x + x2
  82.                                                 ry = y + y2
  83.                                                 If rx < 0 Then rx = 0
  84.                                                 If rx > w Then rx = w
  85.                                                 If ry < 0 Then ry = 0
  86.                                                 If ry > h Then ry = h
  87.                                                 r = r + Pix(rx, ry, 0)
  88.                                                 g = g + Pix(rx, ry, 1)
  89.                                                 b = b + Pix(rx, ry, 2)
  90.                                         Next
  91.                                 Next
  92.                                 div = (param1 * 2 + 1) ^ 2
  93.                                 r = r / div
  94.                                 g = g / div
  95.                                 b = b / div
  96.                                 WritePixelFast x, y, r * $10000 + g * $100 + b, ib
  97.                         Next
  98.                 Next
  99.         Default
  100.                 RuntimeError "Image shading effect not found."
  101. End Select
  102. UnlockBuffer ib
  103. End Function


Comments :


thelizardking(Posted 1+ years ago)

 dude, thats freaking awsome! when i saw all the rectangles from the mouse, im like WTF?!?! but then i move the mouse over the picture of weirdness, and holy mikel jackson, it works!! this is soo cool!


Torrente(Posted 1+ years ago)

 That's pretty neat!It's fast too, except for the blur effect.


Fuller(Posted 1+ years ago)

 Awesome!


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal