Új hozzászólás Aktív témák

• #741 sonar addikt

  Új Válasz 2006-12-29 09:24:28 #741

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  sonar

  addikt

  Sziasztok, ha vkinek szüksége lenne valaha a funkció gombok használatára akkor
  mentse le ezt a forrást.
  Az időzítőt én 100-200 ra szoktam állítani, lassúbb gépen elég a 200 is bár nem vettem
  észre, hogy zabálná a procit. Kell egy Text box is (Text1 néven, a gyengébbek kedvéért)
  és abba lehet figyelni,hogy éppen milyen funkció billentyű lett lenyomva.
  
  üdv sonar
  
  Option Explicit
  Private Declare Sub keybd_event Lib ''user32'' (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
  Private Declare Function GetAsyncKeyState Lib ''user32'' (ByVal vKey As Long) As Integer
  '******************Function Key*******************
  Private Const VK_F1 = &H70
  Private Const VK_F2 = &H71
  Private Const VK_F3 = &H72
  Private Const VK_F4 = &H73
  Private Const VK_F5 = &H74
  Private Const VK_F6 = &H75
  Private Const VK_F7 = &H76
  Private Const VK_F8 = &H77
  Private Const VK_F9 = &H78
  Private Const VK_F10 = &H79
  Private Const VK_F11 = &H7A
  Private Const VK_F12 = &H7B
  
  Private Sub Form_Load()
  Call FunctionClear
  Timer1.Enabled = True
  End Sub
  
  Private Sub Timer1_Timer()
  If GetAsyncKeyState(VK_F1) Then
  Text1 = ''F1'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F2) Then
  Text1 = ''F2'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F3) Then
  Text1 = ''F3'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F4) Then
  Text1 = ''F4'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F5) Then
  Text1 = ''F5'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F6) Then
  Text1 = ''F6'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F7) Then
  Text1 = ''F7'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F8) Then
  Text1 = ''F8'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F9) Then
  Text1 = ''F9'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F10) Then
  Text1 = ''F10'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F11) Then
  Text1 = ''F11'' & vbCrLf & Text1
  ElseIf GetAsyncKeyState(VK_F12) Then
  Text1 = ''F12'' & vbCrLf & Text1
  End If
  End Sub
  
  Public Sub FunctionClear()
  ' Azért kell mert első induláskor néha marad bent vmi szemét és egy üres
  ' kiolvasással megszűnik ez a probléma
  
  GetAsyncKeyState (VK_F1)
  GetAsyncKeyState (VK_F2)
  GetAsyncKeyState (VK_F3)
  GetAsyncKeyState (VK_F4)
  GetAsyncKeyState (VK_F5)
  GetAsyncKeyState (VK_F6)
  GetAsyncKeyState (VK_F7)
  GetAsyncKeyState (VK_F8)
  GetAsyncKeyState (VK_F9)
  GetAsyncKeyState (VK_F10)
  GetAsyncKeyState (VK_F11)
  GetAsyncKeyState (VK_F12)
  
  End Sub
  

Új hozzászólás Aktív témák