1.3. 色彩
1.3.2. プログラミングの練習
(0) TEXTOS-C-1
lbl色相 [色相(H)]
txt色相 [0] 0-240の範囲で色相を表示します。
spn色相 [0] 色相の値を調節します。最大(Max)=12, 初期値(Value)=0
Option Explicit '変数を明示
Sub spn色相_Change()
txt色相 = spn色相 * 240 / 12 End Sub
spn 色相の変化に応じて、txt色相の値を代入します。spn 色相の最大(Max)が 12 であ り、txt色相の最大(Max)が 240なので、* 240 / 12で調節します。つまり、spn色相が 12になったときに、txt色相が 240になります。
(1) TEXTOS-C-1
次のコントロールを追加します。
35
txt背景色 [0000FF] 16進数を使って背景色を表示します。
txt見本 スピンボタンの変化に応じて背景色と文字色を表示します。
lbl明度 [明度(L)]
txt明度 [120] 0-240の範囲で明度を表示します。
spn明度 [6] 明度の値を調節します。最大(Max)=12, 初期値(Value)=6.
lbl彩度 [彩度(S)]
txt彩度 [240] 240: 0-240の範囲で彩度を表示します。
spn彩度 [12] 彩度の値を調節します。最大(Max)=12, 初期値(Value)=12.
cmd実行 [◎実行] Word文書中の選択範囲の文字色、背景色、下線色を出力しま
す。
標準モジュール
Declare Function FindWindow& Lib "user32.dll" Alias "FindWindowA" _ (ByVal C$, ByVal W$) 'ハンドル
Declare Function GetWindowLong& Lib "user32.dll" Alias "GetWindowLongA" _ (ByVal F&, ByVal I&) 'ボタン制御
Declare Function SetWindowLong& Lib "user32.dll" Alias "SetWindowLongA" _ (ByVal F&, ByVal I&, ByVal N&) 'メニューバー
Declare Function SetWindowPos& Lib "user32.dll" (ByVal Hw&, ByVal Ins&, _ ByVal X&, ByVal Y&, ByVal C&, ByVal D&, ByVal F&) 'フォーム表示状態 最小化ボタンを制御するライブラリーの関数を利用します。
Declare Function ColorHLSToRGB& Lib "SHLWAPI.DLL" _ (ByVal H%, ByVal L%, ByVal S%) 'RGB関数
Declare Sub ColorRGBToHLS Lib "SHLWAPI.DLL" _ (ByVal clrRGB&, H%, L%, S%) 'HLSサブルーチン
色を指定する変数を変換用のライブラリーの関数を利用します。
Public lngRGB&, HexRGB$ '長整数型RGB値、16進数RGB値 以下のプログラムで共通に使う変数です。
36
Public Function BGR$(W$) 'RGB$から16進数BGR$に変換 BGR$ = "&H" & Right$(W$, 2) & Mid$(W$, 3, 2) & Left$(W$, 2) End Function
'RGB$から16進数BGR$に変換する関数です。VBAでは赤(R)・緑(G)・青(B)の順番で
はなく、青(B)・緑(G)・青(R)の順番の 16 進数で色を指定する仕様なので、この変換 のための関数を作りました。
Sub Textos_C_色彩_0()
Call UserForm_Show(fmTextos_C_色彩_0) End Sub
Sub Textos_C_色彩_1()
Call UserForm_Show(fmTextos_C_色彩_1) End Sub
Sub Textos_C_色彩_2()
Call UserForm_Show(fmTextos_C_色彩_2) End Sub
Sub Textos_C_色彩_3()
Call UserForm_Show(fmTextos_C_色彩_3) End Sub
それぞれのユーザーフォームを引数として、次のサブルーチンUserForm_Showに渡し ます。
Sub UserForm_Show(M)
Dim F&, G&, S& '最小化ボタン用変数
M.Show vbModeless 'フォームをモードレスで表示
F& = FindWindow("ThunderDFrame", M.Caption) 'ハンドル G& = GetWindowLong(F&, -16) Or &H20000 'ウィンドウの情報 S& = SetWindowLong(F&, -16, G&) 'フォームボタン
S& = SetWindowPos(F&, -1, 150, 150, 0, 0, 1) '表示（ハンドル, 前面, x, y, 0, 0, 1) End Sub
37
渡されたフォームをモードレスで表示し、フォームに最小化ボタンを追加します。
Sub UserForm_Activate() 'フォーム表示 HexRGB$ = txt背景色: Call 色見本 End Sub
フォームを表示したとき、フォーム内のRGB値(0000FF)をHEXRGB$に代入し、「色 見本」サブルーチンを実行します。
Sub spn色相_Change()
txt色相 = spn色相 * 240 / 12: Call RGB変換: Call 色見本 End Sub
spn色相の変化に応じて、txt色相の値を代入します。それぞれの最大(Max)が 12と240 なので、調節します。
Sub spn明度_Change()
txt明度 = spn明度 * 240 / 12: Call RGB変換: Call 色見本 End Sub
明度についても同様です。
Sub spn彩度_Change()
txt彩度 = spn彩度 * 240 / 12: Call RGB変換: Call 色見本 End Sub
彩度についても同様です。
Sub RGB変換() 'txt色相, txt明度, txt彩度 → HexRGB$
If Val(txt彩度) = 0 Then '明度だけでRGBを表示
HexRGB$ = Right$("0" & Hex$(Int(txt明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
LngRGB& = ColorHLSToRGB(txt色相, txt明度, txt彩度) 'RGB変換関数 HexRGB$ = Right$("00000" & Hex$(LngRGB&), 6)
End If End Sub
txt色相, txt明度, txt彩度の値に応じて HexRGB$の値を代入します。彩度がゼロのとき
38
は、明度だけでHexRGB$の値を調節します。このときR, G, Bの最大(Max)255を明度 の最大(Max)240 で割ります。この整数値を 2 桁の 16 進数に変換し、無彩色なので
R=G=Bとします。彩度がゼロでないときはライブラリーの RGB 変換関数を使って長
整数型のRGB値を求め、それを 6桁の16進数に変換します。
Sub 色見本()
txt背景色 = HexRGB$
txt見本.BackColor = BGR$(txt背景色) txt見本.ForeColor = &HFFFFFF End Sub
txt背景色 RGB値（6桁の16進数）を代入し、txt見本の背景色と文字色を出力します。
Private Sub cmd実行_Click()
Selection.Font.Shading.BackgroundPatternColor = BGR$(txt背景色) Selection.Font.Color = &HFFFFFF
End Sub
Word文書内の選択範囲の背景色と文字色を出力します。
(2) TEXTOS-C-2
次のコントロールを追加します。
opt背景色 [背景色] Word文書中の選択範囲の文字列の背景色を指定します。
txt背景色 [0000FF]16進数を使って背景色を表示します。
opt文字色 [文字色] Word文書中の選択範囲の文字列の文字色を指定します。
txt文字色 [FFFFFF] 16進数を使って文字色を表示します。
39
cmd純色 △純色：クリックすると明度を 120, 彩度を 240にリセットします。
次のサブルーチンを追加します。
Sub opt背景色_Click()
HexRGB$ = txt背景色: Call HLS変換 End Sub
opt背景色がクリックしたとき、16 進数の txt背景色を HexREG$に代入し、サブルー チンHLS変換を呼びます。
Sub opt文字色_Click()
HexRGB$ = txt文字色: Call HLS変換 End Sub
opt背景色と同様です。
Private Sub cmd純色_Click()
spn明度 = 6: spn彩度 = 12: Call 色見本 End Sub
cmd純色をクリックしたときに、spn明度 を中位の 6に、spn 彩度を最大(Max)の 12 にリセットして、サブルーチン色見本を呼び出します。
Sub HLS変換() 'HexRGB$ → spnt色相, spn明度, spn彩度 Dim H%, L%, S%
Call ColorRGBToHLS("&H" & HexRGB$, H%, L%, S%) 'HLS変換サブルーチン spn色相 = IIf(L% = 0 Or L% = 240 Or S% = 0, 0, H% * 12 / 240)
spn明度 = L% * 12 / 240 spn彩度 = S% * 12 / 240 End Sub
ライブラリーのHLS変換サブルーチンに RGB値とそれぞれの変数名を渡すと、それ ぞれの変数に値が返される。それらをスピンボタンに代入します（テキストボックス に代入することも可能ですが、スピンボックスに代入すればテキストボックスと値が 連動します。）。スピンボタンの最大(Max)は12であり、それと連動するテキストボ ックスの最大(Max)は 240 なので 12/240 で調節します。無彩色の場合は色相をゼロと します。
40
Sub RGB変換() 'txt色相, txt明度, txt彩度 → HexRGB$
If Val(txt彩度) = 0 Then '明度だけでRGBを表示
HexRGB$ = Right$("0" & Hex$(Int(txt明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
LngRGB& = ColorHLSToRGB(txt色相, txt明度, txt彩度) 'RGB変換関数 HexRGB$ = Right$("00000" & Hex$(LngRGB&), 6)
End If End Sub
txt 色相、txt 明度、txt彩度の値から RGB 値を得るためのサブルーチンです。彩度が ゼロのときは、明度だけで RGB の値を表示します。赤、緑、青の値は同じで、明度 の大きさに応じて0 ~ 255の範囲で増減させます。彩度がゼロでなければ、色相、明 度、彩度の値を引数として、RGB変換関数が返す値を 16 進数に変え、該当するテキ ストボックスに出力します。
(3) TEXTOS-C-3
次のコントロールを追加します。
lbl赤 赤(R)
txt赤 0-255の範囲で赤の値を表示します。
spn赤 赤の値を調節します。
lbl緑 緑(G)
txt緑 0-255の範囲で緑の値を表示します。
spn緑 緑の値を調節します。
41 lbl青 青(B)
txt青 0-255の範囲で青の値を表示します。
spn青 青の値を調節します。
次のサブルーチンに一部を追加します。最後のtxt赤、txt緑、txt青の値は、色相、明 度、彩度の値に連動します。
Sub RGB変換() 'txt色相, txt明度, txt彩度 → txt赤、txt緑、txt青 If Val(txt彩度) = 0 Then '明度だけでRGBを表示
HexRGB$ = Right$("0" & Hex$(Int(txt明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
lngRGB& = ColorHLSToRGB(txt色相, txt明度, txt彩度) 'RGB変換関数 HexRGB$ = Right$("00000" & Hex$(lngRGB&), 6)
End If
txt赤 = Mid$(HexRGB$, 1, 2) txt緑 = Mid$(HexRGB$, 3, 2) txt青 = Mid$(HexRGB$, 5, 2) End Sub
次のサブルーチンを追加します。
Sub spn赤_Change()
txt赤 = Right$("0" & Hex$(Int(spn赤 * 255 / 17)), 2) HexRGB$ = txt赤 & txt緑 & txt青
Call HLS変換: Call 色見本 End Sub
spn赤が変化したときに、txt赤2桁の16進数を代入し、6桁の16進数でRGB値を計 算し、HLS変換と色見本のサブルーチンを呼び出します。
Sub spn緑_Change()
txt緑 = Right$("0" & Hex$(Int(spn緑 * 255 / 17)), 2) HexRGB$ = txt赤 & txt緑 & txt青
Call HLS変換: Call 色見本 End Sub
42 spn赤と同様です。
Sub spn青_Change()
txt青 = Right$("0" & Hex$(Int(spn青 * 255 / 17)), 2) HexRGB$ = txt赤 & txt緑 & txt青
Call HLS変換: Call 色見本 End Sub
spn赤と同様です。
TEXTOS-2「色彩」全体のコード
Sub ■色彩() '***********************************************
If chk文字色 Then Selection.Font.Color = BGR$(txt文字色値) If chk下線色 Then Selection.Font.Underline = wdUnderlineWavy
If chk下線色 Then Selection.Font.UnderlineColor = BGR$(txt下線色値)
If chk 蛍 光 色 Then Selection.Range.HighlightColorIndex =
Options.DefaultHighlightColorIndex Selection.Font.Bold = chk太字 End Sub
Sub opt文字色_Click()
HexRGB$ = txt文字色値: Call HLS変換: Call RGB変換 End Sub
Sub opt下線色_Click()
HexRGB$ = txt下線色値: Call HLS変換: Call RGB変換 End Sub
Sub spn色相_Change()
txt色相 = spn色相 * 240 / 12: Call RGB変換: Call 色見本 End Sub
Sub spn明度_Change()
txt明度 = spn明度 * 240 / 12: Call RGB変換: Call 色見本 End Sub
43 Sub spn彩度_Change()
txt彩度 = spn彩度 * 240 / 12: Call RGB変換: Call 色見本 End Sub
Sub spn赤_Change()
txt赤 = Right$("0" & Hex$(Int(spn赤 * 255 / 17)), 2) HexRGB$ = txt赤 & txt緑 & txt青
Call HLS変換: Call 色見本 End Sub
Sub spn緑_Change()
txt緑 = Right$("0" & Hex$(Int(spn緑 * 255 / 17)), 2) HexRGB$ = txt赤 & txt緑 & txt青
Call HLS変換: Call 色見本 End Sub
Sub spn青_Change()
txt青 = Right$("0" & Hex$(Int(spn青 * 255 / 17)), 2) HexRGB$ = txt赤 & txt緑 & txt青
Call HLS変換: Call 色見本 End Sub
Sub cmd純色_Click()
spn明度 = 6: spn彩度 = 12: Call 色見本 End Sub
Private Sub cmd黒_Click()
spn明度 = 0: spn彩度 = 0: Call 色見本 End Sub
Private Sub cmd白_Click()
spn明度 = 12: spn彩度 = 0: Call 色見本 End Sub
Sub HLS変換() 'HexRGB$ → spnt色相, spn明度, spn彩度 Dim H%, L%, S%
44
Call ColorRGBToHLS("&H" & HexRGB$, H%, L%, S%) 'HLS 変換サブルーチン spn色相 = IIf(L% = 0 Or L% = 240 Or S% = 0, 0, H% * 12 / 240)
spn明度 = L% * 12 / 240 spn彩度 = S% * 12 / 240 End Sub
Sub RGB変換() 'txt色相, txt明度, txt彩度 → txt赤、txt緑、txt青 If Val(txt彩度) = 0 Then '明度だけでRGBを表示
HexRGB$ = Right$("0" & Hex$(Int(txt明度 * 255 / 240)), 2) HexRGB$ = HexRGB$ & HexRGB$ & HexRGB$
Else
lngRGB& = ColorHLSToRGB(txt色相, txt明度, txt彩度) 'RGB変換関数 HexRGB$ = Right$("00000" & Hex$(lngRGB&), 6)
End If
txt赤 = Mid$(HexRGB$, 1, 2) txt緑 = Mid$(HexRGB$, 3, 2) txt青 = Mid$(HexRGB$, 5, 2) End Sub
Private Sub cbo蛍光色_Change() Call 色見本
End Sub
Sub 色見本()
If opt文字色 Then txt文字色値 = HexRGB$
If opt下線色 Then txt下線色値 = HexRGB$
txt文字色.ForeColor = BGR$(txt文字色値) txt下線色.BackColor = BGR$(txt下線色値)
txt文字色.BackColor = "&H" & 蛍光色配列$(cbo蛍光色.ListIndex) Options.DefaultHighlightColorIndex = cbo蛍光色.ListIndex
45 txt文字色.Font.Bold = chk太字
End Sub
Function BGR$(W$) 'RGB$から16進数BGR$に変換
BGR$ = "&H" & Right$(W$, 2) & Mid$(W$, 3, 2) & Left$(W$, 2) End Function
46