469,327 Members | 1,259 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,327 developers. It's quick & easy.

Colour functions - RGB -> Greyscale (sloooww~...)

180 100+
Hi. I've made 2 functions which play around with colours.
They convert a 'colour number' (I don't know what the proper name for it is, so I call it this - the Long given back by RGB(), object.BackColor, etc, which represents a value of red, green and blue) into another 'colour number' but this is a greyscale version of it.

There are 2 functions - the first one 'decodes' the 'colour number' into the separate R G and B values. The second one uses these 3 values to create a single shade of grey from 0 to 255, and use VB's RGB() function to turn this into a true 'colour number' again.

These functions are part of a module which has 4 Global Longs:
ReturnR, ReturnG, ReturnB and ReturnY (Red, Green, Blue and Greyscale - they all range from only 0 to 255, but are Longs because they're faster, and the memory which would be saved by using Bytes is not really worth the loss in speed). These 4 Longs are set by functions which deal with colour.

This sub takes a 'colour number' and sets the R G and B Longs to what the 'colour number' represents:
Expand|Select|Wrap|Line Numbers
  1. Public Sub ColourToRGB(ColourNumberToConvert)
  4. 'ReturnR - 0 -> 255 = Red value
  5. 'ReturnG - 0 -> 255 = Green value
  6. 'ReturnB - 0 -> 255 = Blue value
  8.     Dim NumberLeftSoFar As Long
  9.     NumberLeftSoFar = ColourNumberToConvert
  11.     ReturnB = Fix(NumberLeftSoFar / 256 / 256)
  12.     NumberLeftSoFar = NumberLeftSoFar - (ReturnB * (256 ^ 2))
  13.     ReturnG = Fix(NumberLeftSoFar / 256)
  14.     NumberLeftSoFar = NumberLeftSoFar - (ReturnG * 256)
  15.     ReturnR = NumberLeftSoFar
  17. End Sub
This next function uses the one above to find out the R G and B values and work out a greyscale from them, and returns the greyscale 'colour number':
Expand|Select|Wrap|Line Numbers
  1. Public Function ColourToGreyscale(ColourNumber) As Long 'Long for speed!
  2. 'Convert a single pixel 'in colour' to greyscale
  3. 'It needs to be given the colour number, and will
  4. 'give back a colour number too.
  5. '
  6. '[Colour number] - a number given back by GetPixel(),
  7. 'RGB(), [object].BackColor, etc.
  9.     ColourToRGB ColourNumber
  11.     ReturnY = (ReturnR * 0.299) + (ReturnG * 0.587) + (ReturnB * 0.114)
  12.     ColourToGreyscale = RGB(ReturnY, ReturnY, ReturnY)
  14. End Function
The functions work fine, but they are quite slow, and painfully slow when dealing with fairly large images.
To convert a whole picture (i.e. using the PictureBox), I call GetPixel over and over within 2 loops, CurrentScanX and CurrentScanY:
Expand|Select|Wrap|Line Numbers
  1.     Dim CurrentColour As Long
  2.     Dim CurrentScanX As Long
  3.     Dim CurrentScanY As Long
  5. Dim UsingPicObj As PictureBox
  6. Dim UsinghDC As Long
  7. Set UsingPicObj = LoadedPic
  8.     UsinghDC = UsingPicObj.hDC
  11. '(Note, UsingPicObj's scalemode is set to 3, pixel)
  12.     For CurrentScanY = 0 To UsingPicObj.ScaleHeight - 1
  13.         For CurrentScanX = 0 To UsingPicObj.ScaleWidth - 1
  15.             CurrentColour = GetPixel(UsinghDC, CurrentScanX, CurrentScanY)
  16.             UsingPicObj.PSet (CurrentScanX, CurrentScanY), ColourToGreyscale(CurrentColour)
  17.             If ReturnY < MinColour Then MinColour = ReturnY
  18.             If ReturnY > MaxColour Then MaxColour = ReturnY
  19.             PictureY(CurrentScanX + ((CurrentScanY + 1) * UsingPicObj.ScaleWidth)) = ReturnY
  21.         Next CurrentScanX
  23.     DoEvents
  24.     Next CurrentScanY
Note that as it's going through the X / Y loops, I'm also storing the greyscale value (0 -> 255) in a big array (PictureY) representing the greyscale of all pixels in the image. I use ReDim to make the array the correct size based on the width and height of the picture, before any of this happens.
Also I am storing the smallest and largest values of the greyscale in the picture.

To be able to use the GetPixel function, you need to declare it from a common Windows DLL:
Expand|Select|Wrap|Line Numbers
  1. Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, _
  2.     ByVal y As Long) As Long

I've posted the code here in the hope that someone can think of any way at all to speed this up.

But, also I hope that it can benefit some people who need help working with colours. I also have a function to convert RGB -> HSV, if anyone is interested, but I don't need help with that so I won't post it.
(Maybe this could eventually become a VB article...?)

(By the way, this is in VB6)
Jul 7 '07 #1
6 2380
8,435 Expert 8TB
Hi Robbie.

I'm at work and due to finish lunch, so I can only make a couple of quick comments for now. Should be able to look through this in more detail this evening at home (I hope).
  1. Constants are faster then literals.
    In other words, where you are using 256, for example, use a named constant (Long type) whith a value of 256.
  2. Constants are a lot faster than calculations.
    Where you are doing things like = NumberLeftSoFar - (ReturnB * (256 ^ 2)) You should create a constant to use in place of "256 ^ 2". Not only is it much slower doing a calculation every time, but if I remember correctly, "powers" are a relatively slow calculation.
  3. Make sure your image has Scalemode = Pixel (3, I think). You should only be dealing with the visible pixels. If you are dealing with twips, you are probably doing something like 225 times as much work as necessary. This depends on your screen resolution, and possibly other things.
  4. As long as it works (test it first) integer division is generally faster.
    In other words, use "\" instead of "/" if the result you want is an integer (whole number) value.
  5. Lines 14 and 15 of your first Sub should be combined. You don't need to place the value into NumberLeftSoFar - just shove it straight into ReturnR and save one step.
  6. You will eventually run into a bug that I hit when playing with this stuff a while back. There are values which you cannot split up this way. That's because they are actually larger then a three-byte value. These are the "system colours", representing things like "window background" or "button face". There is a simple way to translate them to an actual colour value, but I don't recall it now. Don't worry though, we'll find it.
By the way, where did you get the weighting values from (the 0.299 and so on)? I've been wondering about them for a while, but keep forgetting to look them up.
Jul 9 '07 #2
180 100+
Hi Robbie.

I'm at work and due to finish lunch, so I can only make a couple of quick comments for now. Should be able to look through this in more detail this evening at home (I hope).
By the way, where did you get the weighting values from (the 0.299 and so on)? I've been wondering about them for a while, but keep forgetting to look them up.

I'm using constants now and have fixed the pointless lines 14 and 15.
I'm already using ScaleMode 3 (vbPixel) (although I did mention that in a comment of code before ^^;).

Integer division (a \ b) instead of Fix(a / b) resulted in some weird stuff. Different combinations of using it on the 2 lines involved everything turning out except for very light colours (they got converted to black), and ReturnR and ReturnG ending up less than 0, but seemingly a correct number (just -Number). Although it was a little faster.

I think I'm okay with not worrying about running into those System Colours, since I'm only using the function on colours returned by GetPixel(). But thanks for the warning on that in case I go on to use it for other things.

Sorry, I can't for the life of me remember where I got those weighting values. It was a site which was demonstrating how to convert colour to greyscale (you probably could've guessed :P) in some programming language (I think it wasn't VB). They were apparenly the values which worked best for that person.

However, I've found an article on Wikipedia which mentions values extremely close (probably just rounded):

Also if you're interested, I've found some weighting values for converting to Sepia tones:
Jul 9 '07 #3
8,435 Expert 8TB
Thanks for the info.

I guess I missed the reference to pixels in the comments. Like I said, I was in a hurry.

I hope to have time to look into this a bit more tonight, after work. I have done some similar stuff, and don't recall it being terribly slow. But then, I guess "slow" is a very subjective thing, and also depends on what you're doing (not to mention your hardware and what else is running on it).

I must have a look at those links when I have time.

Sorry to hear the integer division didn't work out.

As for the system colours, just try to keep it in the back of your mind, so when you eventually hit a weird negative (or impossibly large) colour value, you know what to look for. Also, I wondered - is there a particular reason why you used the API GetPixel function rather than VB's .Point method? (Note, Point does return system colours, so perhaps I should be avoiding it.)

Oh, yeah - I remember now. I wrote an assembler routine to pick apart a colour value into R/G/B components. Can't recall whether it was faster, though. I'll see whether I can track it down.
Jul 10 '07 #4
8,435 Expert 8TB
Sorry, in a rush again.

However, here's a quick sample I threw together. (It's probably exactly the same as what you've done). It seems reasonably quick, but hasn't been extensively performance-tested. This is the complete code module...

Expand|Select|Wrap|Line Numbers
  1. Option Explicit
  3. ' Values produced...
  4. Public Red As Long, Green As Long, Blue As Long
  6. ' Constants used in the calculations...
  7. Private Const GreenWeight As Long = &H100
  8. Private Const BlueWeight As Long = &H10000
  10. Public Sub SplitColour(ByVal Colour As Long)
  11.   Blue = Colour \ BlueWeight
  12.   Colour = Colour - Blue * BlueWeight
  13.   Green = Colour \ GreenWeight
  14.   Red = Colour - Green * GreenWeight
  15. End Sub
Jul 10 '07 #5
8,435 Expert 8TB
You should specify the input parameters for your subs as Long. You haven't, so they are probably defaulting to Variant. Variants are considerably more "expensive" to deal with, so fixing this may provide a bit of a boost.

I would also lose the DoEvents between your two Next statements. Unless you really need the time-out for some visual feedback or something, it's just slowing things down. Perhaps do one at the end of the sub, in case it's called multiple times.
Jul 10 '07 #6
8,435 Expert 8TB
I don't know whether it will be of any interest, but here's a little program I wrote a year or two back to try and replicate the fade-to-grey effect that XP does when you say to shut down or log off. It's VB6 and should be self-contained. You ought to be able to load it into VB editor and run.
Attached Files
File Type: zip PicFader.zip (9.2 KB, 107 views)
Jul 11 '07 #7

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

129 posts views Thread by Torbjørn Pettersen | last post: by
17 posts views Thread by Sara | last post: by
23 posts views Thread by Stanimir Stamenkov | last post: by
reply views Thread by zhoujie | last post: by
reply views Thread by suresh191 | last post: by
reply views Thread by harlem98 | last post: by
reply views Thread by listenups61195 | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.