Teclado x API

[Marcos Guedes]

Identifica a(s) tecla(s) pressionada(s):

Código:

DO GetKeyStates
DO GetKeyNames
* end of main
 
PROCEDURE GetKeyStates
    DECLARE INTEGER GetKeyboardState IN user32 STRING @lpKeyState
 
    LOCAL cBuffer, nIndex
 
    cBuffer = Repli(Chr(0), 256)
    = GetKeyboardState (@cBuffer)
 
    CREATE CURSOR csResult (index N(3), asc N(3))
    FOR nIndex=1 TO Len(cBuffer)
        INSERT INTO csResult VALUES (;
            nIndex-1, Asc(SUBSTR(cBuffer, nIndex,1)))
    ENDFOR
    SELECT csResult
    GO TOP
    BROWSE NORMAL
 
PROCEDURE GetKeyNames
    DECLARE INTEGER GetKeyNameText IN user32;
        INTEGER lParam, STRING @lpString, INTEGER nSize
 
    CREATE CURSOR cs (scancode I, keyname C(32))
    FOR nIndex=0 TO 255
        = SaveKeycode(nIndex)
    ENDFOR
    SELECT cs
    GO TOP
    BROWSE NORMAL NOWAIT
 
PROCEDURE SaveKeycode(nKeyindex)
    LOCAL nKeycode, cKeyname
 
    nKeycode = BITLSHIFT(m.nKeyindex, 16)
    cKeyname = GetKeyName(m.nKeycode)
 
    IF NOT EMPTY(m.cKeyname)
        INSERT INTO cs VALUES (m.nKeyindex, m.cKeyname)
    ENDIF
 
FUNCTION GetKeyName(num)
    LOCAL cBuffer, nBufsize
    nBufsize=64
    cBuffer = REPLICATE(CHR(0), nBufsize)
    nBufsize = GetKeyNameText(num, @cBuffer, nBufsize)
RETURN SUBSTR(cBuffer, 1, nBufsize)


Fonte:
news2news.com/vfp/?example=305&function=-1&xpg=14

[Marcos Guedes]

Exibe layouts de teclado disponíveis para o processo atual e permite alternar entre layouts:

Código:

PUBLIC oform
oform = CREATEOBJECT("Tform")
oform.VISIBLE=.T.

DEFINE CLASS tform AS FORM
   #DEFINE wm_inputlangchange 0x0051
   #DEFINE wm_inputlangchangerequest 0x0050
   #DEFINE gwl_wndproc -4

   PROTECTED activelayout, hwindow, horigproc
   hwindow=0
   horigproc=0

   WIDTH=340
   HEIGHT=100
   BORDERSTYLE=2
   MAXBUTTON=.F.
   MINBUTTON=.F.
   CAPTION="Available Keyboard Layouts"
   AUTOCENTER=.T.

   ADD OBJECT lbllst AS LABEL WITH;
      LEFT=5, TOP=5, AUTOSIZE=.T., FONTBOLD=.T.,;
      FONTSIZE=10, CAPTION="Handles to kbd layouts:"

   ADD OBJECT lst AS LISTBOX WITH;
      LEFT=5, TOP=25, WIDTH=160, HEIGHT=60, STYLE=2

   ADD OBJECT lbllbl AS LABEL WITH;
      LEFT=190, TOP=5, AUTOSIZE=.T., FONTBOLD=.T.,;
      FONTSIZE=10, CAPTION="Active layout:"

   ADD OBJECT lbl AS LABEL WITH;
      LEFT=190, TOP=25, AUTOSIZE=.T.

   PROCEDURE INIT
      THIS.DECLARE

      IF NOT THIS.enumkbdlayouts()
         = MESSAGEBOX("Keyboard layout enumeration failed!",;
            48, "Error!")
         RETURN .F.
      ENDIF

      * save current layout
      THIS.activelayout = getkeyboardlayout(0)
      THIS.lst.LISTINDEX=1
      THIS.displayactivelayout
   ENDPROC

   PROCEDURE DESTROY
      * restore initial layout
      THIS.switchkbdlayout(THIS.activelayout)
   ENDPROC

   PROCEDURE ACTIVATE
      IF THIS.hwindow = 0
         THIS.hwindow = THIS.HWND
         THIS.horigproc = getwindowlong(THIS.hwindow, gwl_wndproc)

         * track WM_INPUTLANGCHANGE window messages
         IF VERSION(5) >= 900
            = BINDEVENT(THIS.hwindow, wm_inputlangchange,;
               THIS, "WindowProc")
         ENDIF
      ENDIF
      THIS.displayactivelayout
   ENDPROC

   PROCEDURE lst.INTERACTIVECHANGE
      THISFORM.switchkbdlayout(VAL(THIS.VALUE))
      THISFORM.displayactivelayout
   ENDPROC

   PROCEDURE windowproc(hwindow AS INTEGER, nmsgid AS INTEGER,;
         wparam AS INTEGER, LPARAM AS INTEGER)
      * requires VFP9, otherwise ignored

      LOCAL nreturn
      nreturn=0

      IF nmsgid=wm_inputlangchange
         * The input language has been changed for the applicaiton.
         * Note that only in-focus (active) form receives this message
         THIS.displayactivelayout
      ENDIF

      * pass control to the original window procedure
      nreturn = callwindowproc(THIS.horigproc, THIS.hwindow,;
         m.nmsgid, m.wparam, m.lparam)
      RETURN nreturn
   ENDPROC

   PROCEDURE displayactivelayout
      LOCAL nlocaleid, cbuffer

      nlocaleid=getkeyboardlayout(0)
      THIS.lst.VALUE=TRANSFORM(m.nlocaleid,"@0")

      cbuffer = REPLICATE(CHR(0), 250)
      = getkeyboardlayoutname(@cbuffer)

      THIS.lbl.CAPTION = STRTRAN(cbuffer, CHR(0),"") +;
         " | " + THIS.getlocalename(m.nlocaleid)
   ENDPROC

   PROCEDURE switchkbdlayout(hlayout)
      = activatekeyboardlayout(m.hlayout, 0)
   ENDPROC

   PROCEDURE enumkbdlayouts
      LOCAL cbuffer, nbufsize, ncount, nindex, hlayout
      nbufsize = 256
      cbuffer = REPLICATE(CHR(0), nbufsize)
      ncount = getkeyboardlayoutlist(nbufsize, @cbuffer)

      FOR nindex=1 TO ncount
         hlayout = buf2dword(SUBSTR(cbuffer, (nindex-1)*4+1, 4))
         THIS.lst.ADDITEM(TRANSFORM(hlayout,"@0"))
      ENDFOR
      RETURN (ncount > 0)
   ENDPROC

   FUNCTION getlocalename(nlocaleid AS NUMBER) AS STRING
      #DEFINE locale_english_us 0x0409
      #DEFINE locale_english_canada 0x1009
      #DEFINE locale_french_standard 0x040c
      #DEFINE locale_french_canada 0x0c0c
      #DEFINE locale_russian 0x0419
      #DEFINE locale_ukrainian 0x0422

      LOCAL clocalename
      nlocaleid=BITAND(nlocaleid, 0xffff)

      DO CASE
         CASE nlocaleid=locale_english_us
            clocalename="EN-US"
         CASE nlocaleid=locale_english_canada
            clocalename="EN-CA"
         CASE nlocaleid=locale_french_standard
            clocalename="FR"
         CASE nlocaleid=locale_french_canada
            clocalename="FR-CA"
         CASE nlocaleid=locale_russian
            clocalename="RU"
         CASE nlocaleid=locale_ukrainian
            clocalename="UA"
         OTHERWISE
            clocalename=TRANSFORM(nlocaleid, "@0")
      ENDCASE
      RETURN m.clocalename

   PROCEDURE DECLARE
      DECLARE INTEGER GetWindowLong IN user32;
         INTEGER hWindow, INTEGER nIndex

      DECLARE INTEGER CallWindowProc IN user32;
         INTEGER lpPrevWndFunc, INTEGER hWindow, LONG Msg,;
         INTEGER wParam, INTEGER LPARAM

      DECLARE INTEGER GetKeyboardLayout IN user32;
         INTEGER idThread

      DECLARE INTEGER GetKeyboardLayoutName IN user32;
         STRING @pwszKLID

      DECLARE INTEGER GetKeyboardLayoutList IN user32;
         INTEGER nBuff, STRING @lpList

      DECLARE INTEGER ActivateKeyboardLayout IN user32;
         INTEGER hkl, INTEGER nFlags

ENDDEFINE

FUNCTION buf2dword(cbuffer)
   RETURN ASC(SUBSTR(cbuffer, 1,1)) +;
      ASC(SUBSTR(cbuffer, 2,1)) * 256 +;
      ASC(SUBSTR(cbuffer, 3,1)) * 65536 +;
      ASC(SUBSTR(cbuffer, 4,1)) * 16777216
ENDFUNC

Fonte:
news2news.com/vfp/?example=275

[LeticiaVale]

Olá Marcos, essa função para pegar as teclas pressionadas só vale pra dentro do programa? igual um 'keypress'?

[Marcos Guedes]

Leticia, você chegou a testar a solução?
Se me lembro bem, a rotina captura as teclas mesmo fora do foco do form.

[LeticiaVale]

Não testei direito ainda, estou tentando entender como funciona.

mas obrigada pela resposta

[Marcos Guedes]

havendo dificuldades na utilização, é só postar.

[LeticiaVale]

Teria como postar algum exemplo?