The Calculation
The next two functions work together to calculate the intermediate colors between color1 and color2, and return those colors in the array passed ByRef.
With this function, you can draw a gradient between any two colors, in as many or as few steps as you like. The number of steps will determine the number of colors returned: 2 steps = no change, 3 steps = 3 colors, color1, the average between color1 and color2, and finally color2, etc.
Private Function CalculateGradient(ByVal color1 As Long, ByVal color2 As Long, ByVal steps As Long, ByRef arr() As Long) As Boolean
Dim cont As Long
Dim red() As Byte
Dim green() As Byte
Dim blue() As Byte
Dim tempRed As Byte
Dim tempGreen As Byte
Dim tempBlue As Byte
Dim temp() As Byte
'Activate error trapping
On Error GoTo ErrorInGradient
'Get ready the temporal arrays for color components
ReDim red(1 To 2)
ReDim green(1 To 2)
ReDim blue(1 To 2)
'Get color 1 by pieces: Red, Green, Blue
'in the temporal array temp()
GetColorByPieces color1, temp
'Store the color components in array meant for that
red(1) = temp(0)
green(1) = temp(1)
blue(1) = temp(2)
'Do the same for color 2
GetColorByPieces color2, temp
red(2) = temp(0)
green(2) = temp(1)
blue(2) = temp(2)
'Get the array ready
ReDim arr(0 To steps - 1)
'The loop will calculate the gradient
For cont = LBound(arr) To UBound(arr)
tempRed = red(1) + Sgn(CLng(red(2)) - CLng(red(1))) * CByte(Abs(CLng(red(2)) - CLng(red(1))) / (steps - 1) * cont)
tempGreen = green(1) + Sgn(CLng(green(2)) - CLng(green(1))) * CByte(Abs(CLng(green(2)) - CLng(green(1))) / (steps - 1) * cont)
tempBlue = blue(1) + Sgn(CLng(blue(2)) - CLng(blue(1))) * CByte(Abs(CLng(blue(2)) - CLng(blue(1))) / (steps - 1) * cont)
arr(cont) = RGB(tempRed, tempGreen, tempBlue)
Next cont
'Return true if the function is successful
CalculateGradient = True
On Error GoTo 0
Exit Function
ErrorInGradient:
CalculateGradient = False
End Function
Private Sub GetColorByPieces(ByVal color As Long, ByRef arr() As Byte)
'Get array ready for data
ReDim arr(0 To 2)
'Get color components. These are bitwise operations
arr(0) = (color And 255)
arr(1) = ((color And 65535) - arr(0)) / 256
arr(2) = ((color And 16777215) - (CLng(arr(1)) * 256 + arr(0))) / 65536
End Sub
UPDATE: The sub GetColorByPieces presented above can be accelerated, just in case you want to use it in a more heavy-duty fashion. Here it is. Enjoy!
You need the following API sub declaration:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Private Sub GetColorByPieces(ByVal color As Long, ByRef arr() As Byte)
'Get array ready for data
ReDim arr(0 To 2)
'Now all you need is map the long variable color into the byte array using CopyMemory.
'This is what I call API casting :)
CopyMemory arr(0), color, 3
End Sub
Now go to the next page to see an example application of this gradient stuff.