Creating color degradations with any two colors

Page 1 of 2
  1. The Calculation
  2. Example of Use

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

   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.

You might also like...


Jose Pablo Ramirez Vargas


Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“The generation of random numbers is too important to be left to chance.” - Robert R. Coveyou