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

[Robbie]

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:

Public Sub ColourToRGB(ColourNumberToConvert)
'WHEN THIS FUNCTION HAS FINISHED, THESE VARIABLES WILL
'GIVE YOU THE R, G AND B VALUES OF THE ORIGINAL COLOUR NUMBER:
'ReturnR - 0 -> 255 = Red value
'ReturnG - 0 -> 255 = Green value
'ReturnB - 0 -> 255 = Blue value
 
    Dim NumberLeftSoFar As Long
    NumberLeftSoFar = ColourNumberToConvert
 
    ReturnB = Fix(NumberLeftSoFar / 256 / 256)
    NumberLeftSoFar = NumberLeftSoFar - (ReturnB * (256 ^ 2))
    ReturnG = Fix(NumberLeftSoFar / 256)
    NumberLeftSoFar = NumberLeftSoFar - (ReturnG * 256)
    ReturnR = NumberLeftSoFar
 
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':

Public Function ColourToGreyscale(ColourNumber) As Long 'Long for speed!
'Convert a single pixel 'in colour' to greyscale
'It needs to be given the colour number, and will
'give back a colour number too.
'
'[Colour number] - a number given back by GetPixel(),
'RGB(), [object].BackColor, etc.
 
    ColourToRGB ColourNumber
 
    ReturnY = (ReturnR * 0.299) + (ReturnG * 0.587) + (ReturnB * 0.114)
    ColourToGreyscale = RGB(ReturnY, ReturnY, ReturnY)
 
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:

    Dim CurrentColour As Long
    Dim CurrentScanX As Long
    Dim CurrentScanY As Long
 
Dim UsingPicObj As PictureBox
Dim UsinghDC As Long
Set UsingPicObj = LoadedPic
    UsinghDC = UsingPicObj.hDC
 
'- - - - - GREYSCALE AND STORING IMAGE
'(Note, UsingPicObj's scalemode is set to 3, pixel)
    For CurrentScanY = 0 To UsingPicObj.ScaleHeight - 1
        For CurrentScanX = 0 To UsingPicObj.ScaleWidth - 1
 
            CurrentColour = GetPixel(UsinghDC, CurrentScanX, CurrentScanY)
            UsingPicObj.PSet (CurrentScanX, CurrentScanY), ColourToGreyscale(CurrentColour)
            If ReturnY < MinColour Then MinColour = ReturnY
            If ReturnY > MaxColour Then MaxColour = ReturnY
            PictureY(CurrentScanX + ((CurrentScanY + 1) * UsingPicObj.ScaleWidth)) = ReturnY
 
        Next CurrentScanX
 
    DoEvents
    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:

Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, _
    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)

[Killer42]

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.

[Robbie]

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.

Thanks!

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):
http://en.wikipedia.org/wiki/Grayscale

Also if you're interested, I've found some weighting values for converting to Sepia tones:
http://en.wikipedia.org/wiki/Sepia_tone

[Killer42]

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.

[Killer42]

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...

Option Explicit
 
' Values produced...
Public Red As Long, Green As Long, Blue As Long
 
' Constants used in the calculations...
Private Const GreenWeight As Long = &H100
Private Const BlueWeight As Long = &H10000
 
Public Sub SplitColour(ByVal Colour As Long)
  Blue = Colour \ BlueWeight
  Colour = Colour - Blue * BlueWeight
  Green = Colour \ GreenWeight
  Red = Colour - Green * GreenWeight
End Sub

[Killer42]

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.

[Killer42]

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.