Code archives/Graphics/Pixelate

This code has not been declared by its author to be Public Domain code, and therefore should not be assumed to be so.

Download source code

Pixelate by Unknown
(Posted 25 years ago)
This routine increases/decreases the resolution of an image while keeping its size intact. It requires no arrays/banks and is capable of doing full screen effects. Enjoy!

The Prof.
; Pixelate v0.3 By The Prof (15% faster)- For Blitzers Everywhere!
; 
Graphics 640,480,16
SetBuffer BackBuffer()
Global Pic=LoadImage("c:\windows\desktop\class56.jpg") ; <- put your image in here

; ****** MAIN ****** 
Demo
End

; ********************************************************

Function Demo()
; This little routine shows how to manipulate the image
; from hi-res to low-res.
DrawBlock Pic,0,0
Color 255,255,255:Text 150,400,"Any key to start - Esc to quit"
Flip:Cls:WaitKey:Flip:Cls
DeRes=True
Repeat
  If DeRes=True
    Res=Res+1
    If res=75
      DeRes=False
   EndIf
Else If DeRes=False
   Res=Res-1
   If Res=1
     DeRes=True
   End If
End If

Pixelate(Pic,0,0,Res)

Flip:Cls
Until KeyHit(1)
End Function

; ********************************************************

Function Pixelate(ImageID,XPos,YPos,Res)
; Pixelate V0.3 By The Prof (15% Faster) - Last compiled 13/10/01 - 23:15
;
; This function pixelates (decreases & increases) the resolution
; of an image without increasing its original size. This version
; requires no arrays/banks etc as everything is calculated in realtime :-)
; It is capable of doing full screens although a hefty cpu is required. 
;
; PARAMETERS:
; ImageID - The Image you want to Pixelate - must be loaded in first!
; XPos,YPos - Where you want the pixelated image to display
; Res - is the resolution of the new image (2 to whatever)
;
Width=ImageWidth(ImageID):Height=ImageHeight(ImageID)
RectsWidth=Int(Width/Res)+1:RectsHeight=Int(Height/Res)+1
Colums=0:Rows=0:X=XPos:Y=YPos
Viewport XPos,YPos,Width,Height ; limit the viewport to clip the image.
DrawBlock ImageID,XPos,YPos ; paste the image down first.
If Res>1
    Repeat
    Repeat
      GetColor x,y:Rect x,y,res,res
      x=x+Res:Colums=Colums+1
    Until Colums=RectsWidth
    X=XPos:y=y+Res
    Colums=0:Rows=Rows+1
  Until Rows=RectsHeight
 End If
Viewport 0,0,GraphicsWidth,GraphicsHeight ; reset the viewport to full screen
End Function

; ********************************************************



Comments

None.

Code Archives Forum