home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Lengine_(C20326511232006.psc / LEngine_B755 / Battle / keyReciever.ctl < prev    next >
Text File  |  2006-07-05  |  3KB  |  132 lines
  1. VERSION 5.00
  2. Begin VB.UserControl keyReciever 
  3.    BackColor       =   &H00C0C0FF&
  4.    ClientHeight    =   2205
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   2430
  8.    InvisibleAtRuntime=   -1  'True
  9.    ScaleHeight     =   2205
  10.    ScaleWidth      =   2430
  11.    Begin VB.Timer Timer1 
  12.       Enabled         =   0   'False
  13.       Interval        =   70
  14.       Left            =   1320
  15.       Tag             =   "0"
  16.       Top             =   1680
  17.    End
  18.    Begin VB.Label Label1 
  19.       Caption         =   "Keys"
  20.       Height          =   495
  21.       Left            =   120
  22.       TabIndex        =   0
  23.       Top             =   120
  24.       Width           =   495
  25.    End
  26. End
  27. Attribute VB_Name = "keyReciever"
  28. Attribute VB_GlobalNameSpace = False
  29. Attribute VB_Creatable = True
  30. Attribute VB_PredeclaredId = False
  31. Attribute VB_Exposed = False
  32. Private iKeys() As Integer
  33. Private iKeysA() As Integer
  34.  
  35. Public Event OnKeyDown(ByVal KeyAscii As Integer)
  36. Public Event OnKeyPressed(ByVal KeyAscii As Integer)
  37. Public Event Timer()
  38.  
  39. Private Index As Integer
  40.  
  41. Option Explicit
  42.  
  43. Property Let Enabled(newEnabled As Boolean)
  44.     Timer1.Enabled = newEnabled
  45. End Property
  46.  
  47. Sub SetSize(iSize As Integer)
  48.     ReDim iKeys(iSize)
  49.     ReDim iKeysA(iSize)
  50. End Sub
  51.  
  52. Sub ClearKeys()
  53.  
  54. Dim I As Integer
  55.     
  56.     For I = 0 To UBound(iKeysA)
  57.         iKeys(I) = 0
  58.         iKeysA(I) = 0
  59.     Next
  60.     Index = 0
  61.  
  62. End Sub
  63.  
  64. Sub AddKey(KeyAscii As Integer)
  65.  
  66.     iKeys(Index) = KeyAscii
  67.     
  68.     Index = Index + 1
  69.     
  70. End Sub
  71.  
  72. Private Sub Timer1_Timer()
  73.  
  74.     Dim I As Integer
  75.     
  76.     For I = 0 To UBound(iKeysA)
  77.         If iKeysA(I) <> 0 Then
  78.             If iKeysA(I) = 1 And GetAsyncKeyState(iKeys(I)) = 0 Then
  79.             
  80.                 If iKeys(I) = 27 Then
  81.                     'Esc
  82.                     iKeysA(I) = 0
  83.                     Call frmMain.ToggleFileMenu
  84.                 Else
  85.                 
  86.                     iKeysA(I) = 0
  87.                     RaiseEvent OnKeyPressed(iKeys(I))
  88.                 End If
  89.             End If
  90.         End If
  91.     Next
  92.     
  93.     For I = 0 To UBound(iKeysA)
  94.         If iKeys(I) <> 0 Then
  95.             If GetAsyncKeyState(CLng(iKeys(I))) <> 0 Then
  96.             
  97.                 iKeysA(I) = 1
  98.                 RaiseEvent OnKeyDown(iKeys(I))
  99.  
  100.                 'Only Report 1 KeyDown at a time
  101.                 Exit For
  102.             End If
  103.         End If
  104.     Next
  105.     
  106.     RaiseEvent Timer
  107.  
  108. End Sub
  109.  
  110. Private Sub UserControl_Initialize()
  111.  
  112.     If NotInDbg = True Then
  113.         Timer1.Enabled = True
  114.     End If
  115.     
  116.     ReDim iKeys(12)
  117.     ReDim iKeysA(12)
  118.     
  119.     'Add Esc Key
  120.     Me.AddKey 27
  121.         
  122. End Sub
  123.  
  124. Private Sub UserControl_Resize()
  125.     UserControl.Height = 810
  126.     UserControl.Width = 810
  127. End Sub
  128.  
  129. Private Sub UserControl_Terminate()
  130.     Timer1.Enabled = False
  131. End Sub
  132.