Home » Category » Microsoft Visual Basic

Microsoft Visual Basic: Colour functions - RGB -> Greyscale (sloooww~...)

206| Fri, 04 Jan 2008 17:37:00 GMT| robbie| Comments (6)
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:

Code: ( text )
  1. Public Sub ColourToRGB(ColourNumberToConvert)
  2. 'WHEN THIS FUNCTION HAS FINISHED, THESE VARIABLES WILL
  3. 'GIVE YOU THE R, G AND B VALUES OF THE ORIGINAL COLOUR NUMBER:
  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':
Code: ( text )
  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:
Code: ( text )
  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
  10. '- - - - - GREYSCALE AND STORING IMAGE
  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:

Code: ( text )
  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)

Keywords & Tags: colour, functions, rgb, greyscale, sloooww~, microsoft, visual basic, vb

URL: http://www.programmerbase.com/visual-basic/80739/
 
«« Prev - Next »» 6 helpful answers below.
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.

killer42 | Fri, 04 Jan 2008 17:38:00 GMT |

Quote:
Originally Posted by 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).
...
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

robbie | Fri, 04 Jan 2008 17:39:00 GMT |

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 | Fri, 04 Jan 2008 17:40:00 GMT |

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

Code: ( vb )
  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

killer42 | Fri, 04 Jan 2008 17:41:00 GMT |

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 | Fri, 04 Jan 2008 17:42:00 GMT |

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.

killer42 | Fri, 04 Jan 2008 17:43:00 GMT |

Microsoft Visual Basic Hot Answers

  • Zuperman!

    :eek2: http://www.vbforums.com/showthread.php?p=2829958#post2829958Well, you seem just to have triggered it through a particular set of circumstances, whatever they may be...Lex Luthor strikes again!!!:)...

  • Zuperman Returns

    He was always here with us. (http://www.vbforums.com/member.php?u=13510) :afrog:...

  • Zuperman

    Happy Birthday seor!...

  • zuperman

    I have more zells than you....

  • Zune or IPod or Other?

    I'm looking for a video/mp3 player.Does anyone know what video formats Ipod / Zune supports?I have a large variety of codecs and video formats, OGMs with *.sub subtitle text files, MKVs, the most importantly DIVX AVIs.Am I wrong or do Ipod only support MOV videos, and Zune only support WMV...

Microsoft Visual Basic New questions

  • ZZ 9 Plural Z Alpha

    I'm sure you have all heard of the sad demise of Mr Douglas Adams, earlier this week, of a heart attack at age 49.He was a source of inspiration to me in particular, having grown up repeatedly listening to the Hitch Hiker's Guide To The Galaxy, and reading all his books.He will be miss...

  • Zune 2.0

    Anyone know when it's coming out?...

  • Z-Scores and Probability in Visual Basic

    I have the z-score value and what i need is the correspondingprobability. I can determine it with a table like this one:http://www.epatric.com/documentatio...core_table.htmlBut i was wondering if there was a function in visual basic or a peiceof code that can calculate it for me without needing...

  • ZOrdering Windows

    OK, I've made my own gaming engine with it's own pseudo-windows and what not. When it comes to render the windows onto the device context it becomes tricky if I want one window to appear in front or behind another window. I thought about ZOrdering but when a window is created what ZO...

  • Z-Order...??

    Can someone explain what exactly Z-Order is...? And what exactly is it used for...?Cheers......

  • Zorder Question

    Hi Guys,Just a quick and hopefully simple question, I'm working on an application that needs to always be at the very bottom of the zorder, i know how to send my app to the top but I need to know how to send it to the very bottom.Thanks....

  • Zorder of a label control

    I am creating an activex control in which I have a 3rd party image control and a label control. I want the label control to be on top of the image control but it's always hidden beneath the image control. Is there any way I can make it come over top of the image contro?? I have played ar...

  • Zorder in Win 2k

    Does Win 2k handle Zorder differently? All of my windows keep appearing at the bottom of the Zorder instead of the top when I spawn them.What the heck is going on?Eiredrake...

  • z-order from some components

    some components e.g. the "spinButton" are not able to bring to front! Also i set z-order in code and choose option "Bring to front" With other components it's no problem!!! Can you help me?...

  • zorder and show form

    hello,i have 2 forms that i want to display in 2 different ways.form1 shows form2 with vbmodal as default.then on form2 i have a check button thay says: 'always on top'.when you click on it you change the default setting either to on top or not on top.i only managed to get this work af...

Microsoft Visual Basic Related Categories