Function library to convert RGB to/from HSL including demonstration code.

Function library to convert RGB to/from HSL including demonstration code.

Please note that the demonstration code is relatively slow as it uses pixel by pixel manipulation of the image to show function usage.

I would not not recommend running the example code with an image not much larger than 200x100 pixels due to the above.

An image 'image1.bmp' is required to run the code. A sample image along with the above demo code and a seperate file containing only the functions can be downloaded under the code listing section (77Kb)

DeepBlue

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    `####################################
`# RGB-HSL-RGB Functions for DBPro  #
`# Including example code           #
`# by DeepBlue (deepblue@ipuk.net)  #
`# ver 1.0b 07/2004                 #
`####################################

`Functions & Usage
`Note: The range of all RGB and HSL values is 0 to 255

` RGBtoHSL
`Returns an HSL equivalent value of the Red,Green,Blue colors passed to the function.
`SYNTAX
`Return DWORD=RGBtoHSL(Red Value,Green Value,Blue Value)

` HSLtoRGB
`Returns an RGB equivalent value of the Hue,Saturation,Lightness values passed to the function.
`SYNTAX
`Return DWORD=HSLtoRGB(Hue Value,Saturation Value,Lightness Value)

` HSL
`Returns an HSL value for the seperate Hue,Saturation,Lightness values passed to the function.
`SYNTAX
`Return DWORD=HSL(Hue Value,Saturation Value,Lightness Value)

` HSLh
`Returns the Hue component of an HSL value
`SYNTAX
`Return Integer=HSLh(HSL Value)

` HSLs
`Returns the Saturation component of an HSL value
`SYNTAX
`Return Integer=HSLs(HSL Value)

` HSLl
`Returns the Lightness component of an HSL value
`SYNTAX
`Return Integer=HSLl(HSL Value)

` --- Demonstration Code ---

`setup display
if check display mode(800,600,32)=1:set display mode 800,600,32
else
if check display mode(800,600,16)=1:set display mode 800,600,16
endif
endif
sync on:sync rate 0:backdrop on:color backdrop rgb(53,171,250)
fog off:autocam off
ink rgb(255,255,255),rgb(0,0,0)
set text font "Arial":set text size 14:set text to bold
hide mouse

`load bitmap source image
load bitmap "image1.bmp",1

bitmapWidth=bitmap width(1)
bitmapHeight=bitmap Height(1)

`create an array to hold the HSL values
arraySize=bitmapWidth*bitmapHeight
dim hslArray(arraySize)

`get each pixels RGB value,convert to HSL & store in hslArray
arrayCounter=1
 set current bitmap 1
 lock pixels
 for x1 = 0 to bitmapWidth-1
  for y1 = 0 to bitmapHeight-1
   rgbVal=point(x1,y1)
   rVal=RGBr(rgbVal)
   gVal=RGBg(rgbVal)
   bVal=RGBb(rgbVal)
   hslVal=RGBtoHSL(rVal,gVal,bVal)
   hslArray(arrayCounter)=hslVal
  inc arrayCounter
  next y1
 next x1
 unlock pixels

`create target bitmap to be manipulated & displayed as image 2
create bitmap 2,bitmapWidth,bitmapHeight
set current bitmap 0

userInputInterval=250
nextUserInput=Timer()

do

 `calls userInput every userInputInterval (ms)
 if nextUserInput <= Timer() then gosub userInput

 gosub updateImage

 paste image 2,(screen width()/2)-(bitmapWidth/2),(screen height()/2)-(bitmapHeight/2)

 text 8,0,"Keys may need to be kept pressed due to speed"
 text 8,16,"Keys Q/W - Hue"
 text 8,32,"Keys A/S - Saturation"
 text 8,48,"Keys Z/X - Lightness"
 text 8,64,"Spacebar - Reset Image"

 sync
loop

userInput:
 nextUserInput=userInputInterval + Timer()

 if scancode()=16 then hShift=hShift-10
 if scancode()=17 then hShift=hShift+10
 if hShift > 255 then hShift=255
 if hShift < -255 then hShift=-255

 if scancode()=30 then sShift=sShift-10
 if scancode()=31 then sShift=sShift+10
 if sShift > 255 then sShift=255
 if sShift < -255 then sShift=-255

 if scancode()=44 then lShift=lShift-10
 if scancode()=45 then lShift=lShift+10
 if lShift > 255 then lShift=255
 if lShift < -255 then lShift=-255

 if scancode()=57
  hShift=0
  sShift=0
  lShift=0
 endif

 clear entry buffer
return

updateImage:
`reads data from hslArray seperates HSL values & converts to RGB
`updates pixels using RGB values & stores as image 2

 arrayCounter=1
 set current bitmap 2
 lock pixels
 for x2 = 0 to bitmapWidth-1
  for y2 = 0 to bitmapHeight-1
   hVal=HSLh(hslArray(arrayCounter))+hShift
   sVal=HSLs(hslArray(arrayCounter))+sShift
   lVal=HSLl(hslArray(arrayCounter))+lShift
   rgbVal=HSLtoRGB(hVal,sVal,lVal)
   dot x2,y2,rgbVal
   inc arrayCounter
  next y2
 next x2
 unlock pixels

 get image 2,0,0,bitmapWidth,bitmapHeight,1
 set current bitmap 0
return

` --- Main RGB-HSL-RGB Functions ---

function RGBtoHSL(R,G,B) as DWORD

 if R > 255 then R=255
 if G > 255 then G=255
 if B > 255 then B=255

 if R < 0 then R=0
 if G < 0 then G=0
 if B < 0 then B=0

 valR# = Abs(R)/255.0
 valG# = Abs(G)/255.0
 valB# = Abs(B)/255.0

 rgbMin#=valR#
 if valG# < rgbMin# then rgbMin#=valG#
 if valB# < rgbMin# then rgbMin#=valB#

 rgbMax#=valR#
 if valG#>rgbMax# then rgbMax#=valG#
 if valB#>rgbMax# then rgbMax#=valB#

 deltaMax#=rgbMax#-rgbMin#

 valL#=(rgbMax#+rgbMin#)/2.0

 if deltaMax# = 0.0
  valH# = 0.0
  valS# = 0.0
 else
  if valL# < 0.5
   valS#=deltaMax#/(rgbMax#+rgbMin#)
  else
   valS#=deltaMax#/(2-rgbMax#-rgbMin#)
  endif

  deltaR#=(((rgbMax#-valR#)/6.0)+(deltaMax#/2.0))/deltaMax#
  deltaG#=(((rgbMax#-valG#)/6.0)+(deltaMax#/2.0))/deltaMax#
  deltaB#=(((rgbMax#-valB#)/6.0)+(deltaMax#/2.0))/deltaMax#

  if valR# = rgbMax#
   valH#=deltaB#-deltaG#
  else
   if valG# = rgbMax#
    valH#=Abs(1.0/3.0)+deltaR#-deltaB#
   else
    valH#=Abs(2.0/3.0)+deltaG#-deltaR#
   endif
  endif

  if valH# < 0.0 then valH#=valH#+1
  if valH# > 1.0 then valH#=valH#-1
 endif

 H=int(abs(valH#*255))
 S=int(abs(valS#*255))
 L=int(abs(valL#*255))

hslVal = hsl(H,S,L)
endfunction hslVal

function HSLtoRGB(H,S,L) as DWORD
`This function uses the HUEtoRGB# function

 if H > 255 then H=255
 if S > 255 then S=255
 if L > 255 then L=255

 if H < 0 then H=0
 if S < 0 then S=0
 if L < 0 then L=0

 valH# = abs(H)/255.0
 valS# = abs(S)/255.0
 valL# = abs(L)/255.0

 if S = 0
  R = L
  G = L
  B = L
 else
  if valL# < 0.5
   val2#=abs(valL#*(1.0+valS#))
  else
   val2#=(valL#+valS#)-(valS#*valL#)
  endif
  val1#=abs(2.0*valL#-val2#)

  RH#=valH#+abs(1.0/3.0)
  GH#=valH#
  BH#=valH#-abs(1.0/3.0)

  HR# = HUEtoRGB#( val1#, val2#, RH# )
  HG# = HUEtoRGB#( val1#, val2#, GH# )
  HB# = HUEtoRGB#( val1#, val2#, BH# )

  R=int(abs(HR#*255))
  G=int(abs(HG#*255))
  B=int(abs(HB#*255))
 endif

rgbVal=rgb(R,G,B)
endfunction rgbVal

function HUEtoRGB#( val1#, val2#, valH# ) as Float

 if valH# < 0.0 then valH# = abs(valH# + 1.0)
 if valH# > 1.0 then valH# = abs(valH# - 1.0)

 if abs(valH#*6.0) < 1.0
   retVal# = abs(val1#+(val2#-val1#)*valH#*6.0)
 else
  if abs(valH#*2.0) < 1.0
   retVal# = val2#
  else
   if abs(valH#*3.0) < 2.0
    retVal# = abs(val1#+(val2#-val1#)*(abs(2.0/3.0)-valH#)*6.0)
   else
    retVal# = val1#
   endif
  endif
 endif
endfunction retVal#

function HSL(H,S,L) as DWORD
 if H > 255 then H=255
 if S > 255 then S=255
 if L > 255 then L=255
 hslVal = abs(H*0x10000) + abs(S*0x100) + abs(L)
endfunction hslVal

function HSLh(hslVal) as Integer
 H = int(abs(hslVal/0x10000))
endfunction H

function HSLs(hslVal) as Integer
 H = int(abs(hslVal/0x10000))
 S = int(abs((hslVal-(H*0x10000))/0x100))
endfunction S

function HSLl(hslVal) as Integer
 H = int(abs(hslVal/0x10000))
 S = int(abs((hslVal-(H*0x10000))/0x100))
 L = int(abs(hslVal-(H*0x10000)-(S*0x100)))
endfunction L