Клавиши контекстного меню

Где не работают? Какие клавиши? Какое контекстное меню? Какое приложение?

В редакторе меню есть список Shortcut, который служит для назначения клавиш, соответсвующих командам меню. Так вот назначаю. А они работают только до тех пор, пока не поработаешь с меню мышью.

Довольно странно, почему такое происходит. Можно ли увидеть код, который вы используете? Происходит ли это в заново созданном приложении? Какая версия бейсика? или это вба?

Да тоже никак не пойму. Пишу на VB-6. Использую дизайнер меню. Каждой позиии назначаю кнопку из списока Shortcut. Меню работает, кнопки - нет. Заметил, что если меню не скрывать (а я его все-таки скрываю, поскольку ведь контекстное), то клавиши работают. Вот такая ерунда.

Исходник выложите, пожалуйста.

Вот код формы

Option Explicit
Dim Rr As Recordset
Dim Edited As Boolean


Private Sub Command1_Click()
If Fix_Edit_Resalts(True) Then
fill_List_Parameters
Edit_Mode False
End If
End Sub

Private Sub Command2_Click()
If Fix_Edit_Resalts(False) Then
fill_List_Parameters
Edit_Mode False
End If
End Sub

Private Sub Form_Load()
On Error Resume Next
Dim SQL As String, qr As QueryDef
SQL = " SELECT ÒîâàðíàÿÃðóïïà.Êîä, ÒîâàðíàÿÃðóïïà.Íîìåð, ÒîâàðíàÿÃðóïïà.Íàèìåíîâàíèå, ÒîâàðíàÿÃðóïïà.Êðàòêî, " _
& " ÒîâàðíàÿÃðóïïà.Âõîäíîé , ÒîâàðíàÿÃðóïïà.Òîâàðíûé, ÒîâàðíàÿÃðóïïà.Ñâåòëûé " _
& " From ÒîâàðíàÿÃðóïïà ORDER BY ÒîâàðíàÿÃðóïïà.Íîìåð;"
Set qr = DB.CreateQueryDef("", SQL)
Set Rr = qr.OpenRecordset(dbOpenDynaset)
Set qr = Nothing
fill_List_Parameters
List1.ListIndex = 0
refrech_blank List1.ItemData(0)
End Sub


'Ïîêàçàòü ñïèñîê ïàðàìåòðîâ
Private Sub fill_List_Parameters()
On Error Resume Next
Dim list_index As Long ' çàïîìèíàåì èíäåêñ
list_index = List1.ListIndex
List1.Clear
With Rr
.Requery: .MoveFirst
Dim i As Long: i = 0 ' äëÿ óïîðÿäî÷åíèÿ ïî íîìåðàì
Do While .EOF = False
.Edit: .Fields("Íîìåð") = IIf(.Fields(0) = 1, 0, i): .Update
If .Fields(0) > 1 Then
List1.AddItem " " & .Fields("Íàèìåíîâàíèå") ' Íàèìåíîâàíèå
List1.ItemData(List1.ListCount - 1) = .Fields("Êîä") ' Èäåíòèôèêàòîð
End If
.MoveNext: i = i + 1
Loop
End With
List1.ListIndex = list_index
End Sub

'Ââûáîð èç ñïèñîêà ïàðàìåòðîâ
Private Sub List1_Click()
With List1
refrech_blank .ItemData(.ListIndex)
End With
End Sub



Private Sub refrech_blank(Optional Id As Long = -1)
On Error Resume Next
With Rr
'Îïðåäåëåíèå òåêóùåé îòîáðàæàåìîé çàïèñè
If Id = 0 Then
.MoveFirst
ElseIf Id > 0 Then
.FindFirst .Fields("Êîä").name & " = " & str(Id)
If .NoMatch Then .MoveLast
End If
'Çàïîëíåíèå òåêñòîâûõ îêîí
Text(0).Text = Trim(valf(.Fields("Íàèìåíîâàíèå")))
Text(1).Text = Trim(valf(.Fields("Êðàòêî")))
'Îïðåäåëåíèå ïåðåêëþ÷àòåëÿ
If .Fields("Âõîäíîé") Then
Option1(1).value = True
Option1(2).value = False
Else
Option1(1).value = False
Option1(2).value = True
End If
'Îïðåäåëåíèå ôëàæêîâ
If .Fields("Âõîäíîé") Then
Option1(1).value = True
Option1(2).value = False
Else
Option1(1).value = False
Option1(2).value = True
End If
Check1.value = IIf(.Fields("Òîâàðíûé"), 1, 0)
Check2.value = IIf(.Fields("Ñâåòëûé"), 1, 0)
End With
Edited = False
End Sub

'Private Sub Form_KeyDown_(KeyCode As Integer, Shift As Integer)
Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 Then
If KeyCode = vbKeyInsert Then Menu_Click 1
Else
If KeyCode = vbKeyF5 Then Menu_Click 2
If KeyCode = vbKeyF2 Then Menu_Click 0
End If
End Sub

Private Sub Option1_Click(Index As Integer)
If Frame.Enabled Then Edited = True
End Sub
Private Sub Text_Change(Index As Integer)
If Frame.Enabled Then Edited = True
End Sub

Private Sub Edit_Mode(ver As Boolean)
On Error Resume Next
If ver Then
With List1
Dim Index As Long: Index = .ListIndex
Dim Id As Long: Id = .ItemData(.ListIndex)
End With
End If
List1.Enabled = IIf(ver, False, True)
Frame.Enabled = IIf(ver, True, False)
Command1.Enabled = IIf(ver, True, False)
Command2.Enabled = IIf(ver, True, False)
Dim i As Long
For i = 0 To Text.Count - 1
Text(i).BackColor = IIf(ver, &H80000018, &H80000005)
Next
Text(0).SetFocus
End Sub



Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Button = vbRightButton Then
Me.PopupMenu UCMenu
End If
End Sub
Private Sub Menu_Click(Index As Integer)
Select Case Index
Case 0 'Ðåäàêòèðîâàòü
Edit_Mode True
Case 1 'Âñòàâèòü
New_Record "ins"
Case 2 'Äîáàâèòü
New_Record "add"
Case 3 'Óäàëèòü
Delete_Record
End Select
End Sub
'Ñîçäàíèå íîâîé çàïèñè
Private Sub New_Record(ver As Variant)
On Error Resume Next
Dim Index As Long
Index = IIf(ver = "ins", List1.ListIndex + 0.1, 9999)
With Rr
.AddNew
.Fields("Íàèìåíîâàíèå") = "#" & Trim(str(.Fields(0)))
.Fields("Êðàòêî") = Trim(str(.Fields(0)))
.Fields("Íîìåð") = IIf(ver = "ins", Index + 0.1, 9999)
.Update
End With
fill_List_Parameters
With List1
.ListIndex = IIf(ver = "ins", Index, .ListCount - 1)
refrech_blank .ItemData(.ListIndex)
End With
End Sub

'Óäàëåíèå çàïèñè çàïèñè
Private Sub Delete_Record()
On Error Resume Next
With List1
Dim Index As Long: Index = .ListIndex
Dim Id As Long: Id = .ItemData(.ListIndex)
End With
With Rr:
.FindFirst .Fields("Êîä").name & " = " & str(Id)
If MsgBox("Óäàëÿåì ïîçèöèþ ", vbYesNo + vbQuestion + vbDefaultButton2, Text(0)) = vbNo Then
Exit Sub
End If
.Delete
End With
fill_List_Parameters
List1.ListIndex = IIf(Index > List1.ListCount - 1, List1.ListCount - 1, Index)
refrech_blank List1.ItemData(List1.ListIndex)
'Ñáðîñ ññûëîê íà óäàëåííóþ ãðóïïó â íàáîðå ïðîäóêòîâ
Dim strSQL As String, qr As QueryDef
strSQL = "UPDATE Ïðîäóêò set [ÊîäÃðóïïû] = 1 Where [ÊîäÃðóïïû] = " & str(Id)
Set qr = DB.CreateQueryDef("", strSQL)
qr.Execute
Set qr = Nothing
End Sub

'|||||||||||||||||||||||||||||||||||||||||||||
' Çàïèñü ðåçóëüòàòîâ ðåäàêòèðîâàíèÿ â áàçó
'|||||||||||||||||||||||||||||||||||||||||||||
Private Function Fix_Edit_Resalts(Ok As Boolean) As Boolean
If Ok Then put_to_base
Fix_Edit_Resalts = True
End Function
Private Sub put_to_base()
On Error Resume Next
' Êîððåêòèðîâêà
If Option1(1).value Then
Check1.value = 0
Check2.value = 0
Else
If Check1.value = 0 Then Check2.value = 0
End If
' Ôèêñàöèÿ ðåçóëüòàòàîâ
With Rr
.Edit
.Fields("Íàèìåíîâàíèå") = Left(Text(0), .Fields("Íàèìåíîâàíèå").Size - 1) & Space(1)
.Fields("Êðàòêî") = Left(Text(1), .Fields("Êðàòêî").Size)
.Fields("Âõîäíîé") = IIf(Option1(1).value, True, False)
.Fields("Òîâàðíûé") = IIf(Check1.value = 0, False, True)
.Fields("Ñâåòëûé") = IIf(Check2.value = 0, False, True)
.Update
End With
End Sub

Нее, так не пойдет! Оформите как следует. Отредактируйте свое сообщение и разместите код между тегами . Читать невозможно. Да и выкладывать такие большие куски надо было в файл..

ЗЫ. А еще лучше, измените свой код так, чтобы интуитивно можно было догадаться, что это за контрол. Ну что ж это за названия - Check1, List1... chkShowResult, lstWareItems - вот так надо, по контексту.

Подготовлю.

SkyM@n, я небольшой файлик подготовил. Как отправить?

Уфф......Там можно вложения делать.. Лучше напиши в личку, а то уже на чат похож этот топик...

Т.е. речь о том, что если меню скрыть, то почему-то перестают работать оперативные клавиши.