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
- 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
Expand|Select|Wrap|Line Numbers
- 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
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
- 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
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
- 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)