vb万分迷惑 求解

SKY定格

1. 
   

复制代码

1. Dim mkey() As Integer
   
2. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   
3.     If UBound(mkey) = 0 Then GoTo l
   
4.         If mkey(UBound(mkey) - 1) <> KeyCode Then
   
5. l:
   
6.             mkey(UBound(mkey)) = KeyCode
   
7.             ReDim Preserve mkey(UBound(mkey) + 1) As Integer
   
8.             mkey(UBound(mkey)) = 0
   
9.         End If
   
10. For i = 0 To UBound(mkey)
    
11. If mkey(i) = 37 Then c1.Left = c1.Left - 20
    
12. If mkey(i) = 40 Then c1.Top = c1.Top + 20
    
13. If mkey(i) = 39 Then c1.Left = c1.Left + 20
    
14. If mkey(i) = 38 Then c1.Top = c1.Top - 20
    
15. Next i
    
16. Dim aaa As String
    
17.     For i = 0 To UBound(mkey)
    
18.      aaa = aaa & mkey(i) & " | "
    
19.     Next
    
20.     Debug.Print aaa
    
21. End Sub
    
22. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    
23. For i = 0 To UBound(mkey) - 1
    
24.     If mkey(i) = KeyCode Then
    
25.         If UBound(mkey) = 1 Or UBound(mkey) = 0 Then
    
26.             ReDim mkey(0) As Integer
    
27.             mkey(0) = 0
    
28.         Else
    
29.             For a = i To UBound(mkey) - 1
    
30.                 mkey(a) = mkey(a + 1)
    
31.             Next a
    
32.         ReDim Preserve mkey(UBound(mkey) - 1) As Integer
    
33.         End If
    
34.     End If
    
35. Next i
    
36. End Sub
    
37. Private Sub Form_Load()
    
38. ReDim mkey(0) As Integer
    
39. End Sub
    

复制代码

窗体有一label  名为c1
运行 后  按上下左右  实现多键控制  
错误：
按下多键时如果首先松开最后按下的那个键c1停止移动  如果先松开前面按的键则正常
如首先按上  再按右     如果先松开右  则停止移动（理想中应该继续向上移动）  如果先松开上则继续向右移动正常。
求解

keyou2007

赚钱来的  我看看啊

SKY定格

求解答  找高手

spxtxh

• Dim mkey() As Integer    ’ 定义一个动态数组
• Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)  '窗体按键按下时触发
•     If UBound(mkey) = 0 Then GoTo  1  '第一次按键，则转到标签号1: 执行
•         If mkey(UBound(mkey) - 1) <> KeyCode Then           ’如果不是第一次按下按键并且没有按下之前按过的键
• l:
•             mkey(UBound(mkey)) = KeyCode                   '将新增的按键码存到数组末尾
•             ReDim Preserve mkey(UBound(mkey) + 1) As Integer      '动态分配数组大小。保留原有元素，数组下标上限增1
•             mkey(UBound(mkey)) = 0   '数组末尾元素置零
•         End If
• For i = 0 To UBound(mkey)       '不管多少按键被按下，只要有相应的方向键被按下，就执行移动语句
• If mkey(i) = 37 Then c1.Left = c1.Left - 20
• If mkey(i) = 40 Then c1.Top = c1.Top + 20
• If mkey(i) = 39 Then c1.Left = c1.Left + 20
• If mkey(i) = 38 Then c1.Top = c1.Top - 20
• Next i
• Dim aaa As String       '调试输出字符串变量
•     For i = 0 To UBound(mkey)
•      aaa = aaa & mkey(i) & " | "
•     Next
•     Debug.Print aaa    '调试输出字符串（目前所有被按下的按键的键盘码）
• End Sub
• Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)     '松开按键时触发
• For i = 0 To UBound(mkey) - 1      '数组末尾为零，所以从数组首到数组倒数第二个元素（也就是对所有按下的按键进行分
•                                                      '析，越早按下的按键码也靠近数组首）
•     If mkey(i) = KeyCode Then     '哪个按键被松开了，就从这个按键码在数组中的位置开始修改数组的元素的值直到数组结尾
•         If UBound(mkey) = 1 Or UBound(mkey) = 0 Then  '如果此时数组里只有一个按键的记录，那么就是说这个按键又被松开
•                                                                                        '那么就将数组再初始化，同Form_Load事件的处理
•             ReDim mkey(0) As Integer
•             mkey(0) = 0
•         Else                                                                        '如果此时，数组里有多个按键码（之前有不止一个按键被按下）
•             For a = i To UBound(mkey) - 1                        '那么就将此时松开的那个按键的按键码从数组里删除
                                                                   '这是数组的删除元素操作，就是把要删除的数组元素所在的位置用后面的
•                                                                 '数组元素来移位填充，数组长度减一
•                 mkey(a) = mkey(a + 1)           ’例如 之前数组为（38 55 26 0）
•                                           '删除一个按键码 55 后,   数组为 (38 26 0)
•             Next a
•         ReDim Preserve mkey(UBound(mkey) - 1) As Integer      '因为删除了一个数组元素，所以数组长度减一
•         End If
•     End If
• Next i
• End Sub
• Private Sub Form_Load()
• ReDim mkey(0) As Integer      '动态分配数组大小为一位动态数组，且当前数组长度为1
• End Sub
• 
  

spxtxh

经测试，当按下一个按键接着又松开同一按键时，WINDOWS系统会产生中断重复按键的消息接收。
什么意思呢？
找了一下资料，大概意思是，键盘的按键消息处理，每个按键keydown必然对应有keyup.
但系统接收到keydown消息，而没有接收到Keyup消息时，会自动重载keydow消息。（你按下一个键时，没有反复按，只是按着不松开，其实，你只按了一次按键，但是只要没有松开，系统会是作重复按这个键，按一定间隔，重载keydown消息，直到收到对应的keyup消息）而windows消息队列是有序的，一旦有同一按键的KEYDOWN和KEYUP之间没有别的按键的KEYDOWN事件，则会中断重载KEYDOWN消息。等待下一次KEYDOWN消息到达，才再次开启重载机制(就像是一个开关机制,特定条件下开启，特定条件下关闭响应机制)
不知道，我理解的对不.(这种情况与VB程序无关，而与WINDOWS消息机制有关)
看看下面的例子，参考一下:

spxtxh

Dim mkey() As Integer
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If UBound(mkey) = 0 Then GoTo l
        If mkey(UBound(mkey) - 1) <> KeyCode Then
l:
            mkey(UBound(mkey)) = KeyCode
            ReDim Preserve mkey(UBound(mkey) + 1) As Integer
            mkey(UBound(mkey)) = 0
        End If
For i = 0 To UBound(mkey)
If mkey(i) = 37 Then c1.Left = c1.Left - 20
If mkey(i) = 40 Then c1.Top = c1.Top + 20
If mkey(i) = 39 Then c1.Left = c1.Left + 20
If mkey(i) = 38 Then c1.Top = c1.Top - 20
Next i
Dim aaa As String
    For i = 0 To UBound(mkey)
     aaa = aaa & mkey(i) & " | "
    Next
    Debug.Print aaa
    Form1.Cls
    Print aaa
   
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
For i = 0 To UBound(mkey) - 1
    If mkey(i) = KeyCode Then
        If UBound(mkey) = 1 Or UBound(mkey) = 0 Then
            ReDim mkey(0) As Integer
            mkey(0) = 0
        Else
            For a = i To UBound(mkey) - 1
               
                mkey(a) = mkey(a + 1)
               
            Next a
        ReDim Preserve mkey(UBound(mkey) - 1) As Integer
        
       Dim bbb As String
    For n = 0 To UBound(mkey)
     bbb = bbb & mkey(n) & " | "
    Next
    Print bbb
   
        End If
    End If
Next i
End Sub
Private Sub Form_Load()
ReDim mkey(0) As Integer
End Sub
可以看出，我们的程序没问题，数组删除元素正常，是系统消息机制的影响，没有达到预期的效果,当按下一个键有松开同一个键后，系统自动停止了之前按键的消息重载.此时，数组里一切正常，KEYUP  KEYDOWN 事件正常，但是系统代劳的按键消息重载（类似系统记忆之前按下了哪些键没松开）失灵了

SKY定格

Dim mkey() As Integer
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If UBound ...[/quote]
人才啊  我一直在看我的程序那里错了  改了又改还是不对    原来是这个原因。。  我再想想怎么解决
谢啦    你哪位？

SKY定格

Dim mkey() As Integer
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If UBound ...[/quote]
我加了个timer  可以实现我的要求了   不过感觉不太好    再求更简单有效的方法

1. Dim mkey() As Integer
   
2. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   
3.     If UBound(mkey) = 0 Then GoTo l
   
4.         If mkey(UBound(mkey) - 1) <> KeyCode Then
   
5. l:
   
6.             mkey(UBound(mkey)) = KeyCode
   
7.             ReDim Preserve mkey(UBound(mkey) + 1) As Integer
   
8.             mkey(UBound(mkey)) = 0
   
9.         End If
   
10.         
    
11.     '我一开始移动的代码放在这里的  但是有点问题  上面说过了  所以我的方法是
    
12.     '放在timer里面  求更好的方法
    
13.         
    
14.         'For i = 0 To UBound(mkey)
    
15.             'If mkey(i) = 37 Then c1.Left = c1.Left - 20
    
16.             'If mkey(i) = 40 Then c1.Top = c1.Top + 20
    
17.             'If mkey(i) = 39 Then c1.Left = c1.Left + 20
    
18.             'If mkey(i) = 38 Then c1.Top = c1.Top - 20
    
19.         'Next i
    
20. Dim aaa As String
    
21.     For i = 0 To UBound(mkey)
    
22.      aaa = aaa & mkey(i) & " | "
    
23.     Next
    
24.     Debug.Print aaa
    
25.     Form1.Cls
    
26.     Print aaa
    
27.    
    
28. End Sub
    
29. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    
30. For i = 0 To UBound(mkey) - 1
    
31.     If mkey(i) = KeyCode Then
    
32.         If UBound(mkey) = 1 Or UBound(mkey) = 0 Then
    
33.             ReDim mkey(0) As Integer
    
34.             mkey(0) = 0
    
35.         Else
    
36.             For a = i To UBound(mkey) - 1
    
37.                
    
38.                 mkey(a) = mkey(a + 1)
    
39.                
    
40.             Next a
    
41.         ReDim Preserve mkey(UBound(mkey) - 1) As Integer
    
42.         
    
43.        Dim bbb As String
    
44.     For n = 0 To UBound(mkey)
    
45.      bbb = bbb & mkey(n) & " | "
    
46.     Next
    
47.     Print bbb
    
48.    
    
49.         End If
    
50.     End If
    
51. Next i
    
52. End Sub
    
53. Private Sub Form_Load()
    
54. ReDim mkey(0) As Integer
    
55. Timer1.Enabled = True
    
56. Timer1.Interval = 33
    
57. End Sub
    
58. Private Sub Timer1_Timer()
    
59. For i = 0 To UBound(mkey)
    
60. If mkey(i) = 37 Then c1.Left = c1.Left - 20
    
61. If mkey(i) = 40 Then c1.Top = c1.Top + 20
    
62. If mkey(i) = 39 Then c1.Left = c1.Left + 20
    
63. If mkey(i) = 38 Then c1.Top = c1.Top - 20
    
64. Next i
    
65. End Sub
    

复制代码

SKY定格

一种新方法  也可以实现这个功能而且代码更简单   给大家提个思路
窗体上一个时钟控件  一个label  名字lb

1. Option Explicit
   
2. Dim Keys(255) As Byte '255应该够用了
   
3. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   
4.     Keys(KeyCode) = 1
   
5. End Sub
   
6. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   
7.     Keys(KeyCode) = 0
   
8. End Sub
   
9. Private Sub Form_Load()
   
10.     Timer1.Interval = 10
    
11.     Timer1.Enabled = True
    
12. End Sub
    
13. Private Sub Timer1_Timer()
    
14.     If Keys(vbKeyLeft) Then
    
15.         Lb.Left = Lb.Left - 100
    
16.         If Lb.Left < 0 Then Lb.Left = Me.ScaleWidth
    
17.     End If
    
18.     If Keys(vbKeyRight) Then
    
19.         Lb.Left = Lb.Left + 100
    
20.         If Lb.Left > Me.ScaleWidth Then Lb.Left = 0
    
21.     End If
    
22.     If Keys(vbKeyUp) Then
    
23.         Lb.Top = Lb.Top - 100
    
24.         If Lb.Top < 0 Then Lb.Top = Me.ScaleHeight
    
25.     End If
    
26.     If Keys(vbKeyDown) Then
    
27.         Lb.Top = Lb.Top + 100
    
28.         If Lb.Top > Me.ScaleHeight Then Lb.Top = 0
    
29.     End If
    
30. End Sub

复制代码