PureBasic Forums - English

Code: Select all

;=================================================================
; Module:          GetScanKeyCodeFromString
; Author:          Michael Taupitz (neotoma)
; Date:            4. July 2007
; Target OS:       Microsoft Windows All
; Target Compiler: PureBasic 4.0 and later
; License:         Free, unrestricted, credit appreciated
;                  but not required
; Version:         Beta 1.0
;=================================================================

EnableExplicit

;This Structure is needed to get the 2 Values for
; Hotkey-Registering
Structure sKeyCode
  mod.l       ; SHIFT,ALT ect
  code.l      ; Key (#VK_xx)
EndStructure

;This Macros are very Helpfull
Macro mDQUOTE
  "
EndMacro

Macro DQtMe(v)
  mDQUOTE#v#mDQUOTE
EndMacro

; Makes the definition of Keys in the Keytable much easier
Macro mcKey(MCKEY)
  Data.s DQtMe(KEY_#MCKEY) : Data.l #VK_#MCKEY
EndMacro

; Simplified for Debug-Output
Macro DHex( __VAL__ )
  "$"+RSet( Hex(__VAL__), 4, "0")
EndMacro


DataSection
KEYTABLE:
;Numbers
mcKey(1) : mcKey(2) : mcKey(3) : mcKey(4) : mcKey(5)
mcKey(6) : mcKey(7) : mcKey(8) : mcKey(9) : mcKey(0)

;Alphabet
mcKey(A) : mcKey(B) : mcKey(C) : mcKey(D) : mcKey(E) : mcKey(F) : mcKey(G):  mcKey(H)
mcKey(I) : mcKey(J) : mcKey(K) : mcKey(L) : mcKey(M) : mcKey(n) : mcKey(O) : mcKey(P)
mcKey(Q) : mcKey(R) : mcKey(S) : mcKey(T) : mcKey(u) : mcKey(v) : mcKey(W) : mcKey(X)
mcKey(Y) : mcKey(Z)

;Function-Keys
mcKey(F1) : mcKey(F2) : mcKey(F3) : mcKey(F4) : mcKey(F5) : mcKey(F6)
mcKey(F7) : mcKey(F8) : mcKey(F9) : mcKey(F10) : mcKey(F11) : mcKey(F12)


;Arrowws
mcKey(UP) :  mcKey(DOWN) : mcKey(LEFT) :  mcKey(RIGHT)

;Num-Pad
mcKey(NUMPAD0) : mcKey(NUMPAD1) : mcKey(NUMPAD2) : mcKey(NUMPAD3) : mcKey(NUMPAD4)
mcKey(NUMPAD5) : mcKey(NUMPAD6) : mcKey(NUMPAD7) : mcKey(NUMPAD8) : mcKey(NUMPAD9)

;Calculation-Keys
mcKey(SUBTRACT)
mcKey(ADD)
mcKey(MULTIPLY)
mcKey(DIVIDE)

; Speacial Keys
mcKey(ESCAPE)
mcKey(TAB)

mcKey(HOME)
mcKey(End)
mcKey(BACK)

mcKey(PRIOR)
mcKey(Next)
mcKey(PAUSE)


mcKey(Return)
mcKey(Scroll)
mcKey(DECIMAL)

; Thias marks the End !!!!
Data.s "" : Data.l -1
EndDataSection


;-----------------------------------------------------------------------
; Find a Key by Name in the Map and return the Keycode
;-----------------------------------------------------------------------
Procedure GetKeyVal(key.s)
  Define keyname.s
  Define keyval.l
  
  keyval = #Null
  Restore KEYTABLE
  While keyval <> -1
    Read keyname
    Read keyval 
    If UCase(keyname) = UCase(key)  Or UCase(keyname) = UCase("KEY_"+key)
      Break
    EndIf
  Wend
  ProcedureReturn keyval
EndProcedure

;-----------------------------------------------------------------------
; Find a Key by Value in the Map and return his Name
;-----------------------------------------------------------------------
Procedure.s GetKeyName(val.l)
  Define keyname.s
  Define keyval.l
  
  keyname ="unknown"
  Restore KEYTABLE
  While keyval <> -1
    Read keyname
    Read keyval 
    If keyval = val
      Break
    EndIf
  Wend
  ProcedureReturn Right(keyname, Len(keyname)-4)
EndProcedure

;
;-----------------------------------------------------------------------
; Makes a Userreadable String from the modifier (ALT, SHIT and CONTROL)
;-----------------------------------------------------------------------
Procedure.s GetModifierText(mod.l)
  
  Define Out.s , f.l
  
  f=0  ; simple flag for correct '+'
  If ( mod & #MOD_ALT )
    Out + "ALT" :  f=1
  EndIf
  
  If ( mod & #MOD_CONTROL )
    If f : out + " + " : EndIf
    Out + "CONTROL"
    f=1
  EndIf
  
  If ( mod & #MOD_SHIFT )
    If f : out + " + " : EndIf
    Out + "SHIFT"
  EndIf   
  
  
  ProcedureReturn Out 
  
  
EndProcedure


;-----------------------------------------------------------------------
; This Procedure scans a String like "ALT|SHIFT|KEY_1" and fills the
; Keycode-Structure. With the Result you can Register Hotkeys (thats
; For what i wrote it.... ;-) ).
; Example:
;     GetKeyValFromString("ALT|SHIFT|KEY_1", @kc.sKeyCode)
;     RegisterHotKey_(WindowID(win), 0, kc\mod,kc\code)   
;   
; Remember in this Example of registering, the 0 is the 'id' of the
; Hotkey with that you can find it as wParam when the #WM_HOTKEY-Event
; appears. Also you need this id for unregister the Hotkey.
;-----------------------------------------------------------------------
Procedure GetKeyValFromString(scantext.s, *keycode.sKeyCode)
  Define count.l = 0, i.l
  Define key.s, val.l
  
  
  *keycode\mod = 0 : *keycode\code = 0
  
  count = CountString(scantext,"|")
  For i = 1 To count+1
    val = 0
    key.s = UCase(StringField(scantext,I,"|"))
    
    If key = "SHIFT"
      *keycode\mod = *keycode\mod | #MOD_SHIFT
    ElseIf key = "CTRL"
      *keycode\mod = *keycode\mod | #MOD_CONTROL
    ElseIf key = "STRG"
      *keycode\mod = *keycode\mod | #MOD_CONTROL
    ElseIf key = "CONTROL"
      *keycode\mod = *keycode\mod | #MOD_CONTROL
    ElseIf key = "ALT"
      *keycode\mod = *keycode\mod | #MOD_ALT
    Else         
      val.l = GetKeyVal(key)
      *keycode\code = *keycode\code | val
    EndIf   
  Next
EndProcedure

; Some Examples :
Define scantext.s, code.l,kc.sKeyCode
;
scantext.s = "ALT|SHIFT|F1"
code.l = GetKeyValFromString(scantext,@kc.sKeyCode)
Debug("Soll-Code="+DHex(#MOD_ALT | #MOD_SHIFT) + " / " + DHex(#VK_F1) )
Debug("Ist-Code="+DHex(kc\mod) + " / " +DHex(kc\code) )
;
;
Debug "ScanText = " + GetModifierText(kc\mod) + " + " + GetKeyName(kc\code)
Debug ""
;
;
scantext.s = "CONTROL|SHIFT|HOME"
code.l = GetKeyValFromString(scantext,@kc.sKeyCode)
Debug("Soll-Code="+DHex(#MOD_CONTROL | #MOD_SHIFT) + " / " + DHex(#VK_HOME) )
Debug("Ist-Code="+DHex(kc\mod) + " / " +DHex(kc\code) )
;
Debug "ScanText = " + GetModifierText(kc\mod) + " + " + GetKeyName(kc\code)
Debug ""
;
;
;
scantext.s = "SHIFT|ALT|KEY_NUMPAD1"
code.l = GetKeyValFromString(scantext,@kc.sKeyCode)
Debug("Soll-Code="+DHex(#MOD_SHIFT|#MOD_ALT) + " / " +  DHex(#VK_NUMPAD1) )
Debug("Ist-Code="+DHex(kc\mod) + " / " +DHex(kc\code) )
Debug "ScanText = " + GetModifierText(kc\mod) + " + " + GetKeyName(kc\code)
Debug ""

DisableExplicit