VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} FormPalette 
   Caption         =   "パレット"
   ClientHeight    =   3585
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4110
   OleObjectBlob   =   "FormPalette.frx":0000
   ShowModal       =   0   'False
   StartUpPosition =   1  'オーナー フォームの中央
End
Attribute VB_Name = "FormPalette"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Cls_Palette(55) As New ClassPalette 'パレット用コマンドボタン

Private Sub UserForm_Initialize() '初期化
Dim For_cnt As Long
For For_cnt = 0 To 55 'パレット
  Cls_Palette(For_cnt).setBtn = Controls("CommandButton" & CStr(For_cnt + 1)) 'コマンドボタン解放
  Cls_Palette(For_cnt).setIndex = For_cnt + 1 'インデックス
  Cls_Palette(For_cnt).updatePalette 'パレット更新
Next For_cnt
TxtColorsSet.Value = "ffffff"
End Sub
Private Sub UserForm_Terminate() '終了化
Dim For_cnt As Long
For For_cnt = 0 To 55 'パレット
  Cls_Palette(For_cnt).setNothing 'コマンドボタン解放
Next For_cnt
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '閉じる
If SheetCanvas.getBol_Init Then '起動しているなら
  If CloseMode = 0 Then '[×]ボタンで閉じようとすれば
    MsgBox "りっぷ2(りっぷつぅ)の[×]ボタンから終了してください"
    Cancel = 1 '閉じない
  End If
Else
  MsgBox "不具合が発生しました" & Chr(10) _
    & Chr(10) & "りっぷ2(りっぷつぅ)を強制終了します"
  End 'マクロを全て終了
End If
End Sub

Public Sub setPenLabel(MainIsTrue As Boolean) 'ペンの色ラベルを設定
Dim Label_name As String
Dim Clr_no As Long
If MainIsTrue Then
  Label_name = "LblPenClr0"
Else
  Label_name = "LblPenClr1"
End If
Clr_no = SheetCanvas.getPenColor(MainIsTrue)
If Clr_no = -4142 Then '塗りつぶしなしなら
  Controls(Label_name).ForeColor = BtnClr4142.ForeColor '前景(文字)色
  Controls(Label_name).BackColor = BtnClr4142.BackColor '背景色
  Controls(Label_name).ControlTipText = "塗りつぶしなし"
Else
  Controls(Label_name).ForeColor = Controls("CommandButton" & CStr(Clr_no)).ForeColor '前景(文字)色
  Controls(Label_name).BackColor = Controls("CommandButton" & CStr(Clr_no)).BackColor '背景色
  Controls(Label_name).ControlTipText = "カラーインデックス：" & CStr(Clr_no)
End If
End Sub
Private Sub BtnClrCell_MouseDown(ByVal Button As Integer, ByVal Shift As Integer _
  , ByVal X As Single, ByVal Y As Single) 'セル色
Select Case Button
Case 1 '左クリック
  SheetCanvas.setPenColor ActiveCell.Interior.ColorIndex, False '副の色
  setPenLabel False 'ペンの色ラベルを設定
Case 2 '右クリック
  SheetCanvas.setPenColor ActiveCell.Interior.ColorIndex, True '主の色
  setPenLabel True 'ペンの色ラベルを設定
End Select
End Sub
Private Sub BtnClr4142_MouseDown(ByVal Button As Integer, ByVal Shift As Integer _
  , ByVal X As Single, ByVal Y As Single) '色なし
Select Case Button
Case 1 '左クリック
  SheetCanvas.setPenColor -4142, False '副の色
  setPenLabel False 'ペンの色ラベルを設定
Case 2 '右クリック
  SheetCanvas.setPenColor -4142, True '主の色
  setPenLabel True 'ペンの色ラベルを設定
End Select
End Sub
Private Sub BtnClrChange_Click() '主⇔副
SheetCanvas.changePenColor
setPenLabel True '主
setPenLabel False '副
End Sub
Private Sub BtnClrReset_Click() '更新
Dim For_cnt As Long
For For_cnt = 0 To 55
  Cls_Palette(For_cnt).updatePalette
Next For_cnt
End Sub
Private Sub TxtColorsSet_Change() 'RGB値入力
Dim Text_rgb As String
Dim R_size As Long, G_size As Long, B_size As Long, Clr_rgb As Long
Text_rgb = TxtColorsSet.Value
If Len(Text_rgb) = 6 Then '2桁*3色なら
  R_size = CLng(Val("&H" & Right(Text_rgb, 2))) 'R
  G_size = CLng(Val("&H" & Mid(Text_rgb, 3, 2))) 'G
  B_size = CLng(Val("&H" & Left(Text_rgb, 2))) 'B
  If -1 < R_size And R_size < 256 And -1 < G_size And G_size < 256 _
    And -1 < B_size And B_size < 256 Then '各色0〜255以内なら
    Clr_rgb = RGB(R_size, G_size, B_size) '色番号
    TxtColorsSet.BackColor = Clr_rgb '背景色
    If R_size + G_size + B_size > 380 Then '色が薄ければ
      TxtColorsSet.ForeColor = &H0 '文字の色を黒
    Else
      TxtColorsSet.ForeColor = &HFFFFFF '文字の色を白
    End If
  End If
End If
End Sub
Private Sub BtnColorsSet_MouseDown(ByVal Button As Integer, ByVal Shift As Integer _
  , ByVal X As Single, ByVal Y As Single) '1色登録
Dim Text_rgb As String
Dim Clr_no As Long, Clr_rgb As Long, R_size As Long, G_size As Long, B_size As Long
Select Case Button
Case 1 '左クリック
  Clr_no = SheetCanvas.getPenColor(False)
Case 2 '右クリック
  Clr_no = SheetCanvas.getPenColor(True)
End Select
If 0 < Clr_no And Clr_no < 57 Then '塗りつぶしなしでないなら
  Text_rgb = TxtColorsSet.Value
  If Len(Text_rgb) = 6 Then '2桁*3色なら
    R_size = CLng(Val("&H" & Right(Text_rgb, 2))) 'R
    G_size = CLng(Val("&H" & Mid(Text_rgb, 3, 2))) 'G
    B_size = CLng(Val("&H" & Left(Text_rgb, 2))) 'B
    If -1 < R_size And R_size < 256 And -1 < G_size And G_size < 256 _
      And -1 < B_size And B_size < 256 Then '各色0〜255以内なら
      Clr_rgb = RGB(R_size, G_size, B_size) '色番号
      ActiveWorkbook.Colors(Clr_no) = Clr_rgb 'カラーインデックス変更
      Cls_Palette(Clr_no - 1).updatePalette
    End If
  End If
  Select Case Button
  Case 1 '左クリック
    setPenLabel False
  Case 2 '右クリック
    setPenLabel True
  End Select
End If
End Sub
Private Sub TxtColorsSet_MouseDown(ByVal Button As Integer, ByVal Shift As Integer _
  , ByVal X As Single, ByVal Y As Single)
If Button = 2 Then '右クリックなら
  If Shift = 1 Then 'Shiftキーが押されていれば
    TxtColorsSet.Value = Right$("00000" & Hex(ActiveWorkbook.Colors(SheetCanvas.getPenColor(False))), 6) '副の色
  Else
    TxtColorsSet.Value = Right$("00000" & Hex(ActiveWorkbook.Colors(SheetCanvas.getPenColor(True))), 6) '主の色
  End If
End If
End Sub