種々のカラーパレット 4

記事「種々のカラーパレット 3」のつづき

「種々のカラーパレット 3」の最後の方で、
色相のグラデーションを
淡くしたり暗くしたカラーパレットに変更する
プロシージャを書いたのですが、
やはり、ただ単に「+ torn」を加えただけでは
同じような色が続いてしまったりしてました。

これを改良します。
淡くしたり暗くするときのRGB関数の引数を
棒グラフで表してみる。

つまり、淡くするときは、
255 - tornを何等分かして増減させたものに
tornを加えれば色相全体を淡くできます。

逆に、暗くするには
255 + torn (torn < 0)が各引数の最大値なので
この255 + tornを何等分化して増減させれば
色相全体が暗くなります。

以上のようにtornがプラスかマイナスかで計算方法が違いますので
tornがプラスのときとマイナスのときを２つのプロシージャに分けました。

まずは、
改良版・淡い色相のグラデーションカラーパレットにするコードです。

Sub macro100222a()
'カラーパレットを変更
'色相のグラデーション
'トーン変化あり,改良版(torn > 0)

    Dim i, r, g, b, torn, v_max As Integer
    Dim MyIndex As Variant
    MyIndex = Array(1, 53, 52, 51, 49, 11, 55, 56, _
        9, 46, 12, 10, 14, 5, 47, 16, _
        3, 45, 43, 50, 42, 41, 13, 48, _
        7, 44, 6, 4, 8, 33, 54, 15, _
        38, 40, 36, 35, 34, 37, 39, 2)
    'トーンの設定(0 < torn < 255)
    torn = 200
    v_max = 255 - torn
        For i = 0 To 6
            r = v_max + torn
            g = Int(v_max * i / 6) + torn
            b = 0 + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 7 To 13
            r = Int(v_max - (v_max * (i - 6) / 7)) + torn
            g = v_max + torn
            b = 0 + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 14 To 20
            r = 0 + torn
            g = v_max + torn
            b = Int(v_max * (i - 13) / 7) + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 21 To 27
            r = 0 + torn
            g = Int(v_max - (v_max * (i - 20) / 7)) + torn
            b = v_max + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(v_max * (i - 27) / 7) + torn
            g = 0 + torn
            b = v_max + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = v_max + torn
            g = 0 + torn
            b = Int(v_max - (v_max * (i - 33) / 7)) + torn
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

変更後の改良版・淡い色相のグラデーションカラーパレットです。
改良前も比較で載せます。

次は、
改良版・暗い色相のグラデーションカラーパレットにするコードです。

Sub macro100222b()
'カラーパレットを変更
'色相のグラデーション
'トーン変化あり,改良版(torn < 0)

    Dim i, r, g, b, torn, v_max As Integer
    Dim MyIndex As Variant
    MyIndex = Array(1, 53, 52, 51, 49, 11, 55, 56, _
        9, 46, 12, 10, 14, 5, 47, 16, _
        3, 45, 43, 50, 42, 41, 13, 48, _
        7, 44, 6, 4, 8, 33, 54, 15, _
        38, 40, 36, 35, 34, 37, 39, 2)
    'トーンの設定(-255 < torn < 0))
    torn = -100
    v_max = 255 + torn
        For i = 0 To 6
            r = v_max
            g = Int(v_max * i / 6)
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 7 To 13
            r = Int(v_max - (v_max * (i - 6) / 7))
            g = v_max
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 14 To 20
            r = 0
            g = v_max
            b = Int(v_max * (i - 13) / 7)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 21 To 27
            r = 0
            g = Int(v_max - (v_max * (i - 20) / 7))
            b = v_max
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 28 To 34
            r = Int(v_max * (i - 27) / 7)
            g = 0
            b = v_max
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 35 To 39
            r = v_max
            g = 0
            b = Int(v_max - (v_max * (i - 33) / 7))
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

変更後の改良版・暗い色相のグラデーションカラーパレットです。

多少の違いですが、数値を見ればよく分かります。
数値はイミディエイトウィンドウに表示するようになってます。