#Compile Exe
#Register None
#Dim All
#Include "WIN32API.INC"
CallBack Function DlgProc
Dim x As Dword, y As Dword
Select Case CbMsg
Case %WM_INITDIALOG
joySetCapture CbHndl, %JOYSTICKID1, 0, %FALSE
Case %MM_JOY1BUTTONDOWN
' Crazy coordinate system 0 - 65535
If (CbWparam And %JOY_BUTTON1CHG) Then _
SetWindowText CbHndl, "1 Dn At x = " + Str$(LoWrd(CbLparam)) + _
" y = " + Str$(HiWrd(CbLparam))
If (CbWparam And %JOY_BUTTON2CHG) Then _
SetWindowText CbHndl, "2 Dn At x = " + Str$(LoWrd(CbLparam)) + _
" y = " + Str$(HiWrd(CbLparam))
Case %MM_JOY1BUTTONUP
If (CbWparam And %JOY_BUTTON1CHG) Then SetWindowText CbHndl, "1 Up"
If (CbWparam And %JOY_BUTTON2CHG) Then SetWindowText CbHndl, "2 Up"
Case %WM_DESTROY
joyReleaseCapture %JOYSTICKID1
End Select
End Function
Function PbMain
If IsFalse(joyGetNumDevs) Then MsgBox "No joysticks"
Local hDlg As Long, hDlg1 As Long
Dialog New 0, "Joystick",,, 200, 80, %WS_SYSMENU To hDlg
Dialog Show Modal hDlg Call DlgProc
End Function
Welcome to Windows... #DIM ALL
'needed to speed up time-critical code
DECLARE FUNCTION SetPriorityClass LIB "KERNEL32.DLL" ALIAS "SetPriorityClass" (BYVAL hprocess AS LONG, BYVAL dwPriorityClass AS LONG) AS LONG
DECLARE FUNCTION StickA(X AS LONG, Y AS LONG) AS LONG
DECLARE FUNCTION StickAButtonDown AS LONG
'for a timer w/ 1 millisec resolution
'EITHER declare Function timeGetTime OR #include Win32API.INC
DECLARE FUNCTION TIMEGETTIME LIB "winmm.dll" ALIAS "timeGetTime" () AS LONG
'''#INCLUDE "\pbcc\winapi\Win32API.INC"
DECLARE FUNCTION Timer2() AS SINGLE
'Demo
FUNCTION PBMAIN() AS LONG
DIM A AS STRING,LastA AS STRING, sp AS STRING, i AS STRING
DIM Start AS SINGLE, t AS SINGLE
DIM Mx AS SINGLE, My AS SINGLE
DIM Jx AS LONG, Jy AS LONG, L AS LONG, Button AS LONG
Sp$=SPACE$(4)
PRINT "Read JoystickA, mouse & keyboard"
PRINT "Press Esc to Quit"
PRINT
PRINT " Time stickX stickY Button MouseX MouseY keypress"
PRINT
CONSOLE SCREEN 26,70 'use an odd size to speed up printing
MOUSE 3, DOUBLE, MOVE, DOWN, UP
MOUSE ON
CURSOR OFF
Start=Timer2
DO
t=Timer2-Start
i$=INKEY$
Button=StickA(Jx,Jy)
Mx=MOUSEX
My=MOUSEY
A$=FORMAT$(t,"#####.### ")
A$=A$+STR$(Jx,5)+sp$+STR$(Jy,5)+sp$+STR$(Button,5)
A$=A$+sp$+STR$(Mx,5)+sp$+STR$(My,5)
L=LEN(i$)
SELECT CASE L
CASE 0: 'no keypress
CASE 1
A$=A$+sp$+i$+ " CHR$("+ FORMAT$(ASC(i$))+ ")"
CASE 2
A$=A$+sp$+"CHR$(0,"+ FORMAT$(ASC(i$, 2))+ ")"
CASE 4
A$=A$+sp$+"Mouse CHR$(255,255,"+ FORMAT$(ASC(i$, 3))+ ","+ FORMAT$(ASC(i$, 4))+ ")"
CASE ELSE
END SELECT
LOCATE 10,1
PRINT A$;SPACE$(30);
IF INSTR(A$,"CHR") >0 THEN
SLEEP 250 'pause to show full printout
END IF
IF i$ = CHR$(27) THEN
EXIT DO
END IF
LOOP
END FUNCTION
'Function StickA returns the Button status of joystick#1
'and also updates this joystick's x,y coordinates
'NOTE: The x,y values will vary with CPU speed
'and have no relation to the video screen settings,
'and some "noise" in the joystick readings is inevitable --
'so the readings should be scaled before being used
FUNCTION StickA(X AS LONG, Y AS LONG) AS LONG
DIM OK AS SINGLE, WindowHandle AS SINGLE
DIM xxx AS LONG, yyy AS LONG, check AS BYTE
OK=SetPriorityClass(WindowHandle!,&H00000100) 'set high priority
x=0: y=0: check=0
! mov dx, &H201 ;game port address
! out dx, al ;send an arbitrary value to game port
DO
! in al, dx
! mov check?,al
xxx=BIT(check?,0) 'check bit for X axis, stick A
yyy=BIT(check?,1) 'check bit for Y axis, stick A
x=x+xxx 'add 1 or 0, depending on bit status
y=y+yyy 'add 1 or 0, depending on bit status
LOOP UNTIL xxx=0 AND yyy=0
OK=SetPriorityClass(WindowHandle!,&H00000020) 'set normal priority
StickA=StickAButtonDown
END FUNCTION
FUNCTION StickAButtonDown AS LONG
DIM check AS BYTE
! mov dx, &H201 ;game port address
! in al, dx
! mov check?,al
IF BIT(check?,4) AND BIT(check?,5) THEN
StickAButtonDown=0 'neither button is down
ELSEIF BIT(check?,4)=0 AND BIT(check?,5)=0 THEN
StickAButtonDown=3 'both are down
ELSEIF BIT(check?,4)=0 THEN
StickAButtonDown=1 'only #1 is down
ELSEIF BIT(check?,5)=0 THEN
StickAButtonDown=2 'only #2 is down
END IF
END FUNCTION
'PB's TIMER is accurate to 54 millisec;
'this timer is presumably accurate to 1 millisec
FUNCTION Timer2() STATIC AS SINGLE
Timer2 = timeGetTime/1000 'call WINMM.DLL
END FUNCTION
'by E.W. Menzel, Jr.
'but all info is in the PUBLIC DOMAIN
#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
FUNCTION StickA (JS AS JOYINFO) AS LONG
LOCAL joystickID1 AS LONG
joystickID1=0 'make that 1 for StickB, I presume
'This info was cribbed from a post on Steinsoft.net
'MMRESULT joyGetPos(UINT uJoyID, LPJOYINFO pji) 'the only win api function we need
'uJoyId is the joystick you want to get info about: JOYSTICKID1 - or JOYSTICKID2
' pji is a a pointer to a JOYINFO structure where the joystick's state will be saved to.
'wXpos holds the X-Position of the joystick (from left to right)
'wYpos the Y-Position (from top to bottom)
'wZpos the position of the third axis most often the throttle.
'These positions range from 0 to 65536 with 32768 being the center.
'wButtons
'These can be: JOY_BUTTON1, JOY_BUTTON_2, JOY_BUTTON_3 and JOY_BUTTON_4.
'joyGetPos(..) returns JOYERR_NOERROR if no error has occured.
FUNCTION= joyGetPos(JOYSTICKID1,JS) 'win api
END FUNCTION
FUNCTION PBMAIN()
DIM JS AS JOYINFO 'as defined in win api
DIM A AS STRING
LOCATE 22,1
PRINT "Testing Joystick 1"
DO WHILE StickA(JS) = 0 AND INSTAT =0
LOCATE 23,1
A$= "x= "+FORMAT$(JS.wXpos)+" y= "+FORMAT$(JS.wYpos)
A$=A$ + " z= "+FORMAT$(JS.wZpos)+" Button= "+ FORMAT$(JS.wButtons)
PRINT A$
SLEEP 30
LOOP
PRINT "done"
IF INKEY$="" THEN PRINT "Error. Check Windows Control Panel/game controllers"
WAITKEY$
END FUNCTION
Comment