VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} FormTool 
   Caption         =   "りっぷ2(りっぷつぅ)"
   ClientHeight    =   4110
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4710
   OleObjectBlob   =   "FormTool.frx":0000
   ShowModal       =   0   'False
   StartUpPosition =   1  'オーナー フォームの中央
End
Attribute VB_Name = "FormTool"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Cls_Clip(9) As New ClassClip 'クリップ用オプションボタン
Private Cls_ClipName(9) As New ClassClipName 'クリップ用テキストボックス
Private Cls_Spray(4) As New ClassSpray 'スプレー用オプションボタン

Private Lng_PenColorsMain(3) As Long 'ペンの色、主
Private Lng_PenColorsSub(3) As Long 'ペンの色、副
Private Lng_PenSprays(3) As Long 'スプレー
Private Lng_PenSizesY(2) As Long 'ペンの大きさ(縦)
Private Lng_PenSizesX(2) As Long 'ペンの大きさ(横)
Private Lng_PenIntervals(3) As Long 'ペンの間隔

Private Sub UserForm_Initialize() '初期化
Dim For_cnt As Long, For_pos As Long, Pos_no As Long
Load FormPalette 'パレットをロード
PagTool.Value = 0
For For_cnt = 0 To 4 'スプレー
  Cls_Spray(For_cnt).setOpt = Controls("OptPenSpray" & CStr(For_cnt)) 'オプションボタン生成
  Cls_Spray(For_cnt).setIndex = For_cnt 'インデックス
Next For_cnt
For For_cnt = 0 To 9 'クリップ
  Cls_Clip(For_cnt).setOpt = Controls("OptClip" & CStr(For_cnt)) 'オプションボタン生成
  Cls_Clip(For_cnt).setIndex = For_cnt 'インデックス
  Cls_ClipName(For_cnt).setTxt = Controls("TxtClip" & CStr(For_cnt)) 'テキストボックス生成
  Cls_ClipName(For_cnt).setIndex = For_cnt 'インデックス
Next For_cnt 'パレット

With SheetClip
  '■基本
  For For_cnt = 0 To 3 'ペン先の数だけ繰り返し(クリップなし)
    Pos_no = CLng(Val(.Cells(ModuleConst.PENCOLOR_MAIN, For_cnt + 1))) 'ペンの色(主)
    If Pos_no < 1 Or 56 < Pos_no Then 'カラーインデックスは、1〜56
      Lng_PenColorsMain(For_cnt) = 32 'パレット右下の色
    Else
      Lng_PenColorsMain(For_cnt) = Pos_no
    End If
    Pos_no = CLng(Val(.Cells(ModuleConst.PENCOLOR_SUB, For_cnt + 1))) 'ペンの色(副)
    If Pos_no < 1 Or 56 < Pos_no Then 'カラーインデックスは、1〜56
      Lng_PenColorsSub(For_cnt) = -4142 '塗りつぶしなし
    Else
      Lng_PenColorsSub(For_cnt) = Pos_no
    End If
    Pos_no = CLng(Val(.Cells(ModuleConst.PENSPRAY, For_cnt + 1))) 'ペンのスプレー
    If Pos_no < 0 Or 4 < Pos_no Then 'スプレーは、0〜4
      Lng_PenSprays(For_cnt) = 0
    Else
      Lng_PenSprays(For_cnt) = Pos_no
    End If
    Pos_no = CLng(Val(.Cells(ModuleConst.PENINTERVAL, For_cnt + 1))) 'ペンの間隔
    If Pos_no < ScrPenInterval.Min Or ScrPenInterval.Max < Pos_no Then 'ペンの間隔は、0〜18
      Lng_PenIntervals(For_cnt) = ScrPenInterval.Min
    Else
      Lng_PenIntervals(For_cnt) = Pos_no
    End If
  Next For_cnt
  For For_cnt = 0 To 2 'ペン先の数だけ繰り返し(クリップ以外)
    Pos_no = CLng(Val(.Cells(ModuleConst.PENSIZE_Y, For_cnt + 1))) 'ペンの大きさ(縦)
    If Pos_no < ScrPenSize0.Min Or ScrPenSize0.Max < Pos_no Then 'ペンの大きさは、1〜30
      Lng_PenSizesY(For_cnt) = ScrPenSize0.Max
    Else
      Lng_PenSizesY(For_cnt) = Pos_no
    End If
    Pos_no = CLng(Val(.Cells(ModuleConst.PENSIZE_X, For_cnt + 1))) 'ペンの大きさ(横)
    If Pos_no < ScrPenSize0.Min Or ScrPenSize0.Max < Pos_no Then 'ペンの大きさは、1〜30
      Lng_PenSizesX(For_cnt) = ScrPenSize0.Min
    Else
      Lng_PenSizesX(For_cnt) = Pos_no
    End If
  Next For_cnt
  Pos_no = CLng(Val(.Cells(ModuleConst.PENSELECT, 1))) '選択しているペン先
  If Pos_no < 0 And 3 < Pos_no Then 'ペン先は、0〜3
    Pos_no = 0
  End If
  With SheetCanvas
    .setPenColor Lng_PenColorsMain(Pos_no), True 'ペンの色、主
    .setPenColor Lng_PenColorsSub(Pos_no), False 'ペンの色、副
    .setPenSpray Lng_PenSprays(Pos_no) 'スプレー
    If Pos_no = 3 Then 'クリップなら
      ScrPenSize0.Value = ScrPenSize0.Max 'ペンの大きさ(縦)
      ScrPenSize1.Value = ScrPenSize1.Min 'ペンの大きさ(横)
    Else
      .setPenSize ScrPenSize0.Max + 1 - Lng_PenSizesY(Pos_no), False 'ペンの大きさ(縦)
      ScrPenSize0 = Lng_PenSizesY(Pos_no)
      .setPenSize Lng_PenSizesX(Pos_no), True 'ペンの大きさ(横)
      ScrPenSize1 = Lng_PenSizesX(Pos_no)
    End If
    ScrPenInterval.Value = Lng_PenIntervals(Pos_no)
    .setPenInterval Lng_PenIntervals(Pos_no) 'ペンの間隔
  End With
  Controls("OptPen" & CStr(Pos_no)).Value = True 'ペン先を選択
  ChkPenClip.Value = CBool(.Cells(ModuleConst.PENCLIP, 1)) 'クリップ中抜き

  TglLog.Value = CBool(.Cells(ModuleConst.LOGSET, 1)) '履歴の有無
  SheetCanvas.changeLog TglLog.Value
  SheetCanvas.deleteLog '履歴削除
  TglLog.ControlTipText = "描画履歴を取る(最大値：" & CStr(SheetCanvas.getLogMax) & "操作)"
  TglMask.Value = CBool(.Cells(ModuleConst.MASKSET, 1)) 'マスクの有無
  SheetCanvas.setMask TglMask.Value
  'Excel2007のバグ対策(列幅変更後列の再表示で、列幅が元に戻る)
  Pos_no = CLng(Val(.Cells(ModuleConst.CELLSIZE_Y, 1))) 'セルの幅(縦)
  If Pos_no < ScrCellSize0.Min Or ScrCellSize0.Max < Pos_no Then 'セルの幅は、1〜13
    ScrCellSize0.Value = ScrCellSize0.Max + 1 - 4 'デフォルトは、4ピクセル
  Else
    ScrCellSize0.Value = Pos_no
  End If
  Pos_no = CLng(Val(.Cells(ModuleConst.CELLSIZE_X, 1))) 'セルの幅(横)
  If Pos_no < ScrCellSize1.Min Or ScrCellSize1.Max < Pos_no Then 'セルの幅は、1〜13
    ScrCellSize1.Value = 4 'デフォルトは、4ピクセル
  Else
    ScrCellSize1.Value = Pos_no
  End If

  '■応用
  Pos_no = CLng(Val(.Cells(ModuleConst.CANVASSIZE_Y, 1))) 'カンバスサイズ(縦)
  If Pos_no < 1 Or SheetCanvas.getCanvasMax(False) < Pos_no Then 'カンバス外なら
    Pos_no = 256 'デフォルトは、256
  End If
  TxtCanvasSize0.Value = CStr(Pos_no) 'カンバスサイズ(縦)
  Pos_no = CLng(Val(.Cells(ModuleConst.CANVASSIZE_X, 1))) 'カンバスサイズ(横)
  If Pos_no < 1 Or SheetCanvas.getCanvasMax(True) < Pos_no Then 'カンバス外なら
    Pos_no = 256 'デフォルトは、256
  End If
  TxtCanvasSize1.Value = CStr(Pos_no) 'カンバスサイズ(横)
  SheetCanvas.setCellCanvasSize ScrCellSize0.Max + 1 - ScrCellSize0.Value _
    , ScrCellSize1.Value, CLng(TxtCanvasSize0.Value), Pos_no 'セル幅、カンバスサイズの設定
  TxtCanvasSize0.ControlTipText = "カンバスの縦の大きさ(範囲：1〜" & SheetCanvas.getCanvasMax(False) & ")"
  TxtCanvasSize1.ControlTipText = "カンバスの横の大きさ(範囲：1〜" & SheetCanvas.getCanvasMax(True) & ")"
  LblBack.ControlTipText = SheetCanvas.changeBack(False)
  LblBack.Caption = "<背景なし>"
  TglGrid.Value = ActiveWindow.DisplayGridlines 'グリッド線
  If TglGrid.Value Then 'グリッド線がオンなら
    TglGrid.Caption = "グリッド線：オン"
  Else
    TglGrid.Caption = "グリッド線：オフ"
  End If

  Pos_no = CLng(Val(.Cells(ModuleConst.PAINT_PER, 1))) 'いろいろ描画、濃度と太さ
  If Pos_no < ScrPaint.Min Or ScrPaint.Max < Pos_no Then '濃度と太さは、1〜50
    ScrPaint.Value = ScrPaint.Max 'デフォルトは、1
  Else
    ScrPaint.Value = Pos_no
  End If
  Pos_no = CLng(Val(.Cells(ModuleConst.PAINT_PLANE, 1))) 'いろいろ描画、図形
  If Pos_no < 0 Or 6 < Pos_no Then '図形は、0〜6
    OptPaint0.Value = True 'デフォルトは、四角：■
  Else
    Controls("OptPaint" & CStr(Pos_no)).Value = True
  End If
  Pos_no = CLng(Val(.Cells(ModuleConst.PAINT_SPRAY, 1))) 'いろいろ描画、塗り方
  If Pos_no < 0 Or 2 < Pos_no Then '塗り方は、0〜2
    OptPaintSpray0.Value = True 'デフォルトは、全部
  Else
    Controls("OptPaintSpray" & CStr(Pos_no)).Value = True
  End If
  Pos_no = CLng(Val(.Cells(ModuleConst.PAINT_SHADE, 1))) 'いろいろ描画、ぼかしの太さ
  If Pos_no < SpnPaint.Min Or SpnPaint.Max < Pos_no Then '濃度と太さは、1〜4
    SpnPaint.Value = 1 'デフォルトは、1
  Else
    SpnPaint.Value = Pos_no
  End If
  OptPaint6.Caption = "ぼかし　幅：" & CStr(SpnPaint.Value * 4)

  '■クリップ
  LblComp.Caption = "" 'レイヤクリア
  TabClip.Enabled = False 'イベントをオフ
  TabClip.Value = 0 'クリップAを選択
  TabClip.Enabled = True 'イベントをオン
  For For_cnt = 0 To 9 'クリップの数だけ繰り返し
    Controls("TxtClip" & CStr(For_cnt)).Value = CStr(.Cells(ModuleConst.CLIPNAME, For_cnt + 1)) 'クリップ名
  Next For_cnt
  OptClip0.Value = True 'クリップ0を選択
End With
FormPalette.Show
End Sub
Private Sub UserForm_Terminate() '終了化
Dim For_cnt As Long, For_pos As Long
For_cnt = SheetCanvas.getPenType '現在のペン先
Controls("OptPen" & CStr(For_cnt)).Value = False '選択解除
Controls("OptPen" & CStr(For_cnt)).Value = True '再選択(情報を保存)
With SheetClip
  '■基本
  For For_cnt = 0 To 3 'ペン先の数だけ繰り返し(クリップなし)
    .Cells(ModuleConst.PENCOLOR_MAIN, For_cnt + 1) = Lng_PenColorsMain(For_cnt) 'ペンの色(主)
    .Cells(ModuleConst.PENCOLOR_SUB, For_cnt + 1) = Lng_PenColorsSub(For_cnt) 'ペンの色(副)
    .Cells(ModuleConst.PENSPRAY, For_cnt + 1) = Lng_PenSprays(For_cnt) 'ペンのスプレー
    .Cells(ModuleConst.PENINTERVAL, For_cnt + 1) = Lng_PenIntervals(For_cnt) 'ペンの間隔
  Next For_cnt
  For For_cnt = 0 To 2 'ペン先の数だけ繰り返し(クリップあり)
    .Cells(ModuleConst.PENSIZE_Y, For_cnt + 1) = Lng_PenSizesY(For_cnt) 'ペンの大きさ(縦)
    .Cells(ModuleConst.PENSIZE_X, For_cnt + 1) = Lng_PenSizesX(For_cnt) 'ペンの大きさ(横)
  Next For_cnt
  For For_pos = 0 To 3
    If Controls("OptPen" & CStr(For_pos)).Value Then 'ペン先が選択されていれば
      .Cells(ModuleConst.PENSELECT, 1) = For_pos '選択しているペン先
      Exit For
    End If
  Next For_pos
  .Cells(ModuleConst.PENCLIP, 1) = ChkPenClip.Value 'クリップ中抜き
  .Cells(ModuleConst.CELLSIZE_Y, 1) = ScrCellSize0.Value 'セルの幅(縦)
  .Cells(ModuleConst.CELLSIZE_X, 1) = ScrCellSize1.Value 'セルの幅(横)
  .Cells(ModuleConst.LOGSET, 1) = TglLog.Value '履歴の有無
  SheetCanvas.deleteLog '履歴削除
  .Cells(ModuleConst.MASKSET, 1) = TglMask.Value 'マスクの有無
  '■応用
  .Cells(ModuleConst.CANVASSIZE_Y, 1) = CLng(Val(TxtCanvasSize0.Value)) 'カンバスサイズ(縦)
  .Cells(ModuleConst.CANVASSIZE_X, 1) = CLng(Val(TxtCanvasSize1.Value)) 'カンバスサイズ(横)
  SheetCanvas.changeBack False '背景削除
  For For_pos = 0 To 6
    If Controls("OptPaint" & CStr(For_pos)).Value Then '図形が選択されていれば
      .Cells(ModuleConst.PAINT_PLANE, 1) = For_pos 'いろいろ描画、図形
      Exit For
    End If
  Next For_pos
  For For_pos = 0 To 2
    If Controls("OptPaintSpray" & CStr(For_pos)).Value Then '塗り方が選択されていれば
      .Cells(ModuleConst.PAINT_SPRAY, 1) = For_pos 'いろいろ描画、塗り方
      Exit For
    End If
  Next For_pos
  .Cells(ModuleConst.PAINT_PER, 1) = ScrPaint.Value 'いろいろ描画、濃度と太さ
  .Cells(ModuleConst.PAINT_SHADE, 1) = SpnPaint.Value 'いろいろ描画、ぼかしの太さ
End With

For For_cnt = 0 To 4 'スプレー
  Cls_Spray(For_cnt).setNothing 'オプションボタン解放
Next For_cnt
For For_cnt = 0 To 9 'クリップ
  Cls_Clip(For_cnt).setNothing 'オプションボタン解放
  Cls_ClipName(For_cnt).setNothing 'テキストボックス解放
Next For_cnt 'パレット
Unload FormPalette 'パレットをアンロード
SheetCanvas.setTerminate
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '閉じる
Dim Msg_ans As Long
If SheetCanvas.getBol_Init Then '起動しているなら
  If CloseMode = 0 Then '[×]ボタンで閉じようとすれば
    Msg_ans = MsgBox("りっぷ2(りっぷつぅ)を終了します" & Chr(10) _
    & Chr(10) & "背景と履歴が消去されます", vbYesNo)
    If Msg_ans = 7 Then 'いいえ
      Cancel = 1 '閉じない
    End If
  End If
Else
  MsgBox "不具合が発生しました" & Chr(10) _
    & Chr(10) & "りっぷ2(りっぷつぅ)を強制終了します"
  End 'マクロを全て終了
End If
End Sub

'■基本
Private Sub changePenType(After_type As Long) 'ペン先変更
Dim Before_type As Long
With SheetCanvas
  Before_type = .getPenType '以前のペン先
  Lng_PenColorsMain(Before_type) = .getPenColor(True) 'ペンの色、主
  Lng_PenColorsSub(Before_type) = .getPenColor(False) 'ペンの色、副
  If Before_type <> 3 Then 'クリップでなければ
    Lng_PenSizesY(Before_type) = ScrPenSize0.Value 'ペンの大きさ(縦)
    Lng_PenSizesX(Before_type) = ScrPenSize1.Value 'ペンの大きさ(横)
  End If
  Lng_PenIntervals(Before_type) = ScrPenInterval.Value 'ペンの間隔
  Lng_PenSprays(Before_type) = .getPenSpray 'スプレー
  .setPenType After_type '以後のペン先
  .setPenColor Lng_PenColorsMain(After_type), True 'ペンの色、主
  .setPenColor Lng_PenColorsSub(After_type), False 'ペンの色、副
  If After_type <> 3 Then 'クリップでなければ
    ScrPenSize0.Value = Lng_PenSizesY(After_type) 'ペンの大きさ(縦)
    ScrPenSize1.Value = Lng_PenSizesX(After_type) 'ペンの大きさ(横)
  End If
  ScrPenInterval.Value = Lng_PenIntervals(After_type) 'ペンの間隔
  Controls("OptPenSpray" & CStr(Lng_PenSprays(After_type))).Value = True 'スプレー
  FormPalette.setPenLabel True 'ペンの色ラベルを設定、主
  FormPalette.setPenLabel False 'ペンの色ラベルを設定、副
End With
End Sub
Private Sub OptPen0_Click() 'ペン先、ノーマル
changePenType 0
ScrPenSize0.Enabled = True 'ペンの大きさ、スクロールバー
ScrPenSize1.Enabled = True
LblPenSize.Enabled = True 'ペンの大きさ、ラベル
ChkPenClip.Enabled = False 'クリップ中抜き
ChkPenClip.ControlTipText = "クリップの塗りつぶしなしを描画する"
OptPenSpray0.Caption = "なし" 'スプレー
End Sub
Private Sub OptPen1_Click() 'ペン先、スポイト
changePenType 1
ScrPenSize0.Enabled = True 'ペンの大きさ、スクロールバー
ScrPenSize1.Enabled = True
LblPenSize.Enabled = True 'ペンの大きさ、ラベル
ChkPenClip.Enabled = False 'クリップ中抜き
ChkPenClip.ControlTipText = "クリップの塗りつぶしなしを描画する"
OptPenSpray0.Caption = "なし" 'スプレー
End Sub
Private Sub OptPen2_Click() 'ペン先、ユビサキ
changePenType 2
ScrPenSize0.Enabled = True 'ペンの大きさ、スクロールバー
ScrPenSize1.Enabled = True
LblPenSize.Enabled = True 'ペンの大きさ、ラベル
ChkPenClip.Enabled = False 'クリップ中抜き
ChkPenClip.ControlTipText = "クリップの塗りつぶしなしを描画する"
OptPenSpray0.Caption = "なし" 'スプレー
End Sub
Private Sub OptPen3_Click() 'ペン先、クリップ
changePenType 3
ScrPenSize0.Enabled = False 'ペンの大きさ、スクロールバー
ScrPenSize1.Enabled = False
LblPenSize.Enabled = False 'ペンの大きさ、ラベル
ChkPenClip.Enabled = True 'クリップ中抜き
If ChkPenClip.Value Then 'チェックありなら
  ChkPenClip.ControlTipText = "クリップの塗りつぶしなしを描画しない"
  OptPenSpray0.Caption = "ベタ" 'スプレー
Else
  ChkPenClip.ControlTipText = "クリップの塗りつぶしなしを描画する"
  OptPenSpray0.Caption = "なし" 'スプレー
End If
End Sub
Private Sub ChkPenClip_Click() 'クリップ中抜き
If ChkPenClip.Value Then 'チェックありなら
  ChkPenClip.ControlTipText = "クリップの塗りつぶしなしを描画しない"
  OptPenSpray0.Caption = "ベタ" 'スプレー
Else
  ChkPenClip.ControlTipText = "クリップの塗りつぶしなしを描画する"
  OptPenSpray0.Caption = "なし" 'スプレー
End If
SheetCanvas.setPenClip ChkPenClip.Value
End Sub

Private Sub ScrPenSize0_Change() 'ペンの縦の大きさ
Dim Pen_size As Long
Pen_size = ScrPenSize0.Max + 1 - ScrPenSize0.Value '補正
If 15 < Pen_size Then
  Pen_size = 15 + (Pen_size - 15) * 2
End If
SheetCanvas.setPenSize Pen_size, False
LblPenSize.Caption = "ペンの　　→縦：" & SheetCanvas.getPenSize(False) _
  & Chr(10) & "大きさ　　↓横：" & SheetCanvas.getPenSize(True)
End Sub
Private Sub ScrPenSize1_Change() 'ペンの横の大きさ
Dim Pen_size As Long
Pen_size = ScrPenSize1.Value
If 15 < Pen_size Then
  Pen_size = 15 + (Pen_size - 15) * 2
End If
SheetCanvas.setPenSize Pen_size, True
LblPenSize.Caption = "ペンの　　→縦：" & SheetCanvas.getPenSize(False) _
  & Chr(10) & "大きさ　　↓横：" & SheetCanvas.getPenSize(True)
End Sub
Private Sub ScrPenInterval_Change() 'ペンの間隔
Dim Interval_size As Long
If ScrPenInterval.Value < 4 Then '0〜3
  Interval_size = ScrPenInterval.Value 'そのまま
Else
  Interval_size = 2 ^ (ScrPenInterval.Value / 2) '値補正
End If
SheetCanvas.setPenInterval Interval_size
LblPenInterval.Caption = "ペンの間隔：" & Interval_size & "ミリ秒"
End Sub

Private Sub TglMask_Click() 'マスク
SheetCanvas.setMask TglMask.Value
If TglMask.Value Then
  TglMask.Caption = "マスク：オン"
Else
  TglMask.Caption = "マスク：オフ"
End If
End Sub

Private Sub BtnLogRedo_Click() 'リドゥ
SheetCanvas.reduLog
End Sub
Private Sub BtnLogUndo_Click() 'アンドゥ
SheetCanvas.undoLog
End Sub
Private Sub BtnLogDel_Click() '履歴削除
Dim Msg_ans As Long
Msg_ans = MsgBox("全ての履歴を削除します", vbYesNo)
If Msg_ans = 6 Then 'はい
  SheetCanvas.deleteLog
End If
End Sub
Private Sub TglLog_Click() '履歴のオンオフ
If TglLog.Value Then 'オンなら
  TglLog.Caption = "履歴：オン"
Else
  TglLog.Caption = "履歴：オフ"
End If
SheetCanvas.changeLog TglLog.Value
End Sub

Private Sub BtnClearSelect_Click() '選択範囲を消去
SheetCanvas.clearRange False '指定範囲をクリア
End Sub
Private Sub BtnClearCanvas_Click() 'カンバスを消去
Dim Msg_ans As Long
Msg_ans = MsgBox("カンバスを消去します" & Chr(10) _
  & Chr(10) & "オートシェイプやワードアート、" & Chr(10) _
  & "図やグラフなどのオブジェクトも消去されます", vbYesNo)
If Msg_ans = 6 Then 'はい
  SheetCanvas.clearRange True '指定範囲を消去
End If
End Sub

Private Sub ScrCellSize0_Change() 'セルの幅(縦)
BtnCellSize.Caption = "セルの幅" _
  & Chr(10) & "→縦：" & ScrCellSize0.Max + 1 - ScrCellSize0.Value _
  & Chr(10) & "↓横：" & ScrCellSize1.Value
End Sub
Private Sub ScrCellSize1_Change() 'セルの幅(横)
BtnCellSize.Caption = "セルの幅" _
  & Chr(10) & "→縦：" & ScrCellSize0.Max + 1 - ScrCellSize0.Value _
  & Chr(10) & "↓横：" & ScrCellSize1.Value
End Sub
Private Sub BtnCellSize_Click() 'セルの幅を反映
Application.ScreenUpdating = False '画面更新をオフ
With SheetCanvas
  .setCellCanvasSize ScrCellSize0.Max + 1 - ScrCellSize0.Value, ScrCellSize1.Value _
    , .getCanvasSize(False), .getCanvasSize(True) 'セル幅、カンバスサイズの設定
End With
Application.ScreenUpdating = True '画面更新をオン
End Sub

'■応用
Private Sub TxtCanvasSize0_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'カンバスサイズ(縦)
TxtCanvasSize0.Value = SheetCanvas.getCanvasMax(False) '縦の最大値
End Sub
Private Sub TxtCanvasSize1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'カンバスサイズ(横)
TxtCanvasSize1.Value = SheetCanvas.getCanvasMax(True) '横の最大値
End Sub
Private Sub BtnCanvasSize_Click() 'カンバスサイズ変更
Select Case CLng(Val(TxtCanvasSize0.Value)) * CLng(Val(TxtCanvasSize1.Value))
Case Is > 800000
  MsgBox "ExcelのバージョンまたはPCのスペックによって、処理は非常に遅くなります" & Chr(10) _
    & Chr(10) & "処理が遅い場合は、カンバスサイズを小さく、" & Chr(10) _
    & "グリッド線をオフに、履歴取得をオフにしてください"
Case Is > 500000
  MsgBox "ExcelのバージョンまたはPCのスペックによって、処理は遅くなります" & Chr(10) _
    & Chr(10) & "処理が遅い場合は、カンバスサイズを小さく、" & Chr(10) _
    & "またはグリッド線をオフに、または履歴取得をオフにしてください"
Case Is > 200000
  MsgBox "ExcelのバージョンまたはPCのスペックによって、処理が遅くなる可能性があります" & Chr(10) _
    & Chr(10) & "処理が遅い場合は、カンバスサイズを小さく、" & Chr(10) _
    & "またはグリッド線をオフに、" & Chr(10) _
    & "または履歴取得をオフにすることで改善される可能性があります"
End Select
Application.ScreenUpdating = False '画面更新をオフ
With SheetCanvas
  .setCellCanvasSize .getCellSize(False), .getCellSize(True) _
    , CLng(Val(TxtCanvasSize0.Value)), CLng(Val(TxtCanvasSize1.Value)) 'セル幅、カンバスサイズの設定
End With
Application.ScreenUpdating = True '画面更新をオン
End Sub

Private Sub BtnTurnUD_Click() '上下反転
SheetCanvas.turnUDorLR True
End Sub
Private Sub BtnTurnLR_Click() '左右反転
SheetCanvas.turnUDorLR False
End Sub
Private Sub BtnTurnRC_Click() '行列入替
SheetCanvas.turnRC
End Sub

Private Sub BtnBack_Click() '背景設定
Dim File_pass As String
Dim Msg_ans As Long
If LblBack.ControlTipText = "<背景なし>" Then '背景なしなら
  File_pass = SheetCanvas.changeBack(True)
  If File_pass <> "" Then
    LblBack.ControlTipText = File_pass
  End If
Else
  Msg_ans = MsgBox("背景に " & LblBack.Caption & " が設定されています" & Chr(10) _
    & Chr(10) & "変更なら[はい]、削除なら[いいえ]、" & Chr(10) _
    & "取りやめるなら[キャンセル]を選んでください", vbYesNoCancel)
  If Msg_ans = 6 Then 'はい
    LblBack.ControlTipText = SheetCanvas.changeBack(True)
  ElseIf Msg_ans = 7 Then 'いいえ
    LblBack.ControlTipText = SheetCanvas.changeBack(False)
  End If
End If
Select Case LblBack.ControlTipText
Case "" 'キャンセル
Case "<背景なし>" '背景なし
  LblBack.Caption = "<背景なし>"
Case Else '背景設定
  LblBack.Caption = Dir(LblBack.ControlTipText)
End Select
End Sub
Private Sub TglGrid_Click() 'グリッド線
If TglGrid.Value Then 'オンなら
  TglGrid.Caption = "グリッド線：オン"
Else
  TglGrid.Caption = "グリッド線：オフ"
End If
ActiveWindow.DisplayGridlines = TglGrid.Value 'グリッド線のオン、オフ
End Sub

Private Sub BtnPaint_Click() 'いろいろ描画
Dim For_Paint As Long, For_Spray As Long, Paint_size As Long
Application.ScreenUpdating = False '画面更新をオフ
For For_Paint = 0 To 6 '図形
  If Controls("OptPaint" & CStr(For_Paint)).Value Then
    Exit For 'ここで終了すれば、For_Paintは0〜6
  End If
Next For_Paint
For For_Spray = 0 To 2 'スプレー
  If Controls("OptPaintSpray" & CStr(For_Spray)).Value Then
    Exit For 'ここで終了すれば、For_Planeは0〜2
  End If
Next For_Spray
Select Case For_Paint '図形
Case 0 '■
  Select Case For_Spray 'スプレー
  Case 0 '全部
    SheetCanvas.paintSquareAll (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max
  Case 1 '副のみ
    SheetCanvas.paintSquareSubOnly (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max
  Case 2 '副以外
    SheetCanvas.paintSquareNotSub (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max
  End Select
Case 1 '□
  Select Case For_Spray 'スプレー
  Case 0 '全部
    SheetCanvas.paintSquareFrameAll ScrPaint.Max + 1 - ScrPaint.Value
  Case 1 '副のみ
    SheetCanvas.paintSquareFrameSubOnly ScrPaint.Max + 1 - ScrPaint.Value
  Case 2 '副以外
    SheetCanvas.paintSquareFrameNotSub ScrPaint.Max + 1 - ScrPaint.Value
  End Select
Case 2 '●
  Select Case For_Spray 'スプレー
  Case 0 '全部
    SheetCanvas.paintCircleAll (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max
  Case 1 '副のみ
    SheetCanvas.paintCircleSubOnly (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max
  Case 2 '副以外
    SheetCanvas.paintCircleNotSub (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max
  End Select
Case 3 '○
  Select Case For_Spray 'スプレー
  Case 0 '全部
    SheetCanvas.paintCircleFrameAll ScrPaint.Max + 1 - ScrPaint.Value
  Case 1 '副のみ
    SheetCanvas.paintCircleFrameSubOnly ScrPaint.Max + 1 - ScrPaint.Value
  Case 2 '副以外
    SheetCanvas.paintCircleFrameNotSub ScrPaint.Max + 1 - ScrPaint.Value
  End Select
Case 4 '／
  Select Case For_Spray 'スプレー
  Case 0 '全部
    SheetCanvas.paintSlashAll ScrPaint.Max + 1 - ScrPaint.Value, False
  Case 1 '副のみ
    SheetCanvas.paintSlashSubOnly ScrPaint.Max + 1 - ScrPaint.Value, False
  Case 2 '副以外
    SheetCanvas.paintSlashNotSub ScrPaint.Max + 1 - ScrPaint.Value, False
  End Select
Case 5 '＼
  Select Case For_Spray 'スプレー
  Case 0 '全部
    SheetCanvas.paintSlashAll ScrPaint.Max + 1 - ScrPaint.Value, True
  Case 1 '副のみ
    SheetCanvas.paintSlashSubOnly ScrPaint.Max + 1 - ScrPaint.Value, True
  Case 2 '副以外
    SheetCanvas.paintSlashNotSub ScrPaint.Max + 1 - ScrPaint.Value, True
  End Select
Case 6 'ぼかし
  Select Case For_Spray 'スプレー
  Case 0 '全部
    SheetCanvas.paintShadeAll (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max, SpnPaint * 4
  Case 1 '副のみ
    SheetCanvas.paintShadeSubOnly (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max, SpnPaint * 4
  Case 2 '副以外
    SheetCanvas.paintShadeNotSub (ScrPaint.Max + 1 - ScrPaint.Value) / ScrPaint.Max, SpnPaint * 4
  End Select
End Select
Application.ScreenUpdating = True '画面更新をオン
End Sub
Private Sub changeScrPaint(WidthIsTrue As Boolean) '濃度、太さ変更
If WidthIsTrue Then
  LblPaint.Caption = "太さ：" & Chr(10) _
    & CStr(ScrPaint.Max + 1 - ScrPaint.Value)
  ScrPaint.ControlTipText = "線の太さ(範囲：1〜50)"
Else
  LblPaint.Caption = "濃度：" & Chr(10) _
    & CStr((ScrPaint.Max + 1 - ScrPaint.Value) * 2) & "%"
  ScrPaint.ControlTipText = "塗りの濃度(範囲：2〜100)"
End If
End Sub
Private Sub OptPaint0_Click() '■
changeScrPaint False
End Sub
Private Sub OptPaint1_Click() '□
changeScrPaint True
End Sub
Private Sub OptPaint2_Click() '●
changeScrPaint False
End Sub
Private Sub OptPaint3_Click() '○
changeScrPaint True
End Sub
Private Sub OptPaint4_Click() '／
changeScrPaint True
End Sub
Private Sub OptPaint5_Click() '＼
changeScrPaint True
End Sub
Private Sub OptPaint6_Click() 'ぼかし
changeScrPaint False
End Sub
Private Sub SpnPaint_Change() 'ぼかしの幅
OptPaint6.Caption = "ぼかし　幅：" & CStr(SpnPaint.Value * 4)
End Sub
Private Sub ScrPaint_Change() '濃度、太さ
If Left$(LblPaint.Caption, 1) = "太" Then '太さなら
  changeScrPaint True '濃度、太さ変更
Else
  changeScrPaint False '濃度、太さ変更
End If
End Sub

'■クリップ
Private Sub BtnClipAdd_Click() 'クリップ登録
Dim Clip_name As String
Dim For_cnt As Long, Clip_y As Long, Clip_x As Long
For For_cnt = 0 To 9
  If Controls("OptClip" & CStr(For_cnt)).Value Then 'オプションボタンがチェックされていれば
    Exit For
  End If
Next For_cnt
If For_cnt < 10 Then 'Exit Forしたなら
  SheetCanvas.addClip TabClip.Value * 10 + For_cnt
  Controls("OptClip" & CStr(For_cnt)).Value = False
  Controls("OptClip" & CStr(For_cnt)).Value = True
Else
  MsgBox "クリップが選択されていません"
End If
End Sub
Private Sub BtnClipChk_Click() 'クリップ確認
Dim For_cnt As Long
For For_cnt = 0 To 9
  If Controls("OptClip" & CStr(For_cnt)).Value Then 'オプションボタンがチェックされていれば
    Exit For
  End If
Next For_cnt
If For_cnt < 10 Then 'Exit Forしたなら
  SheetCanvas.checkClip TabClip.Value * 10 + For_cnt
Else
  MsgBox "クリップが選択されていません"
End If
End Sub
Private Sub BtnClipPut_Click() 'カンバス反映
Dim Clip_y As Long, Clip_x As Long, Msg_ans As Long
Dim For_cnt As Long
For For_cnt = 0 To 9
  If Controls("OptClip" & CStr(For_cnt)).Value Then 'オプションボタンがチェックされていれば
    Exit For
  End If
Next For_cnt
If For_cnt < 10 Then 'Exit Forしたなら
  SheetCanvas.checkClip TabClip.Value * 10 + For_cnt
  Msg_ans = MsgBox(Left$(LblClip, 2) & " のクリップをカンバスに反映します" & Chr(10) _
    & Chr(10) & "「はい」：カンバスをクリアして反映" & Chr(10) _
    & "「いいえ」：カンバスを残して上書き", vbYesNoCancel)
  Select Case Msg_ans
  Case 6 'はい
    SheetCanvas.putClip True
  Case 7 'いいえ
    SheetCanvas.putClip False
  End Select
Else
  MsgBox "クリップが選択されていません"
End If
End Sub
Private Sub BtnClipDel_Click() 'クリップ削除
Dim For_cnt As Long
For For_cnt = 0 To 9
  If Controls("OptClip" & CStr(For_cnt)).Value Then 'オプションボタンがチェックされていれば
    Exit For
  End If
Next For_cnt
If For_cnt < 10 Then 'Exit Forしたなら
  SheetCanvas.deleteClip TabClip.Value * 10 + For_cnt
  LblClip.Caption = Left$(LblClip.Caption, 3) & "クリップなし　縦：1　横：1"
Else
  MsgBox "クリップが選択されていません"
End If
End Sub
Private Sub BtnClipDelAll_Click() 'クリップ全削除
SheetCanvas.deleteClip '引数省略
LblClip.Caption = Left$(LblClip.Caption, 3) & "クリップなし　縦：1　横：1"
End Sub

Private Sub BtnCompAdd_Click() 'レイヤ追加
Dim Clip_name As String
Dim For_cnt As Long
If Len(LblComp.Caption) < 27 Then 'レイヤもどきの要素数が9未満(3*9=27)なら
  For For_cnt = 0 To 9
    If Controls("OptClip" & CStr(For_cnt)).Value Then 'オプションボタンがチェックされていれば
      Exit For
    End If
  Next For_cnt
  If For_cnt < 10 Then 'Exit Forしたなら
    Clip_name = Right$(TabClip.SelectedItem.Caption, 1) & CStr(For_cnt)
    If InStr(LblComp.Caption, Clip_name) = 0 Then '選択クリップがリストになければ
      LblComp.Caption = LblComp.Caption & Clip_name & ","
    End If
  Else
    MsgBox "クリップが選択されていません"
  End If
End If
End Sub
Private Sub BtnCompDel_Click() 'レイヤクリア
LblComp.Caption = ""
End Sub
Private Sub BtnCompPut_Click() 'レイヤ合成
Dim Split_list As Variant
Dim Comp_list() As Long
Dim List_size As Long, Msg_ans As Long, For_cnt As Long, Clip_no As Long
If LblComp.Caption = "" Then 'リストがなければ
  MsgBox "合成できるクリップがありません"
Else
  Split_list = Split(LblComp.Caption, ",") '","で区切った配列を引数にする
  List_size = UBound(Split_list) '最大要素数
  If List_size < 9 Then '要素数が9以下なら
    Msg_ans = MsgBox("リストの左側を上にして " & List_size & " つのクリップを合成します" & Chr(10) _
      & Chr(10) & "「はい」：カンバスの上に合成(現在のカンバスに上書きします)" & Chr(10) _
      & "「いいえ」：カンバスの下に合成(塗りつぶしなしの部分のみ反映されます)" & Chr(10) _
      & Chr(10) & "【注意】" & Chr(10) _
      & "クリップの大きさや数によって、処理に時間がかかる場合があります" & Chr(10) _
      & "[C]キーで中断できます(途中からの再開はできません)", vbYesNoCancel)
    If Msg_ans <> 2 Then 'キャンセルでなければ
      ReDim Comp_list(List_size) As Long '配列を再定義
      For For_cnt = 0 To List_size
        Clip_no = CLng(Val("&H" & Split_list(For_cnt))) '16進数に変換
        Comp_list(For_cnt) = (Clip_no \ 16 - 10) * 10 + Clip_no Mod 16 'Aは10*0、Bは10*1
      Next For_cnt
      If Msg_ans = 6 Then 'はい
        SheetCanvas.composeClip Comp_list, True 'クリップ合成
      Else
        SheetCanvas.composeClip Comp_list, False 'クリップ合成
      End If
    End If
  Else
    MsgBox "合成リストが不正です"
  End If
End If
End Sub
Private Sub TabClip_Change() 'クリップタブ変更
Dim Tub_no As Long, Tab_pos, For_cnt As Long
Tub_no = TabClip.Value '選択タブ
Tab_pos = ((Tub_no + 1) Mod 2) * 10 '非選択タブ
With SheetClip
  For For_cnt = 0 To 9 'クリップの数だけ繰り返し
    .Cells(ModuleConst.CLIPNAME, Tab_pos * 10 + For_cnt + 1) _
      = Controls("TxtClip" & CStr(For_cnt)).Value '保存
    Controls("TxtClip" & CStr(For_cnt)).Value _
      = CStr(.Cells(ModuleConst.CLIPNAME, Tub_no * 10 + For_cnt + 1)) '読み込み
  Next For_cnt
  OptClip0.Value = False 'クリップ0を選択解除
  OptClip0.Value = True 'クリップ0を選択
End With
End Sub