View Single Post
 
Old 01-05-2013, 12:18 AM
Jennifer Murphy's Avatar
Jennifer Murphy Jennifer Murphy is offline Windows XP Office 2007
Competent Performer
 
Join Date: Aug 2011
Location: Silicon Valley
Posts: 234
Jennifer Murphy is on a distinguished road
Default

OK. I think I have all of the bugs out. Here's the new code:

Code:
Sub MyRandCharColors16M()
Dim oChr As Range

'Use floating point so scaling will work.
'Font.Color will take floating point, but it rounds,
'which messes up the probabilities.
Dim sngR As Single, sngG As Single, sngb As Single
Dim sngRGBSum As Single, sngRGBF As Single

'Define the maximum RGB sum.
'A score around 500-600 seems to give the best results.
'See Random color macro test data.pdf.
Const sngRGBMax As Single = 550
Randomize

'Loop thru characters in selection one at a time.
For Each oChr In Selection.Characters
  sngR = Int(Rnd() * 256) 'Select an integer on [0,255]
  sngG = Int(Rnd() * 256) 'Int is required for equal probability
  sngb = Int(Rnd() * 256) 'Else 0 only gets 0.5 and 255 gets 1.5
  'If the sum > max, scale all three back proportionately
  sngRGBSum = sngR + sngG + sngb
  If sngRGBSum > sngRGBMax Then     'If sum > max, scale it down to max
    sngRGBF = sngRGBMax / sngRGBSum
    sngR = sngR * sngRGBF
    sngG = sngG * sngRGBF
    sngb = sngb * sngRGBF
  End If
  'Assign the next character its color
  oChr.Font.Color = RGB(sngR, sngG, sngb)
Next oChr

End Sub
This seems to work quite well. The darkness can be controlled to some extent with the RGBMax variable. I uploaded a PDF document with sample output here:

https://www.dropbox.com/sh/zm8we5ssjtf13fp/9vR8Pms7uO?m

Someone on the sci.math newsgroup suggested that HSV color space would offer better color controls.

Here's a link. I haven't had time to check it out.

http://en.wikipedia.org/wiki/HSL_and_HSV

If the same color value is used for all three RGB settings, we get shades of grey.

Code:
Sub MyRandCharColors256G()
Dim oChr As Range
Dim sngGrey As Single
Randomize
For Each oChr In Selection.Characters
'  sngGrey = Int(Rnd() * 256) '256 shades of grey
  sngGrey = Int(Rnd() * 192) '192 shades of grey
'  sngGrey = Int(Rnd() * 128) '128 shades of grey
  oChr.Font.Color = RGB(sngGrey, sngGrey, sngGrey)
Next oChr
End Sub
Thanks for all the help.
Reply With Quote