This algorithm is based on the one in the code project by Santhosh,
http://www.codeproject.com/Articles/471 ... aintEffect
It gives a BITMAP image an oil painting effect. If your image is in another format (eg. jpg or png) then you will have to use a paint or some other image program to load it and resave it as a bitmap image.
I have used point and pset which I think is slower than direct pixel access but easier to read so a large image will take longer to convert to an oil painted effect. Maybe I will speed it up later.
Code: Select all
'#include "fbgfx.bi"
screenres 640,480,32
Const NULL As Any Ptr = 0
dim shared as integer iWidth 'hold width of image
dim shared as integer iHeight 'hold height of image
dim shared as integer pad 'used to skip any pads at end of rows
function loadImage(file as string) as any ptr
dim img1 as any ptr
if img1 <> NULL then
imageDestroy(img1) 'release memory
end if
dim as integer fileHnd = FreeFile()
'get width and height of bitmap
open file for binary as #fileHnd
get #fileHnd, 19, iWidth
get #fileHnd, 23, iHeight
close #fileHnd
'initialize pointers to img1 bitmaps
img1 = imagecreate(iWidth,iHeight,rgb(255,255,255))
bload file,img1 'bload bitmap img1
If img1 = NULL Then
Print "image creation failed!"
Sleep
End
Else
'compute pad value of image required for direct access to pixel data
pad = (4-(iWidth-((iWidth\4)*4)))and 3
end if
return img1
end function
function oilify(img1 as any ptr,radius as integer) as any ptr
dim as integer i,max,maxIndex,r,g,b
dim as double intensity,intensity2
intensity = 5
dim as integer intensityCount(256)
dim as uinteger pixel
dim as integer sumR(256),sumG(256),sumB(256)
dim img2 as any ptr 'make pointer to point to bitmap
img2 = imagecreate(iWidth,iHeight,rgb(255,255,255)) 'duplicate image
for y as integer = 0 to iHeight-radius
for x as integer = 0 to iWidth-radius
'clear table of values
for ii as integer = 0 to 255
sumR(ii)=0
sumG(ii)=0
sumB(ii)=0
intensityCount(ii)=0
next ii
'find intensity of rgb value and apply intensity level
for yy as integer = -radius to radius
for xx as integer = -radius to radius
pixel = point(x+xx,y+yy,img1)
r = pixel shr 16 and &HFF
g = pixel shr 8 and &HFF
b = pixel and &HFF
intensity2 = (((r+g+b)/3.0)*intensity)/255
if intensity2 > 255 then
intensity2 = 255
end if
i = intensity2
intensityCount(i)=intensityCount(i)+1
'sum of each pixel value is calculated
sumR(i) = sumR(i)+r
sumG(i) = sumG(i)+g
sumB(i) = sumB(i)+b
next xx
next yy
'find intensity with highest occurence
max = 0
maxIndex = 0
for ii as integer = 0 to 255
if intensityCount(ii)>max then
max = intensityCount(ii) 'most repeated intensity found so far
maxIndex = ii 'found at index ii
end if
next ii
r = sumR(maxIndex)/max 'max = number of pixels with this intensity
g = sumG(maxIndex)/max
b = sumB(maxIndex)/max
pset img2,(x,y),rgb(r,g,b)
next x
next y
'copy img2 to img1
put img1,(0,0),img2,(0,0)-(iWidth-1,iHeight-1),pset 'copy image2 to image1
imageDestroy(img2)
return img1
end function
' ******* MAIN PROGRAM ***********
dim img as any ptr 'pointer to point to a bitmap
dim as string filePath 'file path to your bitmap image
filePath = "C:/FreeBasic/bitmaps/scene.bmp" 'file path to a bitmap image
img = loadImage(filePath)
put (0,0),img,pset 'display your image
sleep
img = oilify(img,2)
put (0,0),img,pset 'display your modified image
sleep
imageDestroy(img)