Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Graphic InKey/InStat

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Daniel Raymer
    replied
    Must click on window ?

    Nice code. It seems that you have to click on the window before typing. Can that be fixed, maybe with a Focus statement?

    Leave a comment:


  • Mark Hunter
    replied
    The above code works in 4.03 but not in 4.04. The following works in 4.04.
    Code:
    ' Purpose:   Create InKey and InStat functions for a graphic window.
    ' Compiler:  PBCC  4
    '
    ' The console has InKey$ and InStat functions for keyboard input.
    ' This demo program creates similar functions for a graphic window:
    ' InKey1 and InStat1.
    '
    ' Unlike InKey$, InKey1 is a keycode, and is always the uppercase version.
    argie program could be modified to reflect the appropriate case, but here
    ' we use another variable to tell the shift state.
    '
    ' The shift state is told by the variable "shiftstate."  If you hold either the
    ' Shift or CßO¸key down while pressing a character key more than once,
    ' both characters will be assigned the appropriate shift.  However when
    ' holding Alt down only the first character will be assigned Alt.
    
     #Dim All
     #Console Off                 'cannot use Print or WaitKey$
    '-----------------------------------------------------------------
    
     Macro False     = 0
     Macro True      = -1
     Macro Boolean   = Long
    '-----------------------------------------------------------------
    
     %esc   = 27
     %enter = 13
     %lowerA = 97 :%lowerZ = 122
    
     %none  = 0                  'arbitrary shiftstate values
     %alt   = 1
     %ctrl  = 2
     %shift = 3
    '-----------------------------------------------------------------
    
     'From WinAPI
     %WM_KEYDOWN    = &H100
     %WM_KEYUP      = &H101
     %WM_SYSKEYDOWN = &H104
     %WM_SYSKEYUP   = &H105
     %VK_MENU       = &H12        'alt key
     %WM_SYSCOMMAND = &H112
     %SC_KEYMENU    = &HF100&
     %SC_CLOSE      = &HF060&
     %SC_MINIMIZE   = &HF020&
     %VK_SHIFT      = &H10
     %VK_CONTROL    = &H11
     %GWL_WNDPROC   = -4
     %GW_CHILD      = 5
    
     Type KeyState
      repeatcount As Bit*16 In Dword
      scancode    As Bit*8
      extendkey   As Bit*1      '1 if right Alt or Ctrl
      reserve1    As Bit*4
      context     As Bit*1      '1 if Alt down when key pressed
      previous    As Bit*1      '1 if down, 0 if up
      transstate  As Bit*1      'always 0
     End Type
    
     Union Syskey
      value As Dword
      KeyState
     End Union
    
    
     Declare Function GetWindow      Lib "USER32.DLL" Alias "GetWindow" (ByVal Wnd As Dword, ByVal wCmd As Dword) As Long
     Declare Function CallWindowProc Lib "USER32.DLL" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Dword, ByVal Wnd As Dword, ByVal uMsg As Dword, ByVal param As Dword, ByVal mousepos As Long) As Long
     Declare Function SetWindowLong  Lib "USER32.DLL" Alias "SetWindowLongA" (ByVal Wnd As Dword, ByVal nIndex As Long, ByVal lNewLong As Long) As Long
    '-----------------------------------------------------------------
    
     Declare Function GWnew_k(ByVal Dword, ByVal Dword, ByVal Dword, ByVal Long) As Long
     Declare Function UpperCase(ByVal Long) As Long
     Declare Function InStat1 As Long
     Declare Function InKey1 As Long
     Declare Sub StuffKey(ByVal Long, ByVal Long)
    ' Declare Sub ClearKey
    ' Declare Function NextKey As Long
     Declare Sub GetKey
    '-----------------------------------------------------------------
    
     Global GW, GW1, GWold1, GWold1k As Dword   'handles
     Global win1 As Dword        'handle for window
     Global ky As Long           'keycode
     Global shiftstate As Long   'Alt, Ctrl, Shift
     Global keybuff() As Long    'keycode buffer
     Global shiftbuff() As Long  'shiftstate buffer
     Global nkey As Long         'number of keys in keycode buffer
    '-----------------------------------------------------------------
    
     Sub Stuffkey(ByVal ky As Long, ByVal shiftstate As Long)
      keybuff(nkey) = ky
      shiftbuff(nkey) = shiftstate
      Incr nkey
     End Sub
    
     Function InStat1 As Boolean
      Function = (nkey <> 0)
     End Function
    
     Function InKey1 As Long
      If nkey Then
       Decr nkey
       Function = keybuff(nkey)
       shiftstate = shiftbuff(nkey)
      End If
     End Function
    
    ' Sub ClearKey
    '  nkey = 0
    ' End Sub
    
    ' Function NextKey As Long          'look at key without removing
    '  If nkey Then
    '   Function = keybuff(nkey-1)
    '  End If
    ' End Function
    
     Sub GetKey
      Dim count As Long                     'sleep 0 once every five iterations
      Do Until InStat1
       Incr count
       If count = 5 Then
        count = 0
        Sleep 0
       End If
      Loop
      ky = InKey1
     End Sub
    '-----------------------------------------------------------------
    
     Function UpperCase(ByVal k As Long) As Long  'ky any key upper or lowercase
      If %lowerA <= k And k <= %lowerZ Then       'lowercase letter
       Function = k - 32
      Else
       Function = k
      End If
     End Function
    '-----------------------------------------------------------------
    
     Function GWnew_k (ByVal Wnd As Dword, ByVal Msg As Dword, ByVal Param As Long, ByVal OtherParam As Long) As Long
       'assume no more than one shift key at a time
       Dim ks As Syskey
    
       Select Case Long Msg
       Case %WM_KEYUP
        If Param = %VK_SHIFT Or Param = %VK_CONTROL Then  'shift or ctrl key up
         shiftstate = %none
        End If
       Case %WM_KEYDOWN
        If     Param = %VK_SHIFT Then           'shift key down
         shiftstate = %shift
        ElseIf Param = %VK_CONTROL Then         'ctrl key down
         shiftstate = %ctrl
        Else
         Stuffkey Param,shiftstate              'always uppercase
         shiftstate = %none
        End If
       Case %WM_SYSCOMMAND
        If     (Param And &HFFF0) = %SC_CLOSE Then
         Stuffkey %esc,%none
         Exit Function
        ElseIf Param = %SC_KEYMENU And OtherParam <> 0 Then
         Stuffkey UpperCase(OtherParam),shiftstate
         shiftstate = %none
        End If
       Case %WM_SYSKEYDOWN
        If Param = %VK_MENU Then
         ks.Value = OtherParam
         'Alt pressed, it generates WM_SYSCOMMAND. Change the state.
         '(Trick due to Richard Angell.)
         ks.previous = 1 - ks.previous
         OtherParam = ks.Value
         shiftstate = %alt
        End If
       Case %WM_SYSKEYUP
        shiftstate = %none
       End Select
    
       Function = CallWindowProc(GWold1k, Wnd, Msg, param, OtherParam)
     End Function
    '-----------------------------------------------------------------
    
     Function PBMain
      Dim keybuff(10)
      Dim shiftbuff(10)
    
      Graphic Window "", 0,0, 800,400 To win1    'create graphic window
      Graphic Attach win1,0, ReDraw
    
      GW   = GetWindow(win1, %GW_CHILD)          'subclass
      GWold1k = SetWindowLong(GW, %GWL_WNDPROC, CodePtr(GWnew_k))
    
      Graphic Font "Times New Roman", 12, 0
      Graphic Print "Type some letters or numbers. They'll appear below,  preceeded by  *, ^, or ~  if you press  Alt, Ctrl, or Shift."
      Graphic Print "Press Esc to quit."
      Graphic Print
      Graphic ReDraw
      Graphic Font "Times New Roman", 12, 1
    
      shiftstate = %none
    
      Do
       Getkey
       If ky = %esc Then Exit Loop
       If ky = %enter Then                      'new line
        Graphic Print
       Else
        Select Case shiftstate
        Case %none
        Case %alt   :Graphic Print "*";
        Case %ctrl  :Graphic Print "^";
        Case %shift :Graphic Print "~";
        End Select
        Graphic Print Chr$(ky);
       End If
       Graphic ReDraw
      Loop
    
     End Function

    Leave a comment:


  • Mark Hunter
    started a topic Graphic InKey/InStat

    Graphic InKey/InStat

    Code:
    ' Purpose:   Create InKey and InStat functions for a graphic window.
    ' Compiler:  PBCC  4
    '
    ' The console has InKey$ and InStat functions for keyboard input.
    ' This demo program creates similar functions for a graphic window:
    ' InKey1 and InStat1.
    '
    ' Unlike InKey$, InKey1 is a keycode, and is always the uppercase version.
    ' The program could be modified to reflect the appropriate case, but here 
    ' we use another variable to tell the shift state.
    '
    ' The shift state is told by the variable "shiftstate."  If you hold either the
    ' Shift or CßO¸key down while pressing a character key more than once,
    ' both characters will be assigned the appropriate shift.  However when
    ' holding Alt down only the first character will be assigned Alt.
    
     #Dim All
     #Console Off                 'cannot use Print or WaitKey$
    '-----------------------------------------------------------------
    
     Macro False     = 0
     Macro True      = -1
     Macro Boolean   = Long
    '-----------------------------------------------------------------
    
     %esc   = 27
     %enter = 13
     %lowerA = 97 :%lowerZ = 122
    
     %none  = 0                  'arbitrary shiftstate values
     %alt   = 1
     %ctrl  = 2
     %shift = 3
    '-----------------------------------------------------------------
    
     'From WinAPI
     %WM_KEYDOWN    = &H100
     %WM_KEYUP      = &H101
     %WM_SYSKEYDOWN = &H104
     %WM_SYSKEYUP   = &H105
     %VK_MENU       = &H12        'alt key
     %WM_SYSCOMMAND = &H112
     %SC_KEYMENU    = &HF100&
     %SC_CLOSE      = &HF060&
     %SC_MINIMIZE   = &HF020&
     %VK_SHIFT      = &H10
     %VK_CONTROL    = &H11
     %GWL_WNDPROC   = -4
    
     Type KeyState
      repeatcount As Bit*16 In Dword
      scancode    As Bit*8
      extendkey   As Bit*1      '1 if right Alt or Ctrl
      reserve1    As Bit*4
      context     As Bit*1      '1 if Alt down when key pressed
      previous    As Bit*1      '1 if down, 0 if up
      transstate  As Bit*1      'always 0
     End Type
    
     Union Syskey
      value As Dword
      KeyState
     End Union
     
     Declare Function CallWindowProc Lib "USER32.DLL" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Dword, ByVal Wnd As Dword, ByVal uMsg As Dword, ByVal param As Dword, ByVal mousepos As Long) As Long
     Declare Function SetWindowLong  Lib "USER32.DLL" Alias "SetWindowLongA" (ByVal Wnd As Dword, ByVal nIndex As Long, ByVal lNewLong As Long) As Long
    '-----------------------------------------------------------------
    
     Declare Function GWnew_k(ByVal Dword, ByVal Dword, ByVal Dword, ByVal Long) As Long
     Declare Function UpperCase(ByVal Long) As Long
     Declare Function InStat1 As Long
     Declare Function InKey1 As Long
     Declare Sub StuffKey(ByVal Long, ByVal Long)
    ' Declare Sub ClearKey
    ' Declare Function NextKey As Long
     Declare Sub GetKey
    '-----------------------------------------------------------------
    
     Global GW1, GWold1, GWold1k As Dword   'handles
     Global win1 As Dword        'handle for window
     Global ky As Long           'keycode
     Global shiftstate As Long   'Alt, Ctrl, Shift
     Global keybuff() As Long    'keycode buffer
     Global shiftbuff() As Long  'shiftstate buffer
     Global nkey As Long         'number of keys in keycode buffer
    '-----------------------------------------------------------------
    
     Sub Stuffkey(ByVal ky As Long, ByVal shiftstate As Long)
      keybuff(nkey) = ky
      shiftbuff(nkey) = shiftstate
      Incr nkey
     End Sub
    
     Function InStat1 As Boolean
      Function = (nkey <> 0)
     End Function
    
     Function InKey1 As Long
      If nkey Then
       Decr nkey
       Function = keybuff(nkey)
       shiftstate = shiftbuff(nkey)
      End If
     End Function
    
    ' Sub ClearKey
    '  nkey = 0
    ' End Sub
    
    ' Function NextKey As Long          'look at key without removing
    '  If nkey Then
    '   Function = keybuff(nkey-1)
    '  End If
    ' End Function
    
     Sub GetKey
      Dim count As Long                     'sleep 0 once every five iterations
      Do Until InStat1
       Incr count
       If count = 5 Then
        count = 0
        Sleep 0
       End If
      Loop
      ky = InKey1
     End Sub
    '-----------------------------------------------------------------
    
     Function UpperCase(ByVal k As Long) As Long  'ky any key upper or lowercase
      If %lowerA <= k And k <= %lowerZ Then       'lowercase letter
       Function = k - 32
      Else
       Function = k
      End If
     End Function
    '-----------------------------------------------------------------
    
     Function GWnew_k (ByVal Wnd As Dword, ByVal Msg As Dword, ByVal Param As Long, ByVal OtherParam As Long) As Long
       'assume no more than one shift key at a time
       Dim ks As Syskey
       
       Select Case Long Msg
       Case %WM_KEYUP
        If Param = %VK_SHIFT Or Param = %VK_CONTROL Then  'shift or ctrl key up
         shiftstate = %none
        End If
       Case %WM_KEYDOWN
        If     Param = %VK_SHIFT Then           'shift key down
         shiftstate = %shift
        ElseIf Param = %VK_CONTROL Then         'ctrl key down
         shiftstate = %ctrl
        Else
         Stuffkey Param,shiftstate              'always uppercase
         shiftstate = %none
        End If
       Case %WM_SYSCOMMAND
        If     (Param And &HFFF0) = %SC_CLOSE Then
         Stuffkey %esc,%none
         Exit Function
        ElseIf Param = %SC_KEYMENU And OtherParam <> 0 Then
         Stuffkey UpperCase(OtherParam),shiftstate
         shiftstate = %none
        End If
       Case %WM_SYSKEYDOWN
        If Param = %VK_MENU Then
         ks.Value = OtherParam
         'Alt pressed, it generates WM_SYSCOMMAND. Change the state.
         '(Trick due to Richard Angell.)
         ks.previous = 1 - ks.previous
         OtherParam = ks.Value
         shiftstate = %alt
        End If
       Case %WM_SYSKEYUP
        shiftstate = %none
       End Select
    
       Function = CallWindowProc(GWold1k, Wnd, Msg, param, OtherParam)
     End Function
    '-----------------------------------------------------------------
    
     Function PBMain
      Dim keybuff(10)
      Dim shiftbuff(10)
    
      Graphic Window "", 0,0, 800,400 To win1    'create graphic window
      Graphic Attach win1,0, ReDraw
    
      GWold1k = SetWindowLong(win1, %GWL_WNDPROC, CodePtr(GWnew_k))
    
      Graphic Font "Times New Roman", 12, 0
      Graphic Print "Type some letters or numbers. They'll appear below,  preceeded by  *, ^, or ~  if you press  Alt, Ctrl, or Shift."
      Graphic Print "Press Esc to quit."
      Graphic Print
      Graphic ReDraw
      Graphic Font "Times New Roman", 12, 1
    
      shiftstate = %none
    
      Do
       Getkey
       If ky = %esc Then Exit Loop
       If ky = %enter Then                      'new line
        Graphic Print
       Else
        Select Case shiftstate
        Case %none
        Case %alt   :Graphic Print "*";
        Case %ctrl  :Graphic Print "^";
        Case %shift :Graphic Print "~";
        End Select
        Graphic Print Chr$(ky);
       End If
       Graphic ReDraw
      Loop
    
     End Function
    Last edited by Mark Hunter; 12 Oct 2007, 11:02 PM.
Working...
X