home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Example_of1799241012004.psc / modKeys.bas < prev    next >
Encoding:
BASIC Source File  |  2004-07-18  |  6.1 KB  |  156 lines
  1. Attribute VB_Name = "modKeys"
  2. 'GetKeyPressName ---
  3. ' PURPOSE: Get name of KeyPress
  4. ' INPUTS:
  5. '  objKeyPress: HotKey object with keypress in it
  6. ' RETURNS: Keypress name (eg. CTRL+Z)
  7. ' EXAMPLE: mnuUndo.Caption = "&Undo" & vbTab & GetKeyPressName(CSGlobals.GetHotKeyForCmd(cmCmdUndo, 0))
  8. Function GetKeyPressName(objKeyPress As HotKey) As String
  9. 'if no keypress, exit function
  10. If objKeyPress Is Nothing Then Exit Function
  11. If objKeyPress.VirtKey1 = "" Then Exit Function
  12. Dim strResult As String
  13. strResult = vbTab
  14. 'get key mask (eg. CTRL+ALT)
  15. strResult = strResult & GetKeyMaskName(objKeyPress.Modifiers1)
  16. 'append keyname (eg. Z or ESCAPE)
  17. strResult = strResult & GetVirtKeyName(objKeyPress.VirtKey1)
  18.  
  19. 'if second keypress, ...
  20. If objKeyPress.VirtKey2 <> "" Then
  21.     '...append a comma...
  22.     strResult = strResult & ", "
  23.     '...and do the same as with first keypress
  24.     strResult = strResult & GetKeyMaskName(objKeyPress.Modifiers2)
  25.     strResult = strResult & GetVirtKeyName(objKeyPress.VirtKey2)
  26. End If
  27. 'return result
  28. GetKeyPressName = strResult
  29. End Function
  30.  
  31. 'GetVirtKeyName ---
  32. ' PURPOSE: Get the name of a key
  33. ' INPUTS:
  34. '  VirtKey - String / Integer containing KeyCode
  35. ' RETURNS: Key name (eg. Z or INSERT)
  36. ' EXAMPLE: msgbox GetVirtKeyName(&H70)
  37. Function GetVirtKeyName(VirtKey) As String
  38. Dim intVirtKey As Integer
  39. 'if VirtKey is string...
  40. If VarType(VirtKey) = vbString Then
  41.     '...convert to integer
  42.     intVirtKey = Asc(VirtKey)
  43. Else
  44.     intVirtKey = VirtKey
  45. End If
  46.  
  47. 'find out key name
  48. Select Case intVirtKey
  49.     Case vbKeyAdd: GetVirtKeyName = "+ (KEYPAD)"
  50.     Case vbKeyBack: GetVirtKeyName = "BACKSPACE"
  51.     Case vbKeyCancel: GetVirtKeyName = "CANCEL"
  52.     Case vbKeyCapital: GetVirtKeyName = "CAPSLOCK"
  53.     'Clear? The '5' on the numpad when Num Lock
  54.     'is off - try it!
  55.     Case vbKeyClear: GetVirtKeyName = "CLEAR"
  56.     Case vbKeyControl: GetVirtKeyName = "CONTROL"
  57.     Case vbKeyDecimal: GetVirtKeyName = ". (KEYPAD)"
  58.     Case vbKeyDelete: GetVirtKeyName = "DELETE"
  59.     Case vbKeyDivide: GetVirtKeyName = "/ (KEYPAD)"
  60.     Case vbKeyDown: GetVirtKeyName = "DOWN ARROW"
  61.     Case vbKeyEnd: GetVirtKeyName = "END"
  62.     Case vbKeyEscape: GetVirtKeyName = "ESCAPE"
  63.     'What's an 'EXECUTE' key????
  64.     Case vbKeyExecute: GetVirtKeyName = "EXECUTE"
  65.     Case vbKeyF1: GetVirtKeyName = "F1"
  66.     Case vbKeyF2: GetVirtKeyName = "F2"
  67.     Case vbKeyF3: GetVirtKeyName = "F3"
  68.     Case vbKeyF4: GetVirtKeyName = "F4"
  69.     Case vbKeyF5: GetVirtKeyName = "F5"
  70.     Case vbKeyF6: GetVirtKeyName = "F6"
  71.     Case vbKeyF7: GetVirtKeyName = "F7"
  72.     Case vbKeyF8: GetVirtKeyName = "F8"
  73.     Case vbKeyF9: GetVirtKeyName = "F9"
  74.     Case vbKeyF10: GetVirtKeyName = "F10"
  75.     Case vbKeyF11: GetVirtKeyName = "F11"
  76.     Case vbKeyF12: GetVirtKeyName = "F12"
  77.     Case vbKeyF13: GetVirtKeyName = "F13"
  78.     Case vbKeyF14: GetVirtKeyName = "F14"
  79.     Case vbKeyF15: GetVirtKeyName = "F15"
  80.     Case vbKeyF16: GetVirtKeyName = "F16"
  81.     'What the hell's a help key?
  82.     Case vbKeyHelp: GetVirtKeyName = "HELP"
  83.     Case vbKeyHome: GetVirtKeyName = "HOME"
  84.     Case vbKeyInsert: GetVirtKeyName = "INSERT"
  85.     'Mouse button is a key?
  86.     Case vbKeyLButton: GetVirtKeyName = "LEFT MOUSE"
  87.     Case vbKeyLeft: GetVirtKeyName = "LEFT ARROW"
  88.     Case vbKeyMButton: GetVirtKeyName = "MIDDLE MOUSE"
  89.     'Menu key? apparently 'ALT' is menu key
  90.     'Case vbKeyMenu: GetVirtKeyName = "MENU KEY"
  91.     Case vbKeyMenu: GetVirtKeyName = "ALT"
  92.     Case vbKeyMultiply: GetVirtKeyName = "* (KEYPAD)"
  93.     Case vbKeyNumlock: GetVirtKeyName = "NUMLOCK"
  94.     Case vbKeyNumpad0: GetVirtKeyName = "0 (KEYPAD)"
  95.     Case vbKeyNumpad1: GetVirtKeyName = "1 (KEYPAD)"
  96.     Case vbKeyNumpad2: GetVirtKeyName = "2 (KEYPAD)"
  97.     Case vbKeyNumpad3: GetVirtKeyName = "3 (KEYPAD)"
  98.     Case vbKeyNumpad4: GetVirtKeyName = "4 (KEYPAD)"
  99.     Case vbKeyNumpad5: GetVirtKeyName = "5 (KEYPAD)"
  100.     Case vbKeyNumpad6: GetVirtKeyName = "6 (KEYPAD)"
  101.     Case vbKeyNumpad7: GetVirtKeyName = "7 (KEYPAD)"
  102.     Case vbKeyNumpad8: GetVirtKeyName = "8 (KEYPAD)"
  103.     Case vbKeyNumpad9: GetVirtKeyName = "9 (KEYPAD)"
  104.     Case vbKeyPageDown: GetVirtKeyName = "PAGE DOWN"
  105.     Case vbKeyPageUp: GetVirtKeyName = "PAGE UP"
  106.     Case vbKeyPause: GetVirtKeyName = "PAUSE"
  107.     Case vbKeyPrint: GetVirtKeyName = "PRINT SCREEN"
  108.     Case vbKeyRButton: GetVirtKeyName = "RIGHT MOUSE"
  109.     Case vbKeyReturn: GetVirtKeyName = "ENTER"
  110.     Case vbKeyRight: GetVirtKeyName = "RIGHT ARROW"
  111.     Case vbKeyScrollLock: GetVirtKeyName = "SCROLL LOCK"
  112.     '...select? hmmmmmmmmm
  113.     Case vbKeySelect: GetVirtKeyName = "SELECT"
  114.     Case vbKeySeperator: GetVirtKeyName = "ENTER (KEYPAD)"
  115.     Case vbKeyShift: GetVirtKeyName = "SHIFT"
  116.     'snapshot *BANG* oops
  117.     Case vbKeySnapshot: GetVirtKeyName = "SNAPSHOT"
  118.     Case vbKeySpace: GetVirtKeyName = "SPACE"
  119.     Case vbKeySubtract: GetVirtKeyName = "- (KEYPAD)"
  120.     Case vbKeyTab: GetVirtKeyName = "TAB"
  121.     Case vbKeyUp: GetVirtKeyName = "UP ARROW"
  122.     
  123.     Case 186: GetVirtKeyName = "SEMICOLON"
  124.     Case 187: GetVirtKeyName = "="
  125.     Case 188: GetVirtKeyName = "COMMA"
  126.     Case 189: GetVirtKeyName = "-"
  127.     Case 190: GetVirtKeyName = "DOT (.)"
  128.     Case 191: GetVirtKeyName = "/"
  129.     Case 192: GetVirtKeyName = "`"
  130.     Case 219: GetVirtKeyName = "["
  131.     Case 220: GetVirtKeyName = "\"
  132.     Case 221: GetVirtKeyName = "]"
  133.     Case 222: GetVirtKeyName = "'"
  134.     'ahhhh, the any key!
  135.     Case 223: GetVirtKeyName = "ANY"
  136.     
  137.     'Case Else: GetVirtKeyName = "UNKNOWN" & intVirtKey
  138.     Case Else: GetVirtKeyName = Chr(intVirtKey)
  139. End Select
  140. End Function
  141.  
  142. 'GetKeyMaskName ---
  143. ' PURPOSE: Get the key mask, eg. CTRL+ALT+
  144. ' INPUTS:
  145. '  bytKeyMask - key mask, eg. alt=4 ctrl=2 shift=1
  146. ' RETURNS: Key mask, eg. CTRL or CTRL+SHIFT+ALT
  147. ' EXAMPLE: MsgBox GetKeyMaskName(6) 'is the same as
  148. '          MsgBox GetKeyMaskName(vbAltMask + vbCtrlMask)
  149. Function GetKeyMaskName(bytKeyMask As Byte) As String
  150. Dim strResult As String
  151. If (bytKeyMask And vbCtrlMask) = vbCtrlMask Then strResult = "CTRL+"
  152. If (bytKeyMask And vbShiftMask) = vbShiftMask Then strResult = strResult & "SHIFT+"
  153. If (bytKeyMask And vbAltMask) = vbAltMask Then strResult = strResult & "ALT+"
  154. GetKeyMaskName = strResult
  155. End Function
  156.