@rc2k17
I like the idea to use ResizeImage to create a pixelation effect.
I found that using the #PB_Image_Raw mode when resizing works better in my opinion.
I have expanded the code to make it easier to demonstrate and test this method.
Also, this version of code maintains the original image size.
Code: Select all
; http://www.purebasic.fr/english/viewtopic.php?f=12&t=69558
; It creates a pixelate effect from just simple code.
; original idea by Raul Clifton - aka - rc2k17
; this version by BasicallyPure 11/10/2017
EnableExplicit
UseJPEGImageDecoder()
UsePNGImageDecoder()
Enumeration ; images
#imgRef : #imgPixelated
EndEnumeration
Enumeration ;menu items
#Load : #Copy : #Pixelate : #Minimize : #Quit
EndEnumeration
Procedure PIXELATE_IMAGE(image, value)
Protected ImgW, ImgH, result
If value < 1 : value = 1 : EndIf
If IsImage(image)
ImgW = ImageWidth(image)
ImgH = ImageHeight(image)
If ResizeImage(image, ImgW / value , ImgH / value)
If ResizeImage(image,ImgW,ImgH,#PB_Image_Raw) ;<-- #PB_Image_Raw works best
result = #True
EndIf
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure LOAD_IMAGE()
Protected result, File$
Static Path$ = ""
File$ = OpenFileRequester("Please choose an image.", Path$, "*.jpg|*.jpg|*.png|*.png|*.bmp|*.bmp|*.*|*.*", 0)
If File$
result = LoadImage(#imgRef, File$)
If result
Path$ = GetPathPart(File$)
If IsImage(#imgPixelated) : FreeImage(#imgPixelated) : EndIf
EndIf
EndIf
ProcedureReturn result
EndProcedure
Procedure CHOOSE_VALUE()
Static value = 10, value$ = "10"
value$ = InputRequester("Choose value","Enter a pixelation value ",value$)
If value$
value = Val(value$)
Else
value$ = Str(value)
EndIf
ProcedureReturn value
EndProcedure
OpenWindow(0,0,0,640,480,"Pixelation_Effect", #PB_Window_BorderLess | #PB_Window_Maximize)
SetWindowColor(0,$808080)
CreatePopupMenu(1)
;MenuTitle("Action")
MenuItem(#Load,"Load image")
MenuItem(#Copy,"Copy to clipboard")
MenuItem(#Pixelate,"pixelate")
MenuItem(#Minimize,"Minimize")
MenuItem(#Quit,"Quit")
ImageGadget(0,0,0,1,1,0)
If CreateImage(#imgRef,250,50,24,$808080)
StartDrawing(ImageOutput(#imgRef))
DrawText(10,10," Right click for menu ")
StopDrawing()
SetGadgetState(0,ImageID(#imgRef))
EndIf
Define.i quit = #False
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
quit = #True
Case #PB_Event_RightClick
DisplayPopupMenu(1,WindowID(0))
Case #PB_Event_Gadget
If EventGadget() = 0 And EventType() = #PB_EventType_RightClick
DisplayPopupMenu(1,WindowID(0))
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case #Load
If LOAD_IMAGE()
SetGadgetState(0,ImageID(#imgRef))
EndIf
Case #Copy
If IsImage(#imgPixelated)
SetClipboardImage(#imgPixelated)
ElseIf IsImage(#imgRef)
SetClipboardImage(#imgRef)
EndIf
Case #Pixelate
If IsImage(#imgRef)
CopyImage(#imgRef,#imgPixelated)
If PIXELATE_IMAGE(#imgPixelated, CHOOSE_VALUE())
SetGadgetState(0,ImageID(#imgPixelated))
EndIf
EndIf
Case #Minimize
SetWindowState(0,#PB_Window_Minimize)
Case #Quit
quit = #True
EndSelect
EndSelect
Until quit = #True