KeyActionMapping クラス

Imports Infragistics.Win
Imports Infragistics.Win.UltraWinSchedule
Imports Infragistics.Win.UltraWinSchedule.MonthViewSingle

    Private Sub CustomizeKeyActionMappings()

        '	新しい KeyActionMapping オブジェクトを作成し、コントロールの
        '	KeyActionMappings コレクションに追加します新しい KeyActionMapping オブジェクトで
        '	以下のプロパティを設定します:
        '
        '	KeyCode = F2
        '	ActionCode = ExitEditModeAndSaveChanges
        '	StateDisallowed = 0 (許可されていない状態なし)
        '	StateRequired = ActivityInEditMode
        '	SpecialKeysDisallowed = All (Alt、Ctrl、または Shift が押された場合、操作を無効にする)
        '	SpecialKeysRequired = 0 (操作を実行するには、特別なキーを押す必要がない)
        '
        Dim keyToMap As Keys = Keys.F2

        Dim keyMappingToAdd As New KeyActionMapping(keyToMap, UltraMonthViewSingleAction.ExitEditModeAndSaveChanges, 0, UltraMonthViewSingleState.ActivityInEditMode, SpecialKeys.All, 0)

        '	コレクションに追加する前に、追加するかどうかを確認するために、
        '	KeyActionMapping プロパティを表示する MessageBox を表示します
        Dim msg As String = "The following KeyActionMapping will be added to the KeyActionMappings collection:" + vbCrLf + vbCrLf
        msg += "The keystoke the action will respond to is: " + keyMappingToAdd.KeyCode.ToString() + vbCrLf
        msg += "The action that will be performed when the key is pressed is: " + keyMappingToAdd.ActionCode.ToString() + vbCrLf
        msg += "The disallowed state for the action is (zero indicates no disallowed state): " + keyMappingToAdd.StateDisallowed.ToString() + vbCrLf
        msg += "The required state for the action is (zero indicates no required state): " + keyMappingToAdd.StateRequired.ToString() + vbCrLf
        msg += "The action will not be performed if any of the following special keys are pressed (zero indicates no special keys are disallowed): " + keyMappingToAdd.SpecialKeysDisallowed.ToString() + vbCrLf
        msg += "The action will only be performed if all of the following special keys are pressed (zero indicates no special keys are required): " + keyMappingToAdd.SpecialKeysRequired.ToString() + vbCrLf
        msg += vbCrLf + "Are you sure you want to add the custom KeyActionMapping?" + vbCrLf

        '	メッセージ ボックスを表示します
        Dim result As DialogResult = MessageBox.Show(msg, "Add KeyActionMapping", MessageBoxButtons.YesNo)

        '	ユーザーが「いいえ」を押すと、デフォルトの KeyActionMappings を変更せずに返します
        If result = DialogResult.No Then Return

        '	KeyActionMapping をコントロールの KeyActionMappings コレクションに追加する前に、
        '	そのキーストロークの既存のマッピングを削除するかどうかを
        '	確認します
        '			
        '	KeyActionMappings コレクションに繰り返し、特定のキーストロークの
        '	既存のマッピングの数を取得します
        '
        '	このコレクションを繰り返すときに、削除するかどうかを
        '	決定するため、ユーザーに表示するための特定の
        '	キーストロークにマップした操作をリストする文字列を作成します
        Dim count As Integer = 0
        Dim mapList As String = String.Empty
        Dim keyMapping As KeyActionMapping
        For Each keyMapping In Me.ultraMonthViewSingle1.KeyActionMappings
            If keyMapping.KeyCode = keyToMap Then
                count += 1
                mapList += keyMapping.ActionCode.ToString() + vbCrLf
            End If
        Next

        '	マップした操作がない場合、ユーザーにメッセージを表示する
        '	必要がないため、カスタム マッピングを追加して返します
        If count = 0 Then
            Me.ultraMonthViewSingle1.KeyActionMappings.Add(keyMappingToAdd)
            '	テストするために予定を追加します
            Me.ultraMonthViewSingle1.CalendarInfo.Appointments.Add(DateTime.Now, DateTime.Now.AddMinutes(30), "My Appointment")
            Return
        End If

        '	ユーザーに既存のマッピングについて通知し、削除するかどうかを確認します。
        msg = "The KeyActionMappings collection already contains the following mappings for " + keyToMap.ToString() + ":" + vbCrLf + vbCrLf
        msg += mapList + vbCrLf
        msg += "Do you want to remove the existing mappings for " + keyToMap.ToString() + "?"

        '	メッセージ ボックスを表示します
        result = MessageBox.Show(msg, "Remove existing KeyActionMappings", MessageBoxButtons.YesNo, MessageBoxIcon.Information)

        '	ユーザーは「いいえ」を押すと、既存の KeyActionMappings コレクションを変更せずに返します
        If result = DialogResult.No Then
            Me.ultraMonthViewSingle1.KeyActionMappings.Add(keyMappingToAdd)
            '	テスト用に予定を追加します
            Me.ultraMonthViewSingle1.CalendarInfo.Appointments.Add(DateTime.Now, DateTime.Now.AddMinutes(30.0F), "My Appointment")
            Return
        End If

        '	マップするキーに設定した KeyCode プロパティを持つすべての KeyActionMappings を削除します
        For Each keyMapping In Me.ultraMonthViewSingle1.KeyActionMappings
            If keyMapping.KeyCode = keyToMap Then Me.ultraMonthViewSingle1.KeyActionMappings.Remove(keyMapping)
        Next

        '	カスタム マッピングを追加します
        Me.ultraMonthViewSingle1.KeyActionMappings.Add(keyMappingToAdd)

        '	他のマッピングがすべて削除されたことをユーザーに通知します
        msg = "All existing mappings for " + keyToMap.ToString() + " successfully removed." + vbCrLf
        MessageBox.Show(msg, "Remove existing KeyActionMappings", MessageBoxButtons.OK)

        '	テスト用に予定を追加します
        Me.ultraMonthViewSingle1.CalendarInfo.Appointments.Add(DateTime.Now, DateTime.Now.AddMinutes(30.0F), "My Appointment")

    End Sub