|
|
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?
|
|
