Imports Infragistics.Win
Imports Infragistics.Win.UltraWinSchedule
Imports Infragistics.Win.UltraWinSchedule.WeekView
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, UltraWeekViewAction.ExitEditModeAndSaveChanges, 0, UltraWeekViewState.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.ultraWeekView.KeyActionMappings
If keyMapping.KeyCode = keyToMap Then
count += 1
mapList += keyMapping.ActionCode.ToString() + vbCrLf
End If
Next
' マップした操作がない場合、ユーザーにメッセージを表示する
' 必要がないため、カスタム マッピングを追加して返します
If count = 0 Then
Me.ultraWeekView.KeyActionMappings.Add(keyMappingToAdd)
' テストするために予定を追加します
Me.ultraWeekView.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.ultraWeekView.KeyActionMappings.Add(keyMappingToAdd)
' テスト用に予定を追加します
Me.ultraWeekView.CalendarInfo.Appointments.Add(DateTime.Now, DateTime.Now.AddMinutes(30.0F), "My Appointment")
Return
End If
' マップするキーに設定した KeyCode プロパティを持つすべての KeyActionMappings を削除します
For Each keyMapping In Me.ultraWeekView.KeyActionMappings
If keyMapping.KeyCode = keyToMap Then Me.ultraWeekView.KeyActionMappings.Remove(keyMapping)
Next
' カスタム マッピングを追加します
Me.ultraWeekView.KeyActionMappings.Add(keyMappingToAdd)
' 他のマッピングがすべて削除されたことをユーザーに通知します
msg = "All existing mappings for " + keyToMap.ToString() + " successfully removed." + vbCrLf
MessageBox.Show(msg, "Remove existing KeyActionMappings", MessageBoxButtons.OK)
' テスト用に予定を追加します
Me.ultraWeekView.CalendarInfo.Appointments.Add(DateTime.Now, DateTime.Now.AddMinutes(30.0F), "My Appointment")
End Sub