GetKeyboardState

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.


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

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.


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

[Lance Edmonds]

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>

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


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

[Jim Huguley]

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.

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

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

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