CheckedComboBox のサンプル

CheckedComboBox.vb

Option Explicit On
Option Strict On

#Region "名前空間"

Imports System.Collections
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Text
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Diagnostics

#End Region

''' <summary>
''' チェック付きコンボボックス
''' </summary>
''' <remarks></remarks>
Public Class CheckedComboBox
    Inherits ComboBox

#Region "内部クラス"

    ''' <summary>
    ''' <see cref="CheckedComboBox">CheckedComboBox</see> のドロップダウンを表す内部クラス
    ''' </summary>
    Protected Friend Class CheckedComboBoxDropdown
        Inherits Form

#Region "内部クラス"

        ''' <summary>
        ''' カスタムチェックリストボックス
        ''' </summary>
        Protected Friend Class CustomCheckedListBox
            Inherits CheckedListBox

            Private m_curSelIndex As Integer = -1

            ''' <summary>
            ''' コンストラクタ
            ''' </summary>
            Public Sub New()
                MyBase.New()
                Me.SelectionMode = SelectionMode.One
                Me.HorizontalScrollbar = True
            End Sub

            ''' <summary>
            ''' キーダウン時のイベントハンドラ
            ''' </summary>
            Protected Overrides Sub OnKeyDown(ByVal e As KeyEventArgs)

                Select Case e.KeyCode
                    Case Keys.Enter
                        DirectCast(Parent, CheckedComboBoxDropdown). _
                            OnDeactivate(New CheckedComboBoxEventArgs(EventArgs.Empty, True))
                        e.Handled = True

                    Case Keys.Escape
                        DirectCast(Parent, CheckedComboBoxDropdown). _
                            OnDeactivate(New CheckedComboBoxEventArgs(EventArgs.Empty, False))
                        e.Handled = True

                    Case Keys.Delete
                        ' Delete は全てのチェックを解除, [Shift + Delete] は全てチェックします。
                        For i As Integer = 0 To Items.Count - 1
                            Me.SetItemChecked(i, e.Shift)
                        Next
                        e.Handled = True

                End Select

                MyBase.OnKeyDown(e)

            End Sub

            ''' <summary>
            ''' マウス移動時のイベントハンドラ
            ''' </summary>
            Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)

                MyBase.OnMouseMove(e)
                Dim index As Integer = Me.IndexFromPoint(e.Location)
                If (index >= 0) AndAlso (index <> m_curSelIndex) Then
                    m_curSelIndex = index
                    Me.SetSelected(index, True)
                End If
            End Sub

        End Class

#End Region

#Region "フィールド"
        Private m_cclb As CustomCheckedListBox
        Private m_checkedStateArr() As Boolean
        Private m_dropdownClosed As Boolean = True
        Private m_oldStrValue As String = String.Empty
        Private m_parent As CheckedComboBox
#End Region

#Region "コンストラクタ"
        ''' <summary>
        ''' コンストラクタ
        ''' </summary>
        ''' <param name="parent">
        ''' <seealso cref="CheckedComboBox">CheckedComboBox</seealso>オブジェクト
        ''' </param>
        Public Sub New(ByVal parent As CheckedComboBox)
            Me.m_parent = parent
            Me.InitializeComponent()
            Me.ShowInTaskbar = False
            ' イベントハンドラを設定します。
            AddHandler Me.m_cclb.ItemCheck, AddressOf Me.m_cclb_ItemCheck
        End Sub
#End Region

#Region "プロパティ"
        ''' <summary>
        ''' ドロップダウンに関連付けられている
        ''' <see cref="CheckedListBox">CheckedListBox</see>オブジェクトを取得します。
        ''' </summary>
        Public ReadOnly Property List() As CheckedListBox
            Get
                Return m_cclb
            End Get
        End Property

        ''' <summary>
        ''' ドロップダウンで現在選択された項目のインデックスを取得・設定します。 
        ''' </summary>
        Public Property SelectedIndex() As Integer
            Get
                Return m_cclb.SelectedIndex
            End Get
            Set(ByVal value As Integer)
                If (m_cclb IsNot Nothing) Then
                    m_cclb.SelectedIndex = value
                    If (m_cclb.Visible = False) Then
                        m_parent.Text = GetCheckedItemsStringValue()
                    End If
                End If
            End Set
        End Property

        ''' <summary>
        ''' 選択項目が変更されているか取得します。
        ''' </summary>
        Public ReadOnly Property ValueChanged() As Boolean
            Get
                Dim newStrValue As String = m_parent.Text
                If ((m_oldStrValue.Length > 0) AndAlso (newStrValue.Length > 0)) Then
                    Return (m_oldStrValue.CompareTo(newStrValue) <> 0)
                Else
                    Return (m_oldStrValue.Length <> newStrValue.Length)
                End If
            End Get
        End Property
#End Region

#Region "イベント"
        ''' <summary>
        ''' <see cref="CustomCheckedListBox.ItemCheck">
        ''' CustomCheckedListBox.ItemCheck</see>イベントを発生させます。 
        ''' </summary>
        Private Sub m_cclb_ItemCheck(ByVal sender As Object, ByVal e As ItemCheckEventArgs)
            If (m_parent.ItemChecked IsNot Nothing) Then
                m_parent.ItemChecked(sender, e)
            End If
        End Sub

        ''' <summary>
        ''' <see cref="Activated">Activated</see>イベントを発生させます。 
        ''' </summary>
        Protected Overrides Sub OnActivated(ByVal e As EventArgs)
            MyBase.OnActivated(e)
            m_dropdownClosed = False
            m_oldStrValue = m_parent.Text
            m_checkedStateArr = New Boolean(m_cclb.Items.Count - 1) {}
            For i As Integer = 0 To m_cclb.Items.Count - 1
                m_checkedStateArr(i) = m_cclb.GetItemChecked(i)
            Next
        End Sub

        ''' <summary>
        ''' <see cref="Deactivate">Deactivate</see>イベントを発生させます。 
        ''' </summary>
        Protected Overrides Sub OnDeactivate(ByVal e As EventArgs)
            MyBase.OnDeactivate(e)
            If (e IsNot Nothing) AndAlso (TypeOf e Is CheckedComboBoxEventArgs) Then
                CloseDropdown(DirectCast(e, CheckedComboBoxEventArgs).AssignValues)
            Else
                CloseDropdown(True)
            End If
        End Sub
#End Region

#Region "メソッド"
        ''' <summary>
        ''' コンポーネントを初期化します。
        ''' </summary>
        Private Sub InitializeComponent()

            Me.m_cclb = New CustomCheckedListBox()
            Me.SuspendLayout()
            ' 
            ' m_cclb
            ' 
            Me.m_cclb.BorderStyle = System.Windows.Forms.BorderStyle.None
            Me.m_cclb.Dock = System.Windows.Forms.DockStyle.Fill
            Me.m_cclb.FormattingEnabled = True
            Me.m_cclb.Location = New System.Drawing.Point(0, 0)
            Me.m_cclb.Name = "m_cclb"
            Me.m_cclb.Size = New System.Drawing.Size(47, 15)
            Me.m_cclb.Font = DirectCast(m_parent.Font.Clone(), Font)
            ' 
            ' Dropdown
            ' 
            Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0F, 13.0F)
            Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
            Me.BackColor = System.Drawing.SystemColors.Menu
            Me.ClientSize = New System.Drawing.Size(47, 16)
            Me.ControlBox = False
            Me.Controls.Add(Me.m_cclb)
            Me.ForeColor = System.Drawing.SystemColors.ControlText
            Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow
            Me.MinimizeBox = False
            Me.Name = "m_parent"
            Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual
            Me.ResumeLayout(False)
        End Sub

        ''' <summary>
        ''' ドロップダウンを閉じ、指定されたブールパラメタに応じて変更します。
        ''' <para>
        ''' 呼び出し元が変更を求める可能性があるにもかかわらず、確定されていなければ、
        ''' これは必ずしもすべての変更が発生したわけではありません。<br/>
        ''' 発信者は、任意の実際の値の変更を決定するために 
        ''' <see cref="CheckedComboBox">CheckedComboBox</see>（ドロップダウンが閉じている）の 
        ''' <see cref="ValueChanged">ValueChanged</see>プロパティを確認してください。
        ''' </para>
        ''' </summary>
        ''' <param name="enactChanges">変更確定フラグ</param>
        Public Sub CloseDropdown(ByVal enactChanges As Boolean)
            If (m_dropdownClosed) Then
                Return
            End If
            If (enactChanges) Then
                m_parent.SelectedIndex = -1
                m_parent.Text = GetCheckedItemsStringValue()

            Else
                For i As Integer = 0 To m_cclb.Items.Count - 1
                    m_cclb.SetItemChecked(i, m_checkedStateArr(i))
                Next
            End If
            m_dropdownClosed = True
            m_parent.Focus()
            m_parent.SelectionLength = 0
            Me.Hide()

            m_parent.OnDropDownClosed(New CheckedComboBoxEventArgs(EventArgs.Empty, False))
        End Sub

        ''' <summary>
        ''' チェック項目の文字列を結合して取得します。
        ''' </summary>
        Public Function GetCheckedItemsStringValue() As String
            Dim sb As New System.Text.StringBuilder()
            For i As Integer = 0 To m_cclb.CheckedItems.Count - 1
                sb.Append(m_cclb.GetItemText(m_cclb.CheckedItems(i))).Append(m_parent.Separator)
            Next
            If (sb.Length > 0) Then
                sb.Remove(sb.Length - m_parent.Separator.Length, m_parent.Separator.Length)
            End If
            Return sb.ToString()
        End Function
#End Region

    End Class

#End Region

#Region "イベントの宣言"
    Public ItemChecked As ItemCheckEventHandler
#End Region

#Region "フィールド"
    Private m_dropdown As CheckedComboBoxDropdown
    Private m_separator As String
#End Region

#Region "コンストラクタ"
    ''' <summary>
    ''' コンストラクタ
    ''' </summary>
    Public Sub New()

        MyBase.New()
        Me.DrawMode = DrawMode.OwnerDrawVariable
        Me.Separator = ", "
        Me.DropDownHeight = 1
        Me.DropDownStyle = ComboBoxStyle.DropDown
        Me.CheckOnClick = True

    End Sub
#End Region

#Region "プロパティ"
    ''' <summary>
    ''' このコントロール内でチェックされているインデックスのコレクションを取得します。
    ''' </summary>
    Public ReadOnly Property CheckedIndices() As CheckedListBox.CheckedIndexCollection
        Get
            Return m_dropdown.List.CheckedIndices
        End Get
    End Property

    ''' <summary>
    ''' このコントロール内でチェックされている項目のコレクションを取得します。
    ''' </summary>
    Public ReadOnly Property CheckedItems() As CheckedListBox.CheckedItemCollection
        Get
            Return m_dropdown.List.CheckedItems
        End Get
    End Property

    ''' <summary>
    ''' 項目が選択されたときに、チェックボックスを切り替えるかどうかを示す値を取得または設定します。 
    ''' </summary>
    Public Property CheckOnClick() As Boolean
        Get
            If (m_dropdown IsNot Nothing) Then
                Return m_dropdown.List.CheckOnClick
            Else
                Return Nothing
            End If
        End Get
        Set(ByVal value As Boolean)
            If (m_dropdown IsNot Nothing) Then m_dropdown.List.CheckOnClick = value
        End Set
    End Property

    ''' <summary>
    ''' このコントロールのデータソースを取得または設定します。 
    ''' </summary>
    ''' <remarks>このプロパティは使用しないでください。実装すると 
    ''' <see cref="NotImplementedException">NotImplementedException</see>
    '''  例外が発生します。</remarks>
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden), _
     Browsable(False)> _
 _
    Private Shadows Property DataSource() As Object
        Get
            Throw New NotImplementedException("このプロパティは使用できません。実装しないでください。")
        End Get
        Set(ByVal value As Object)
            Throw New NotImplementedException("このプロパティは使用できません。実装しないでください。")
        End Set
    End Property

    ''' <summary>
    ''' このコントロールに表示するプロパティを取得または設定します。 
    ''' </summary>
    Public Shadows Property DisplayMember() As String
        Get
            If (m_dropdown IsNot Nothing) Then
                Return m_dropdown.List.DisplayMember
            Else
                Return String.Empty
            End If
        End Get
        Set(ByVal value As String)
            m_dropdown.List.DisplayMember = value
        End Set
    End Property

    ''' <summary>
    ''' このコントロール内の項目のコレクションを取得します。
    ''' </summary>
    Public Shadows ReadOnly Property Items() As CheckedListBox.ObjectCollection
        Get
            Return m_dropdown.List.Items
        End Get
    End Property

    ''' <summary>
    ''' 現在選択されている項目を指定しているインデックスを取得または設定します。 
    ''' </summary>
    Public Overrides Property SelectedIndex() As Integer
        Get
            If (m_dropdown IsNot Nothing) Then
                Return m_dropdown.SelectedIndex
            Else
                Return -1
            End If
        End Get
        Set(ByVal value As Integer)
            If (m_dropdown Is Nothing) Then Return
            m_dropdown.SelectedIndex = value
        End Set
    End Property

    ''' <summary>
    ''' <see cref="Text">Text</see> に表示される項目間のセパレータ文字を取得または設定します。
    ''' </summary>
    Public Property Separator() As String
        Get
            Return m_separator
        End Get
        Set(ByVal value As String)
            m_separator = value
        End Set
    End Property

    ''' <summary>
    ''' このコントロールに関連付けられているテキストを取得または設定します。
    ''' </summary>
    Public Overrides Property Text() As String
        Get
            If (MyBase.Items.Count = 0) Then
                Return String.Empty
            End If
            Return MyBase.Text
        End Get
        Set(ByVal value As String)
           Try
                MyBase.Text = value
            Catch ex As ArgumentOutOfRangeException
                ' この例外は意図的にスルーする。
            Catch ex As Exception
                Throw
            End Try
        End Set
    End Property

    ''' <summary>
    ''' コントロールの値が変更されたか取得します。
    ''' </summary>
    Public ReadOnly Property ValueChanged() As Boolean
        Get
            Return m_dropdown.ValueChanged
        End Get
    End Property

    ''' <summary>
    ''' コントロール内の項目の実際の値として使用するプロパティを取得または設定します。
    ''' </summary>
    Public Shadows Property ValueMember() As String
        Get
            If (m_dropdown IsNot Nothing) Then
                Return m_dropdown.List.ValueMember
            Else
                Return String.Empty
            End If
        End Get
        Set(ByVal value As String)
            m_dropdown.List.ValueMember = value
        End Set
    End Property

#End Region

#Region "イベント"
    ''' <summary>
    ''' レイアウト変更時のイベントを発生させます。
    ''' </summary>
    Protected Overrides Sub OnLayout(ByVal levent As LayoutEventArgs)
        MyBase.OnLayout(levent)
        If (m_dropdown Is Nothing) Then
            m_dropdown = New CheckedComboBoxDropdown(Me)
        End If
    End Sub

    ''' <summary>
    ''' フォント変更時のイベントを発生させます。
    ''' </summary>
    Protected Overrides Sub OnFontChanged(ByVal e As EventArgs)
        MyBase.OnFontChanged(e)
        Dim font As Font = DirectCast(Me.Font.Clone(), Font)
        m_dropdown.Font = font
        m_dropdown.List.Font = font
    End Sub

    ''' <summary>
    ''' ドロップダウン時のイベントを発生させます。
    ''' </summary>
    Protected Overrides Sub OnDropDown(ByVal e As EventArgs)
        MyBase.OnDropDown(e)
        Me.DoDropDown()
    End Sub

    ''' <summary>
    ''' ドロップダウンを閉じた時のイベントを発生させます。
    ''' </summary>
    Protected Overrides Sub OnDropDownClosed(ByVal e As EventArgs)
        If (TypeOf e Is CheckedComboBoxEventArgs) Then
            MyBase.OnDropDownClosed(e)
        End If
    End Sub

    ''' <summary>
    ''' キーダウン時のイベントを発生させます。
    ''' </summary>
    Protected Overrides Sub OnKeyDown(ByVal e As KeyEventArgs)

        If (e.KeyCode = Keys.Down) Then
            OnDropDown(EventArgs.Empty)
        End If
        ' 特定のキーまたは組合せが妨げられないことを確認します。
        e.Handled = _
            Not e.Alt AndAlso _
            Not (e.KeyCode = Keys.Tab) AndAlso _
            Not ( _
                    (e.KeyCode = Keys.Left) OrElse _
                    (e.KeyCode = Keys.Right) OrElse _
                    (e.KeyCode = Keys.Home) OrElse _
                    (e.KeyCode = Keys.End) _
                )

        MyBase.OnKeyDown(e)
    End Sub

    ''' <summary>
    ''' キーが押された時のイベントを発生させます。
    ''' </summary>
    Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)
        e.Handled = True
        MyBase.OnKeyPress(e)
    End Sub
#End Region

#Region "メソッド"
    ''' <summary>
    ''' ドロップダウン処理を行います。
    ''' </summary>
    Private Sub DoDropDown()
        If (Not m_dropdown.Visible) Then

            Dim rect As Rectangle = RectangleToScreen(Me.ClientRectangle)
            m_dropdown.Location = New Point(rect.X, rect.Y + Me.Size.Height)

            Dim count As Integer = m_dropdown.List.Items.Count
            If (count > Me.MaxDropDownItems) Then
                count = Me.MaxDropDownItems
            ElseIf (count = 0) Then
                count = 1
            End If

            m_dropdown.Size = New Size(Me.Size.Width, (m_dropdown.List.ItemHeight) * count + 2)
            m_dropdown.Show(Me)
        End If
    End Sub

    ''' <summary>
    ''' 項目のチェック状況を取得します。
    ''' </summary>
    ''' <param name="index">インデックス</param>
    ''' <returns>チェックされていたら True</returns>
    ''' <remarks>index がリストの範囲外の場合、
    ''' <see cref="ArgumentOutOfRangeException">ArgumentOutOfRangeException</see>
    '''  例外が発生します。</remarks>
    Public Function GetItemChecked(ByVal index As Integer) As Boolean
        If (index < 0 OrElse index > Items.Count) Then
            Throw New ArgumentOutOfRangeException("index", "範囲外の値が渡されました。")
        Else
            Return m_dropdown.List.GetItemChecked(index)
        End If
    End Function

    ''' <summary>
    ''' 指定したインデックスの項目のチェック状況を調べます。
    ''' </summary>
    ''' <param name="index">インデックス</param>
    ''' <returns></returns>
    ''' <remarks>index がリストの範囲外の場合、
    ''' <see cref="ArgumentOutOfRangeException">ArgumentOutOfRangeException</see>
    '''  例外が発生します。</remarks>
    Public Function GetItemCheckState(ByVal index As Integer) As CheckState
        If (index < 0 OrElse index > Items.Count) Then
            Throw New ArgumentOutOfRangeException("index", "範囲外の値が渡されました。")
        Else
            Return m_dropdown.List.GetItemCheckState(index)
        End If
    End Function

    ''' <summary>
    ''' 指定したインデックスの項目をチェックします。
    ''' </summary>
    ''' <param name="index">インデックス</param>
    ''' <param name="isChecked"></param>
    ''' <remarks>index がリストの範囲外の場合、
    ''' <see cref="ArgumentOutOfRangeException">ArgumentOutOfRangeException</see>
    '''  例外が発生します。</remarks>
    Public Sub SetItemChecked(ByVal index As Integer, ByVal isChecked As Boolean)
        If (index < 0 OrElse index > Items.Count) Then
            Throw New ArgumentOutOfRangeException("index", "範囲外の値が渡されました。")
        Else
            m_dropdown.List.SetItemChecked(index, isChecked)
            ' Text の更新に必要です
            Me.Text = m_dropdown.GetCheckedItemsStringValue()
            Me.SelectionLength = 0
        End If
    End Sub

    ''' <summary>
    ''' 指定したインデックスの項目のチェック状況を設定します。
    ''' </summary>
    ''' <param name="index">インデックス</param>
    ''' <param name="state"></param>
    ''' <remarks>index がリストの範囲外の場合、
    ''' <see cref="ArgumentOutOfRangeException">ArgumentOutOfRangeException</see>
    '''  例外が発生します。</remarks>
    Public Sub SetItemCheckState(ByVal index As Integer, ByVal state As CheckState)
        If (index < 0 OrElse index > Items.Count) Then
            Throw New ArgumentOutOfRangeException("index", "範囲外の値が渡されました。")
        Else
            m_dropdown.List.SetItemCheckState(index, state)
            ' Text の更新に必要です
            Me.Text = m_dropdown.GetCheckedItemsStringValue()
            Me.SelectionLength = 0
        End If
    End Sub
#End Region

End Class