I have a little Word macro that will assign a random color from the entire 16M color palette to each letter in a text string. It does this by selecting a random number on (0,255) for each of the RGB colors.
The VBA code is:
Sub MyRandCharColors() Dim oChr As Range Dim sngR As Single, sngG As Single, sngB As Single Randomize For Each oChr In Selection.Characters sngR = Int(Rnd() * 256) sngG = Int(Rnd() * 256) sngB = Int(Rnd() * 256) oChr.Font.Color = RGB(sngR, sngG, sngB) Next oChr End Sub
This works well. The result is a multi-colored string that has a nice party effect.
The only problem is that some of the colors are a little too faint (light). This happens then all three values are too close to 255. Pure white is (255,255,255). Pure black is (0,0,0).
The solution I came up with is to test the sum of the RGB values. If it's too close to 765 (255+255+255), scale the values down.
max = some RGB sum threshold, such as 500.
If (R+G+B) > Max
I want F, such that
(R+G+B)*F = Max F = Max / (R+G+B)
then I can scale R, G, & B
R = R * F G = G * F B = B * F
This maintains the relative ratio among the colors, eliminates the lightest color combinations, and generally darkens the result.
Here's the revised VBA code:
Sub MyRandCharColors() Dim oChr As Range Dim sngR As Single, sngG As Single, sngB As Single Dim sngRGBSum As Single, sngRGBF As Single Const sngRGBMax As Single = 100 Randomize For Each oChr In Selection.Characters sngR = Rnd() * 256 sngG = Rnd() * 256 sngB = Rnd() * 256 sngRGBSum = sngR + sngG + sngB If sngRGBSum > sngRGBMax Then sngRGBF = sngRGBMax / sngRGBSum sngR = sngR * sngRGBF sngG = sngG * sngRGBF sngB = sngB * sngRGBF End If oChr.Font.Color = RGB(sngR, sngG, sngB) Next oChr End Sub
I uploaded a PDF document with some samples using various values for Max.