#include once "fbpng.bi" #include once "png_image.bi" #include "fbgfx.bi" Using FB declare sub grayscale (byref img as any ptr) declare Function HSV2RGB(Byval hue As Integer, Byval sat As Integer,Byval value As Integer, Byval a As Integer )As Integer declare Sub RGB2HSV(ByRef hue As Integer,ByRef sat As Integer,ByRef value As Integer, ByVal myrgb As Integer) declare sub set_hue (byref img as any ptr, hue_value as integer) declare sub set_sat (byref img as any ptr, sat_value as integer) dim as any ptr sprite1, sprite2 dim as integer workpage, hue_set = 220, sat_set = 255 dim as integer mx, my, mbutton Screenres 640, 480, 32, , GFX_ALPHA_PRIMITIVES sprite1 = png_load( "lava.png", PNG_TARGET_DEFAULT) sprite2 = png_load( "ball.png", PNG_TARGET_DEFAULT) 'grayscale sprite2 Do GETMOUSE mx,my,, mbutton screenlock screenset workpage, workpage xor 1 CLS LINE (120,20)-(220,120), RGBA(255,255,255,255), BF LINE (230,20)-(330,120), RGBA(255,0,0,255), BF put( 0, 0 ), sprite1, ALPHA, 50 put( 0, 80 ), sprite1, ALPHA, 150 put( 0, 160 ), sprite1, ALPHA, 200 put( 0, 240 ), sprite1, ALPHA, 250 put( mx, my ), sprite2, ALPHA If Multikey (SC_1) THEN hue_set = hue_set - 5 If hue_set < 0 then hue_set = 0 set_hue sprite2, hue_set End If If Multikey (SC_2) THEN hue_set = hue_set + 5 If hue_set > 359 then hue_set = 359 set_hue sprite2, hue_set End If If Multikey (SC_3) THEN sat_set = sat_set - 5 If sat_set < 0 then sat_set = 0 set_sat sprite2, sat_set End If If Multikey (SC_4) THEN sat_set = sat_set + 5 If sat_set > 255 then sat_set = 255 set_sat sprite2, sat_set End If LOCATE 50,1 PRINT "Change HUE with 1-2, SATURATION with 3-4" PRINT "HUE: "+ STR$(hue_set) PRINT "SATURATION: "+ STR$(sat_set) workpage xor = 1 screenunlock Sleep 25,1 Loop Until Multikey(SC_ESCAPE) png_destroy( sprite1 ) sub grayscale (byref img as any ptr) 'Makes "img" grayscale 'Copyright (c) Dariusz "Darkhog" G. Jagielski dim as integer img_w, img_h, res, img_pitch dim as uinteger gray, col res = imageinfo (img, img_w, img_h,, img_pitch) if res = 1 then print #44,"Invalid image" 'replace 44 as file number you opened CONS with System(1337) end if dim as uinteger ptr Pixel = cast(any ptr,img+sizeof(fb.image)) ' read the pixel data of img (skip header) for CNT as integer = 0 to ((img_pitch shr 2)*img_h)-1 col = *Pixel ' read the first pixel from the image gray = (col SHR 16) AND &hFF gray += (col SHR 8) AND &hFF gray = (gray+(col AND &hFF))/3 *Pixel = rgba(gray,gray,gray,(col shr 24)) ' change the current pixel RGBA values Pixel += 1 ' switch to next pixel next CNT end sub Function HSV2RGB(Byval hue As Integer, Byval sat As Integer,Byval value As Integer, Byval a As Integer )As Integer 'by Antoni Gual, 2007 If sat = 0 Then Return RGBA(value,value,value,a) hue Mod = 360 Dim As Single h1= hue/60 Dim As Integer i = Int(h1) Dim As Single f = frac(h1) Dim As Integer p = value * ( 255 - sat )/256 Dim As Integer q = value * ( 255 - f*sat)/256 Dim As Integer t = value * ( 255 - ( 1. - f )*sat)/256 Select Case As Const i Case 0: Return RGBA(value,t,p,a) Case 1: Return RGBA(q,value,p,a) Case 2: Return RGBA(p,value,t,a) Case 3: Return RGBA(p,q,value,a) Case 4: Return RGBA(t,p,value,a) Case 5: Return RGBA(value,p,q,a) End Select End Function Sub RGB2HSV(ByRef hue As Integer,ByRef sat As Integer,ByRef value As Integer, ByVal myrgb As Integer) 'by Antoni Gual, 2007 Dim As Integer max=0,min=255,r,g,b,a r=(myRGB Shr 16) And &hff g=(myRGB Shr 8) And &hff b=myRGB And &hff a=myRGB shr 24 If r>max Then max=r If rmax Then max=g If gmax Then max=b If b=b,0,360) ElseIf max=g then hue=60.*(b-r)/(max-min)+120 Else hue=60.*(r-g)/(max-min)+240 End if End sub sub set_hue (byref img as any ptr, hue_value as integer) dim as integer img_w, img_h, res, h, s, v, a, img_pitch dim as uinteger col dim as ubyte red, green, blue res = imageinfo (img, img_w, img_h,, img_pitch) if res = 1 then print #44,"Invalid image" 'replace 44 as file number you opened CONS with System(1337) end if dim as uinteger ptr Pixel = cast(any ptr,img+sizeof(fb.image)) for CNT as integer = 0 to ((img_pitch shr 2)*img_h)-1 col = *Pixel RGB2hsv(h,s,v,col) h = hue_value *Pixel = HSV2RGB(h,s,v,(col shr 24)) Pixel += 1 next CNT end sub sub set_sat (byref img as any ptr, sat_value as integer) dim as integer img_w, img_h, res, h, s, v, a, img_pitch dim as uinteger col dim as ubyte red, green, blue res = imageinfo (img, img_w, img_h,, img_pitch) if res = 1 then print #44,"Invalid image" 'replace 44 as file number you opened CONS with System(1337) end if dim as uinteger ptr Pixel = cast(any ptr,img+sizeof(fb.image)) for CNT as integer = 0 to ((img_pitch shr 2)*img_h)-1 col = *Pixel RGB2hsv(h,s,v,col) s = sat_value *Pixel = HSV2RGB(h,s,v,(col shr 24)) Pixel += 1 next CNT end sub