Announcement

Collapse
No announcement yet.

GetKeyboardState

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    GetKeyboardState

    This code generates a "This program has performed an illegal function and will be shut down" message.

    What is illegal about the function? If the first MsgBox is made active, it shows up, but the "illegal function" message comes up before the second MsgBox. Info obtained from Win32.Hlp.

    CallBack Function TestKeyPress
    Dim Acd(0 To 255) As Byte
    Local Cid As Byte
    %A = 65
    If CbMsg=%WM_INITDIALOG Then Exit Function
    If CbCtl=14 Then
    GetKeyboardState(Acd(0))
    'MsgBox("So far ...")
    Cid=Acd(%A)
    'MsgBox(Str$(%A))
    Control Set Text qDlg&, 14, "Key pressed"
    End If
    End Function
    Tags: None
  • #2
    Dieny...

    When you are calling a function and not wanting a return value,
    you omit the parentheses. If wanting a return then you must use
    them.

    Code:
        GetKeyboardState Acd(0)
    MsgBox "So far ..."
    Cid=Acd(%A)
    MsgBox Str$(%A)

    ------------------
    Jim..
    [email protected]
    Jim..

    Comment

    • #3
      Jim, thanks for that feedback. A stupid error on my part (even I actually knew that) - but it still doesn't do the thing. I've modified it a per below.

      For a keyboard-intensive screen (a letter) which has fixed (unmodifiable) areas, others which may be modified subject to given restrictions, and some which may be edited freely, it is a nuisance to have to click the mouse in order to access different areas (refer Lance's website). Much rather use the keyboard's cursor keys, where LEFT and RIGHT arrows, HOME and END operate within a textbox, and PgUp/PgDn and UP and DOWN arrows access different textboxes or areas of the scrolling screen.

      Example code.

      Intended purpose: keyboard trap - testing only one textbox (id&=14) on one dialog (qDlg&). It is the callback function for textbox 14.

      Effect achieved: hangs the system, thereafter needing reboot on account of "destination file write error".

      It is interesting that %WM_KEYFIRST occurs NOWHERE on my C: drive other than in WinAPI32.inc, Ddt.inc and of course as per below.

      Is there anywhere an example of keyboard trapping? If there was a SEARCH (for keyword) facility on this (and the other) forums, it would be very useful.

      CallBack Function TestKeyPress
      Local Msg As tagMSG
      'Type tagMSG
      ' hwnd As Dword
      ' message As Dword
      ' wParam As Dword
      ' lParam As Dword
      ' time As Dword
      ' pt As POINTAPI
      'End Type
      ' If CbMsg=%WM_INITDIALOG Then Exit Function
      ' If CbMsg<>%WM_COMMAND Then Exit Function
      Msg.hwnd=qDlg&
      If IsTrue GetMessage(Msg, %NULL, %WM_KEYFIRST, %WM_KEYLAST) Then
      If CbCtl=14 Then
      Msg.hwnd=qDlg&
      n&=GetMessage (Msg, qDlg&, 0, 0)
      Select Case n&
      Case %WM_KEYDOWN
      m&=GetMessage(Msg, qDlg&, 0, 0)
      Select Case m&
      Case %VK_LEFT
      MsgBox("Left-arrow")
      'other CASEs here
      End Select
      End Select
      ' Else
      ' TranslateMessage Msg
      ' DispatchMessage Msg
      End If
      End If
      'MsgBox("So far ...")
      End Function


      ------------------

      Comment

      • #4
        If there was a SEARCH (for keyword) facility on this (and the other) forums, it would be very useful.
        There is... look up in the top right hand corner of the BBS index page, or forum index page, or thread "view" page... or see http://www.powerbasic.com/support/fo...i?action=intro


        ------------------
        Lance
        PowerBASIC Support
        mailto:[email protected][email protected]</A>
        Lance
        mailto:[email protected]

        Comment

        • #5
          Lance, thanks. That ole SEARCH button, I'm SURE it wasn't there yesterday ... this is the second time in 24 hours that I am caught out as being blind as a mole. Or maybe it is incipient senility.

          With the aid of this search option I found an item posted by Charles Dietz on 4th September 1999 which simplifies the whole thing totally, it seems. HE was looking for a solution to the same problem, and several members came to his aid. Superb forum, nice people.

          However, whilst his sample code works, this doesn't.

          This is the final part of the callback function of a radio button, and it sets up a number of textboxes. In the SELECT CASE LCD& structure, the CASE ELSE does a SETWINDOWLONG -- and that makes those text boxes either invisible or non-existent.
          Without the SETWINDOWLONG they appear as expected.
          -----------------------------------------------------------------
          ... ...
          r$=LetterLine("QuoteReference")
          QrfLno&=Val(LetterLine("QrefLineNo"))
          QutRef$=Right$(r$,Len(r$)-4)

          ReDim EditProc&(QlLines&), eID&(QlLines&)

          CurPos&=8

          For i&=7 To QLlines&
          CurPos&=CurPos&+10
          If i&=QrfLno& Then
          uFont&=MakeFont("Times New Roman", 10)
          GetObject uFont&, SizeOf(uf), ByVal VarPtr(uf)
          uf.lfWeight=%FW_MEDIUM
          uf.lfUnderline = 1
          uFont&=CreateFontIndirect(uf)
          Control Add TextBox, qDlg&, i&, QutRef$, 30, CurPos&, 360, 10, %SS_Center Or %BF_FLAT
          Control Send qDlg&, i&, %WM_SETFONT, uFont&, 1
          Else
          r$=FetchQletterLine (i&)
          Lcd&=Val(Left$(r$,3))
          r$=Right$(r$,Len(r$)-3)

          Select Case Lcd&

          Case 205
          DearWho&=i&
          Control Add Label, qDlg&, 9000+i&, "Dear", 30, CurPos&, 24, 10, %SS_LEFT
          Control Send qDlg&, 9000+i&, %WM_SETFONT, hFont, 1
          r$=Trim$(Mid$(Contacts$,ContactNo&+20,15))+","
          Control Add TextBox, qDlg&, i&, r$, 54, CurPos&, 336, 10, %SS_LEFT Or %BF_FLAT
          Control Send qDlg&, i&, %WM_SETFONT, hFont, 1

          Case 4 To 15
          If Instr(r$,":")>0 Then
          q$=Left$(r$,Instr(r$,":"))
          r$=Trim$(Right$(r$,Len(r$)-Len(q$)))
          Control Add Label, qDlg&, 9000+i&, q$, 30, CurPos&, 100, 10, %SS_LEFT
          Control Send qDlg&, 9000+i&, %WM_SETFONT, hFont, 1
          Control Add TextBox, qDlg&, i&, r$, 130, CurPos&, 236, 10, %SS_LEFT Or %BF_FLAT
          Control Send qDlg&, i&, %WM_SETFONT, hFont, 1
          End If

          Case 0, 210
          If Lcd&=0 Then
          If Mid$(r$,2,8)="Quantity" Or Mid$(r$,2,10)="Kwantiteit" Then r$=" " +Right$(r$,Len(r$)-1)
          End If
          Control Add Label, qDlg&, 9000+i&, r$, 30, CurPos&, 360, 10, %SS_LEFT Or %BF_FLAT 'CALL callbackfunction
          Control Send qDlg&, 9000+i&, %WM_SETFONT, hFont, 1

          Case Else
          Control Add TextBox, qDlg&, i&, r$, 30, CurPos&, 360, 10, %SS_LEFT Or %BF_FLAT
          Control Send qDlg&, i&, %WM_SETFONT, hFont, 1

          Control Handle qDlg&, i& To hEdit&
          ePr&=SetWindowLong (hEdit&, %GWL_WNDPROC, CodePtr(TestKeyPress&))
          eID&(i&)=i&
          EditProc&(i&)=ePr&

          'MsgBox(Str$(i&)+Str$(eID&(i&))+Str$(hEdit&)+Str$(ePr&)+Str$(EditProc&(i&)))
          End Select
          End If
          Next

          Control Add "scrollbar", qDlg, 1006, "", 392, 0, 9, 199, _
          %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %SBS_VERT

          hWndScrol = CreateWindow ("scrollbar",_ 'window class name
          ByVal %NULL,_ 'window caption
          %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %SBS_VERT,_ 'window style
          0, 0, 0, 0,_ 'initial y
          qDlg&,_ 'parent window handle
          %NULL,_ 'window menu handle
          hInst,_ 'program instance handle
          %NULL) 'creation parameter

          'Subclass the scroll bar

          fnOldScr = SetWindowLong(hWndScrol, %GWL_WNDPROC, CodePtr(EditLetter))

          'Set scrollbar range and position

          Call SetScrollRange (hWndScrol, %SB_CTL, 0, QLlines&, %FALSE)
          Call SetScrollPos (hWndScrol, %SB_CTL, 0, %FALSE)
          Dialog Show Modeless qDlg& Call EditLetter

          Dialog Send hDlg&, %WM_PAINT, %NULL, %NULL

          Call UpdateWindow (qDlg&)
          Control Set Focus qDlg&, 14
          End Function
          -----------------------------------------------------------------
          Function TestKeyPress& (ByVal h&, ByVal wMsg&, ByVal wParm&, ByVal lParm&)
          If wMsg&<>%WM_KEYUP And wMsg&<>%WM_DESTROY Then Exit Function
          If wParm&<>%VK_UP And _
          wParm&<>%VK_DOWN And _
          wParm&<>%VK_PGUP And _
          wParm&<>%VK_PGUP Then Exit Function
          EdID&=GetDlgCtrlID(lParm&)
          eId&=EditProc&(EdID&)
          Select Case wMsg&
          Case %WM_KEYUP
          Select Case wParm&
          Case %VK_RETURN
          MsgBox "trapped RETURN key"
          Case %VK_LEFT
          MsgBox "trapped LEFT ARROW key"
          Case %VK_TAB
          MsgBox "trapped TAB key"
          Case %VK_UP
          MsgBox "trapped UP-ARROW key"
          Case %VK_DOWN
          MsgBox "trapped DOWN-ARROW key"
          Case %VK_PGUP
          MsgBox "trapped PAGE-UP key"
          Case %VK_PGDN
          MsgBox "trapped PAGE-DOWN key"
          End Select
          Case %WM_DESTROY
          SetWindowLong h&, %GWL_WNDPROC, eId&
          End Select
          Function = callWindowProc(eId&, h&, wMsg&, wParm&, lParm&)
          End Function
          -----------------------------------------------------------------
          (But just imagine even that amount of code, just to replace a simple INKEY$ and very little else!! One might suppose that Mr. Gates & Co. don't use keyboards; type with the mouse, obviously.

          So far, anyway, thanks, Charles!

          Is there a special reason for DECLARING functions at the top which occur further down in the same EXE module? It does not seem to be essential, but quite a number of code snippets and samples do this.


          ------------------

          Comment

          • #6
            Lance, thanks. That ole SEARCH button, I'm SURE it wasn't there yesterday ... this is the second time in 24 hours that I am caught out as being blind as a mole. Or maybe it is incipient senility.

            With the aid of this search option I found an item posted by Charles Dietz on 4th September 1999 which simplifies the whole thing totally, it seems. HE was looking for a solution to the same problem, and several members came to his aid. Superb forum, nice people.

            However, whilst his sample code works, this doesn't.

            This is the final part of the callback function of a radio button, and it sets up a number of textboxes. In the SELECT CASE LCD& structure, the CASE ELSE does a SETWINDOWLONG -- and that makes those text boxes either invisible or non-existent.
            Without the SETWINDOWLONG they appear as expected.
            -----------------------------------------------------------------
            ... ...
            r$=LetterLine("QuoteReference")
            QrfLno&=Val(LetterLine("QrefLineNo"))
            QutRef$=Right$(r$,Len(r$)-4)

            ReDim EditProc&(QlLines&), eID&(QlLines&)

            CurPos&=8

            For i&=7 To QLlines&
            CurPos&=CurPos&+10
            If i&=QrfLno& Then
            uFont&=MakeFont("Times New Roman", 10)
            GetObject uFont&, SizeOf(uf), ByVal VarPtr(uf)
            uf.lfWeight=%FW_MEDIUM
            uf.lfUnderline = 1
            uFont&=CreateFontIndirect(uf)
            Control Add TextBox, qDlg&, i&, QutRef$, 30, CurPos&, 360, 10, %SS_Center Or %BF_FLAT
            Control Send qDlg&, i&, %WM_SETFONT, uFont&, 1
            Else
            r$=FetchQletterLine (i&)
            Lcd&=Val(Left$(r$,3))
            r$=Right$(r$,Len(r$)-3)

            Select Case Lcd&

            Case 205
            DearWho&=i&
            Control Add Label, qDlg&, 9000+i&, "Dear", 30, CurPos&, 24, 10, %SS_LEFT
            Control Send qDlg&, 9000+i&, %WM_SETFONT, hFont, 1
            r$=Trim$(Mid$(Contacts$,ContactNo&+20,15))+","
            Control Add TextBox, qDlg&, i&, r$, 54, CurPos&, 336, 10, %SS_LEFT Or %BF_FLAT
            Control Send qDlg&, i&, %WM_SETFONT, hFont, 1

            Case 4 To 15
            If Instr(r$,":")>0 Then
            q$=Left$(r$,Instr(r$,":"))
            r$=Trim$(Right$(r$,Len(r$)-Len(q$)))
            Control Add Label, qDlg&, 9000+i&, q$, 30, CurPos&, 100, 10, %SS_LEFT
            Control Send qDlg&, 9000+i&, %WM_SETFONT, hFont, 1
            Control Add TextBox, qDlg&, i&, r$, 130, CurPos&, 236, 10, %SS_LEFT Or %BF_FLAT
            Control Send qDlg&, i&, %WM_SETFONT, hFont, 1
            End If

            Case 0, 210
            If Lcd&=0 Then
            If Mid$(r$,2,8)="Quantity" Or Mid$(r$,2,10)="Kwantiteit" Then r$=" " +Right$(r$,Len(r$)-1)
            End If
            Control Add Label, qDlg&, 9000+i&, r$, 30, CurPos&, 360, 10, %SS_LEFT Or %BF_FLAT 'CALL callbackfunction
            Control Send qDlg&, 9000+i&, %WM_SETFONT, hFont, 1

            Case Else
            Control Add TextBox, qDlg&, i&, r$, 30, CurPos&, 360, 10, %SS_LEFT Or %BF_FLAT
            Control Send qDlg&, i&, %WM_SETFONT, hFont, 1

            Control Handle qDlg&, i& To hEdit&
            ePr&=SetWindowLong (hEdit&, %GWL_WNDPROC, CodePtr(TestKeyPress&))
            eID&(i&)=i&
            EditProc&(i&)=ePr&

            'MsgBox(Str$(i&)+Str$(eID&(i&))+Str$(hEdit&)+Str$(ePr&)+Str$(EditProc&(i&)))
            End Select
            End If
            Next

            Control Add "scrollbar", qDlg, 1006, "", 392, 0, 9, 199, _
            %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %SBS_VERT

            hWndScrol = CreateWindow ("scrollbar",_ 'window class name
            ByVal %NULL,_ 'window caption
            %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %SBS_VERT,_ 'window style
            0, 0, 0, 0,_ 'initial y
            qDlg&,_ 'parent window handle
            %NULL,_ 'window menu handle
            hInst,_ 'program instance handle
            %NULL) 'creation parameter

            'Subclass the scroll bar

            fnOldScr = SetWindowLong(hWndScrol, %GWL_WNDPROC, CodePtr(EditLetter))

            'Set scrollbar range and position

            Call SetScrollRange (hWndScrol, %SB_CTL, 0, QLlines&, %FALSE)
            Call SetScrollPos (hWndScrol, %SB_CTL, 0, %FALSE)
            Dialog Show Modeless qDlg& Call EditLetter

            Dialog Send hDlg&, %WM_PAINT, %NULL, %NULL

            Call UpdateWindow (qDlg&)
            Control Set Focus qDlg&, 14
            End Function
            -----------------------------------------------------------------
            Function TestKeyPress& (ByVal h&, ByVal wMsg&, ByVal wParm&, ByVal lParm&)
            If wMsg&<>%WM_KEYUP And wMsg&<>%WM_DESTROY Then Exit Function
            If wParm&<>%VK_UP And _
            wParm&<>%VK_DOWN And _
            wParm&<>%VK_PGUP And _
            wParm&<>%VK_PGUP Then Exit Function
            EdID&=GetDlgCtrlID(lParm&)
            eId&=EditProc&(EdID&)
            Select Case wMsg&
            Case %WM_KEYUP
            Select Case wParm&
            Case %VK_RETURN
            MsgBox "trapped RETURN key"
            Case %VK_LEFT
            MsgBox "trapped LEFT ARROW key"
            Case %VK_TAB
            MsgBox "trapped TAB key"
            Case %VK_UP
            MsgBox "trapped UP-ARROW key"
            Case %VK_DOWN
            MsgBox "trapped DOWN-ARROW key"
            Case %VK_PGUP
            MsgBox "trapped PAGE-UP key"
            Case %VK_PGDN
            MsgBox "trapped PAGE-DOWN key"
            End Select
            Case %WM_DESTROY
            SetWindowLong h&, %GWL_WNDPROC, eId&
            End Select
            Function = callWindowProc(eId&, h&, wMsg&, wParm&, lParm&)
            End Function
            -----------------------------------------------------------------
            (But just imagine even that amount of code, just to replace a simple INKEY$ and very little else!! One might suppose that Mr. Gates & Co. don't use keyboards; type with the mouse, obviously.

            So far, anyway, thanks, Charles!

            Is there a special reason for DECLARING functions at the top which occur further down in the same EXE module? It does not seem to be essential, but quite a number of code snippets and samples do this.


            ------------------

            Comment

            Previous template Next
            Working...
            X

            We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

            By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

            I Agree