|
Re: Help with algorithm for adjusting RGB colors
Posted:
Jan 5, 2013 12:47 PM
|
|
On Fri, 04 Jan 2013 15:08:19 -0800, Jennifer Murphy <JenMurphy@jm.invalid> wrote:
>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
A comment that has nothing to do with your question: That call to Randomize is wrong!
It's a common thing, people calling Randomize, or the equivalent in another language, in the body of a function like this, thinking that the more calls to Randomize the better. But in fact you should call Randomize only _once_ in the course of the application! Call Randomize in whatever routine VBA has for initializing things (FormCreate or something).
You think calling Randomize over and over is making things more random, but it actually makes things _less_ random. The story: Randomize sets some "seed" based on the system clock. Once that seed is set, repeated calls to Rnd return a sequence of quasi-random numbers, starting with he seed.
Luckily VBA is slow. But the same principle applies: Imagine this is some fast compiled language. You call Randomize, the seed gets set. The next time you call MyRandCharColors, the clock hasn't ticked yet, so you reset the seed to the same as you set it the first time! So your second call to MyRandCharColors gives exactly the same colors as the first call.
If you haven't noticed this problem it's because VBA is so slow. But regardless, only _one_ call to Randomize, at the start of the application, will make the colors more random. Honest.
> 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. > >Let > > max = some RGB sum threshold, such as 500. > >then > > 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. > >https://www.dropbox.com/sh/zm8we5ssjtf13fp/9vR8Pms7uO?m > >As max gets smaller, there are fewer and fewer light colors and the >overall effect if generally darker. > >Is there a better way to do this?
|
|