I just wanted to confirm, since version 9 does not show inkey$
to get, trap, use key strokes in a program you must use winapi?
thanks
to get, trap, use key strokes in a program you must use winapi?
thanks
#DIM ALL #INCLUDE "WIN32API.INC" FUNCTION PBMAIN() LOCAL hGWnd AS DWORD LOCAL sKey, sTemp AS STRING LOCAL Clk, x, y AS LONG GRAPHIC WINDOW "Graphic Window", 50, 50, 300, 300 TO hGWnd GRAPHIC ATTACH hGWnd, 0 WHILE ISWIN(hGWnd) GRAPHIC INKEY$ TO sKey ' Capture arrow keys etc SELECT CASE LEN(sKey) CASE 0 ' No keys pressed DIALOG DOEVENTS CASE 1 ' ASCII Key pressed DIALOG SET TEXT hGWnd, " " + sKey + Str$(ASC(sKey)) IF ASC(sKey) >1 AND ASC(sKey) <31 THEN DIALOG SET TEXT hGWnd, " " + "Control Code" + STR$(ASC(sKey)) IF sKey = $ESC THEN ' Quit on Escape DIALOG SET TEXT hGWnd, "Escape key pressed - Bye!" : SLEEP 2000 EXIT LOOP END IF CASE 2 ' Extended key pressed - * NB not number pad * SELECT CASE ASC(RIGHT$(sKey,1)) CASE 69 : sTemp = "NumLock" CASE 71 : sTemp = "Home" ' * CASE 72 : sTemp = "Up Arrow" CASE 73 : sTemp = "Page up" ' * CASE 75 : sTemp = "Left arrow" CASE 77 : sTemp = "Right arrow" CASE 79 : sTemp = "End" ' * CASE 80 : sTemp = "Down arrow" CASE 81 : sTemp = "Page down" ' * CASE 82 : sTemp = "Insert" CASE 83 : sTemp = "Delete" CASE ELSE : sTemp = "Etc.." END SELECT DIALOG SET TEXT hGWnd, " " + STR$(ASC(RIGHT$(sKey,1))) + " " + sTemp : sTemp = "" END SELECT ' As we're looping anyway let's test for clicks.. GRAPHIC WINDOW CLICK hGWnd TO Clk&, x&, y& IF Clk = 2 THEN WinBeep 800,1 ' double click ELSEIF Clk = 1 THEN GRAPHIC SET POS (0, 0) : GRAPHIC PRINT " " ' clear old pos info GRAPHIC SET POS (0, 0) GRAPHIC PRINT " x:"+STR$(x)+", y:"+STR$(y) ' click position in GfxWindow END IF WEND END FUNCTION '------------------/
'================= tstgrph.bas PBWin 9.01 by Alex Trenty #DIM ALL #COMPILE EXE #INCLUDE "WIN32API.INC" GLOBAL AWin AS DWORD ' Graphic Window Handle $AppTitle = "Test graphics especially" $pFont1 = "Lucida Console" $pFont2 = "Arial" $pFont3 = "Courier New" $pFont4 = "Arial Black" $pFont5 = "Times new Roman" GLOBAL fZagl AS LONG GLOBAL fTxt1 AS LONG GLOBAL fZagB AS LONG GLOBAL fTime AS LONG %ID_OK = 100 %ID_S1 = 101 %ID_S2 = 102 %ID_S3 = 103 %ID_S4 = 104 %ID_S5 = 105 %ID_S6 = 106 %ID_GA = 200 %wW = 560& %wH = 540& %aR=10: %aD= 80: %aW=460: %aH=300 ' Graphic Window GLOBAL hDlg AS LONG GLOBAL hWnd AS LONG GLOBAL fDlgEnd AS LONG GLOBAL hThread AS LONG GLOBAL fThrClose AS LONG GLOBAL Result AS LONG GLOBAL hTimer AS LONG ' Handle íà åæåñåêóíäíûé òàéìåð GLOBAL fTimer AS LONG ' Timer Flag GLOBAL lTimer AS LONG ' Countdown from 2 to 0 GLOBAL wTimer AS LONG ' Flag=1 every 0,5s GLOBAL cDat1 AS STRING*10 ' as is GLOBAL cDat2 AS STRING*8 ' dd/mm-yy GLOBAL cDat3 AS STRING*19 ' dd/mm-yy = cc:mm:ss GLOBAL x,y AS SINGLE: GLOBAL fUnd AS LONG GLOBAL sI AS STRING GLOBAL fI AS LONG GLOBAL xM1, yM1, xM2, yM2 AS LONG GLOBAL s5 AS STRING GLOBAL hWin AS LONG GLOBAL xG,yG AS LONG GLOBAL hGraphic AS DWORD FUNCTION Timer_Event () AS LONG ' -------------- Issued every 0,5s fTimer=%TRUE: FUNCTION=0 END FUNCTION SUB CurTime() cDat1=DATE$: cDat2=MID$(cDat1,4,2)+"/"+MID$(cDat1,1,2)+"-"+MID$(cDat1,9,2) cDat3=cDat2+" - "+TIME$ END SUB '==================================================================== CALLBACK FUNCTION D_CB() AS LONG '-------------------------------------------------------------------- LOCAL pT AS POINTAPI SELECT CASE CB.MSG CASE %WM_DESTROY fDlgEnd=%TRUE CASE %WM_PARENTNOTIFY ' Detect L/R Click to Interest Place pT.x = LO(WORD,CB.LPARAM) pT.y = HI(WORD,CB.LPARAM) MapWindowPoints CB.HNDL, 0, pT, 1 IF LO(WORD,CB.WPARAM) = %WM_LButtonDown THEN s5=s5+"L": CONTROL SET TEXT hDlg,%ID_S5,s5 ELSEIF LO(WORD,CB.WPARAM) = %WM_RButtonDown THEN s5=s5+"R": CONTROL SET TEXT hDlg,%ID_S5,s5 END IF CASE %WM_LButtonUp s5=s5+"l": CONTROL SET TEXT hDlg,%ID_S5,s5 CASE %WM_RButtonUp s5=s5+"r": CONTROL SET TEXT hDlg,%ID_S5,s5 CASE %WM_COMMAND IF CB.CTLMSG=%BN_CLICKED AND CB.CTL=%ID_OK THEN fDlgEnd=%TRUE: EXIT SELECT IF CB.CTL=%ID_GA THEN GetCursorPos(pT): ScreenToClient(AWin,pT) CONTROL SET TEXT hDlg,%ID_S3,"!CB.MSG="+FORMAT$(CB.MSG,"0000")+ _ ", CB.CTLMSG="+STR$(CB.CTLMSG)+", x="+STR$(pT.x)+ _ ", y="+STR$(pT.y): EXIT SELECT END IF END SELECT END FUNCTION '============= Thread ==================================== FUNCTION eThread (BYVAL hDlg AS LONG) AS LONG LOCAL s AS STRING WHILE ISFALSE fThrClose ERRCLEAR IF wTimer>0 THEN wTimer=0: DECR lTimer CurTime: CONTROL SET TEXT hDlg,%ID_S4,CDat3 ' Date,Time every 0,5s IF lTimer<0 THEN CONTROL SET TEXT hDlg,%ID_S6,"": lTimer=2 fUnd=1-fUnd: IF fUnd=0 THEN s=" " ELSE s="_" GRAPHIC ATTACH hDlg,%ID_GA: GRAPHIC SET POS (x,y) GRAPHIC FONT $pFont3,10,0: GRAPHIC COLOR %BLACK GRAPHIC PRINT s; '<========================== Underscore END IF IF fI=2 THEN ' Output catched symbol IF LEN(sI)=1 AND ASC(sI,1)>31 THEN ' <-----------------Normal Chr GRAPHIC ATTACH hDlg,%ID_GA: GRAPHIC SET POS (x,y) GRAPHIC SET FONT fTxt1: GRAPHIC COLOR %BLUE GRAPHIC PRINT sI;: GRAPHIC GET POS TO x,y ELSEIF LEN(sI)=1 THEN ' <------------------ Control Chr [xx] GRAPHIC ATTACH hDlg,%ID_GA: GRAPHIC SET POS (x,y) GRAPHIC SET FONT fTxt1: GRAPHIC COLOR %RED GRAPHIC PRINT "["+LTRIM$(STR$(ASC(sI,1)))+"]"; IF ASC(sI,1)=13 THEN ' CR GRAPHIC PRINT: GRAPHIC GET POS TO x,y: GRAPHIC SET POS (12,y) GRAPHIC COLOR %BLACK: GRAPHIC SET FONT fTxt1: GRAPHIC PRINT ">"; END IF GRAPHIC GET POS TO x,y ELSE ' <----------------------- Special Characters - WHERE ARE ?? GRAPHIC ATTACH hDlg,%ID_GA: GRAPHIC SET POS (x,y) GRAPHIC SET FONT fTxt1: GRAPHIC COLOR %YELLOW GRAPHIC PRINT "{"+LTRIM$(STR$(ASC(sI,2)))+"}"; GRAPHIC GET POS TO x,y END IF: fI=0 END IF SLEEP 20 WEND: FUNCTION = %TRUE END FUNCTION ' ================================== FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInst AS DWORD, _ BYVAL pCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG #REGISTER NONE LOCAL v,pN,t,sT AS STRING, i AS DWORD, dW,dH,tR,tD AS LONG DESKTOP GET CLIENT TO dW, dH tR=(dW-%wW)/2: tD=(dH-%wH)/2 FONT NEW $pFont2,12,1,204,0 TO fZagl FONT NEW $pFont3,10,0,204,0 TO fTxt1 FONT NEW $pFont4,12,1,204,0 TO fZagB FONT NEW $pFont1,12,0,204,0 TO fTime DIALOG FONT DEFAULT $pFont2,10,0,204 '"Arial" DIALOG NEW PIXELS, 0,$AppTitle,tR,tD,%wW,%wH,%WS_POPUP OR %WS_VISIBLE _ ' OR %DS_SETFONT OR %WS_CLIPCHILDREN OR %WS_BORDER OR %WS_CAPTION _ OR %WS_SYSMENU OR %WS_DLGFRAME _ TO hDlg ' Create a dialog box ' ,%WS_EX_TOPMOST _ IF hDlg=0 THEN EXIT FUNCTION fDlgEnd=%FALSE CONTROL ADD LABEL,hDlg,%ID_S1,"G r a p h i c s T e s t",10,12,320,20,0 CONTROL SET FONT hDlg,%ID_S1,fZagB CONTROL ADD TEXTBOX, hDlg,%ID_S2,"", 10,40, 460,20,0 CONTROL SET FONT hDlg,%ID_S2,fTxt1 CONTROL ADD TEXTBOX, hDlg,%ID_S3,"", 10,400,460,20,0 CONTROL SET FONT hDlg,%ID_S3,fTxt1 CONTROL ADD TEXTBOX, hDlg,%ID_S4,"",350, 10,160,20,0 CONTROL SET COLOR hDlg,%ID_S4, -1,RGB(255,255,217) CONTROL SET FONT hDlg,%ID_S4,fTxt1 CONTROL ADD TEXTBOX, hDlg,%ID_S5,"", 10,430,460,20,0 CONTROL SET FONT hDlg,%ID_S5,fTxt1 CONTROL ADD TEXTBOX, hDlg,%ID_S6,"", 10,460,460,20,0 CONTROL SET FONT hDlg,%ID_S6,fTxt1 s5="#" CONTROL ADD BUTTON,hDlg,%ID_OK,"OK",%wW-50,%wH-50,40,40 CONTROL ADD GRAPHIC, hDlg, %ID_GA, "GA", %ar, %ad, %aW, %aH, _ %SS_NOTIFY OR %WS_CHILD OR %WS_VISIBLE OR %SS_OWNERDRAW OR _ %WS_BORDER DIALOG SHOW MODELESS hDlg, CALL D_CB AWin = GetDlgItem(hDlg, %ID_GA)' Store the handle to the graphics window GRAPHIC ATTACH hDlg, %ID_GA GRAPHIC PAINT (0,0),RGB( 85, 255, 255) GRAPHIC COLOR -1,RGB( 85, 255, 255) GRAPHIC GET LOC TO xG, yG CONTROL SET TEXT hDlg,%ID_S2,"Loc on the Screen: xG="+STR$(xG)+ _ ", yG="+STR$(yG)+", Hndl="+STR$(AWin) GRAPHIC SET POS (20,4): GRAPHIC COLOR %MAGENTA: GRAPHIC SET FONT fZagl GRAPHIC PRINT "Graphical Window"+STR$(%aW)+" x"+STR$(%aH) GRAPHIC SET POS (12,40): GRAPHIC COLOR %BLACK: GRAPHIC SET FONT fTxt1 GRAPHIC PRINT ">";: GRAPHIC GET POS TO x,y: GRAPHIC SET FOCUS GRAPHIC REDRAW THREAD CREATE eThread(hDlg) TO hThread hTimer = SetTimer(0,0,500,CODEPTR(Timer_Event)) lTimer=0: fThrClose=%FALSE: wTimer=0: fUnd=0: fI=0 DO ' Main cycle until fDialog is %TRUE IF ISTRUE fTimer THEN wTimer=1: fTimer=%FALSE IF fI=0 THEN ' Test for getting symbol GRAPHIC ATTACH hDlg,%ID_GA: GRAPHIC INKEY$ TO sI IF LEN(sI)>0 THEN fI=1 END IF IF fI=1 THEN CONTROL SET TEXT hDlg,%ID_S6,"LEN="+STR$(LEN(sI)): fI=2 END IF DIALOG DOEVENTS LOOP WHILE ISFALSE fDlgEnd KillTimer 0, hTimer ' Destroy the timer DO: THREAD CLOSE hThread TO Result: SLEEP 50: LOOP UNTIL ISTRUE Result DIALOG END hDlg END FUNCTION
[COLOR=slategray]SUB CurTime()[/COLOR] [COLOR=slategray] cDat1=DATE$: cDat2=MID$(cDat1,4,2)+"/"+MID$(cDat1,1,2)+"-"+MID$(cDat1,9,2)[/COLOR] [COLOR=slategray] cDat3=cDat2+" - "+TIME$[/COLOR] [COLOR=slategray]END SUB[/COLOR] '------------------/ CallBack Function TextBoxProc Select Case As Long CbMsg Case %WM_LButtonUp '* sub class to catch these s5=s5+"l": CONTROL SET TEXT hDlg,%ID_S5,s5 Case %WM_RButtonUp s5=s5+"r": CONTROL SET TEXT hDlg,%ID_S5,s5 '* Case %WM_SYSKEYUP ' Eat F10 (special key) If CbWparam = %VK_F10 Then Exit Function End If End Select Function = Callwindowproc(Getwindowlong(CbHndl, %GWL_USERDATA), CbHndl, CbMsg, CbWParam, CbLParam) End Function '------------------/ '==================================================================== CALLBACK FUNCTION D_CB() AS LONG '-------------------------------------------------------------------- LOCAL pT AS POINTAPI SELECT CASE CB.MSG Case %WM_INITDIALOG ' set up subclass proc & record old proc add in %ID_GA userdata. (TT Colin Schmidt) Setwindowlong Getdlgitem(CbHndl, %ID_GA), %GWL_USERDATA, _ SetWindowLong(GetDlgItem(CbHndl, %ID_GA), %GWL_WNDPROC, CodePtr(TextBoxProc)) [COLOR=slategray]CASE %WM_DESTROY[/COLOR] [COLOR=slategray] fDlgEnd=%TRUE[/COLOR]
IF fI=0 THEN ' Test for getting symbol GRAPHIC ATTACH hDlg,%ID_GA: GRAPHIC INKEY$ TO sI IF LEN(sI)>0 THEN fI=1 END IF
CONTROL SET FOCUS hDlg, %ID_GA
#Debug Display ON #COMPILE EXE #DIM ALL #REGISTER NONE #INCLUDE "WIN32API.INC" %ID_S1 = 101 %ID_S6 = 105 %ID_GA = 200 FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInst AS DWORD, _ BYVAL pCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG LOCAL hDlg AS DWORD LOCAL sI AS STRING LOCAL x, y, fI AS LONG DIALOG NEW PIXELS, 0,"Test graphics especially", , , 560, 540, %WS_POPUP OR %WS_VISIBLE _ ' OR %DS_SETFONT OR %WS_CLIPCHILDREN OR %WS_BORDER OR %WS_CAPTION _ OR %WS_SYSMENU OR %WS_DLGFRAME TO hDlg ' Create a dialog box IF hDlg=0 THEN EXIT FUNCTION CONTROL ADD LABEL,hDlg,%ID_S1,"G r a p h i c s T e s t",10,12,320,20,0 CONTROL ADD TEXTBOX, hDlg, %ID_S6, "", 10,430,460,20,0 CONTROL ADD GRAPHIC, hDlg, %ID_GA, "GA" ,22, 65, 460, 300, _ %SS_NOTIFY OR %WS_CHILD OR %WS_VISIBLE OR %SS_OWNERDRAW OR %WS_BORDER DIALOG SHOW MODELESS hDlg GRAPHIC ATTACH hDlg, %ID_GA GRAPHIC PAINT (0,0),RGB( 85, 255, 255) GRAPHIC SET POS (20,4): GRAPHIC COLOR %MAGENTA,RGB( 85, 255, 255) GRAPHIC PRINT "Graphic Control" GRAPHIC SET POS (12,40): GRAPHIC COLOR %BLACK,RGB( 85, 255, 255) GRAPHIC PRINT ">";: GRAPHIC GET POS TO x,y GRAPHIC SET FOCUS DO GRAPHIC INKEY$ TO sI DIALOG DOEVENTS IF LEN(sI)>0 THEN fI=1 : WinBeep 800,1 IF fI=1 THEN GRAPHIC PRINT IIF$(LEN(sI)=1, sI, RIGHT$(sI,1)); DIALOG DOEVENTS CONTROL SET TEXT hDlg, %ID_S6, "LEN="+STR$(LEN(sI)) : fI=0 DIALOG DOEVENTS : SLEEP 50 : CONTROL SET TEXT hDlg, %ID_S6, "" END IF DIALOG DOEVENTS LOOP WHILE ISWIN(hDlg) DIALOG END hDlg END FUNCTION '------------------/
'PBWIN 9.00 - WinApi 05/2008 - XP Pro SP3 #COMPILE EXE #DIM ALL #INCLUDE "WIN32API.INC" #INCLUDE "COMDLG32.INC" FUNCTION PBMAIN ERRCLEAR LOCAL hwin AS DWORD, s$ GRAPHIC WINDOW "Testing", 100, 200, 200, 100 TO hWin GRAPHIC ATTACH hWin, 0 g1: GRAPHIC INKEY$ TO s$ IF LEN(s$) = 0 THEN GOTO g1 'no key pressed IF LEN(s$)=1 AND ASC(s$)<32 THEN ? "ASC"+FORMAT$(ASC(s$)) ELSEIF LEN(s$)=1 THEN ? "String length=1 "+s$ END IF IF LEN(s$)=2 THEN ? "String length=2!"+$CRLF+ FORMAT$(ASC(LEFT$(s$,1))) +$CRLF+ _ "Extended key code"+ FORMAT$(ASC(RIGHT$(s$,1))) 'GRAPHIC WINDOW END IF UCASE$(s$)<>"Q" THEN GOTO g1 'dialog doevents ? "Inkey$ works" 'Never gets here GRAPHIC WINDOW END END FUNCTION 'Applikation beenden '
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.
Comment