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)