Robert M. Ryan                 EXPANDING KEYBOARD BUFFEER     EXPANDING,KEYBOARD,BUFFER      02/29/92 (00:00)       TASM, MASM             562  18175    BUF160.ASM  	title   BUF160ã	page    58,132ã; History:1,1ã; Wed Oct 23 17:08:32 1991ã;ã; v1.6a, 2-29-92, Robert M. Ryanã; - Added CLI and STI in installation routine. (hgm)ã;ã; v1.6,  2-26-92, Robert M. Ryanã; - On conditional assembly of PRIVATESTACK, this program will create it'sã;   own stack.  This was implemented due to problems on some older PCs.ã; - Refine checking of segment boundries, based upon recommendation byã;   Harry McGavran (hgm@moki.lanl.gov)ã; - Added missing a LES before stuffing data into driver header. (also hgm)ã; - Eliminated unnecessary structures and generally cleaned up code.ã; - Changed name to BUF160, rather than BUF160_4, BUF160_5, etc.ã;ã; v1.5 10-23-91 Robert M. Ryanã; - using PUSHA and SHL AX,4 on conditional assembly for 286ã; - changed the default buffer status to have TRANSFER enabled, so thatã;   keys pressed during initialization are preserved.ã; - changed case of es and ds to be like the rest of the registersã; - added initialization of BX so Cmd_Init would workã; - slightly modified initialization messageã;ã; Rob Ryan, Brown Universityã; Robert_Ryan@brown.edu or 70324.227@CompuServe.Comã;ã; v1.4 09-26-88 Toad Hall Tweakã; - Donno WHY all the public mess.  Leaving it, tho.ã; - Donno why author commented out the buffer transfer code.ã;   I guess, since we're loading as a driver right at system startup,ã;   there shouldn't BE anything in the old keyboard buffer.ã;   Driver works fine with TRANSFER enabled (1), but donno what good itã;   does.  Therefore leaving the default (and compiled driver) OFF (0).ã; - Changed case: constants UPPERCASE, procedures mixed Upper_Lower,ã;   variables remain lowercase.  (Helps to keep my head straight.)ã; - Added some comments.ã; - Moved Force inline (since only called once)ã; - Using string commands in Transfer_Buffer (lodsw, stosw)ã; - Just below Transfer_Done, recoded to use AX when stuffing wordsã;   into variables (faster than old code using CX).ã;ã; David Kirschbaumã; Toad Hallã; kirsch@braggvax.ARPAã;ã; 09-21-87 09:31:17 v1.3, fix buf in Force().ã; 09-16-87 16:07:46 v1.2, added publicsã; 09-16-87 16:01:41 v1.1, comment out buffer transfer code with equateã;ã; DJ Delorieã;ã;ã; To compile:ã;ã;   MICROSOFT ASSEMBLER         TURBO ASSEMBLERã;   -------------------         ---------------ã;   masm BUF160;                tasm BUF160ã;   link BUF160;                tlink BUF160ã;   exe2bin BUF160.exe BUF160.sys       exe2bin BUF160.exe BUF160.sysã;ã; To install, insert the following line in your config.sys:ã;ã;   DEVICE=<path>BUF160.SYSã;ã; where "<path>" is the path of the directory containing the device driverã; (e.g., C:\BIN\).ããã;*****************************************************************************ã; Compilation flagsã;*****************************************************************************ããTRANSFER    equ 1   ;Enables keyboard buffer transfer   v1.4ã				;  procedure if enabled (1)     v1.4ãUSE286      equ 0   ;Should we use 286 (and later)      v1.5ã				;  CPU specific instructions?       v1.5ãPRIVATESTACK    equ 1   ;Use own stack?             v1.6ããPROGNAME    equ 'BUF160'ãVERSION     equ 'v1.6a, 29 January 1992'ãã;*****************************************************************************ã; General equatesã;*****************************************************************************ããBUFSIZE equ 160     ;What is the size of the keyboard bufferãSTACKSZ equ 100h        ;What is the size of the private bufferãSUCCESS equ 0100hãERROR   equ 8100hãBUSY    equ 0300hãCR  equ 13      ;Carriage ReturnãLF  equ 10      ;Line FeedãTERM    equ '$'     ;DOS printing terminator characterãã;*****************************************************************************ã; Data structuresã;*****************************************************************************ããdqq strucãofs dw  ?ãsegw    dw  ?       ;changed from 'seg' to keep MASM 5.0 happy v1.4ãdqq endsããrqq struc           ;Request header structureãlen db  ?       ;length of request block (bytes)ãunit    db  ?       ;unit #ãcode    db  ?       ;driver command codeãstatus  dw  ?       ;status returnãq1  dd  ?       ;8 reserved bytesãq2  dd  ?ãmdesc   db  ?       ;donnoãtrans   dd  ?ãcount   dw  ?ãrqq endsãã;*****************************************************************************ã; Pointers to BIOS data segment, v1.4ã;*****************************************************************************ããBIOS_DATA_SEG   equ 40H     ;MASM had prob using BIOS_DATA in calculations,ã				;   so this typeless constant introduced.  v1.6ããBIOS_DATA   SEGMENT AT BIOS_DATA_SEGã	org 1AHãBUFFER_GET  dw  ?   ;org    1ahãBUFFER_PUT  dw  ?   ;org    1chã	org 80HãBUFFER_START    dw  ?   ;org    80hãBUFFER_END  dw  ?   ;org    82hãBIOS_DATA   ENDSããã;*****************************************************************************ã; The actual programã;*****************************************************************************ããCseg    segment byteã	assume  cs:Cseg,ds:Cseg,es:Cseg,ss:Csegã	org 0           ; no offset, it's a .SYS fileãstart   equ $           ; define start=CS:0000ããIF USE286               ;               v1.5ã	.286ã	%OUT Compiling 286 code ...ãELSEã	%OUT Compiling generic 8086 code ...ãENDIFãIF PRIVATESTACKã	%OUT Using private stack ...ãELSEã	%OUT Not using private stack ...ãENDIFãIF TRANSFERã	%OUT Including keyboard transfer code ...ãELSEã	%OUT Not including keyboard transfer code ...ãENDIFãã	public  headerãheader  label   nearã	dd  -1          ;pointer to next deviceã	dw  8000h           ;type deviceã	dw  Strat           ;strategy entry pointã	dw  Intr            ;interrupt entry pointã	db  'KBUFFER '      ;device nameãã	public  reqãreq dd  ?           ;store request header vector hereãã	public  queue_start,queue_endãqueue_start dw  BUFSIZE dup (0)     ;our expanded keyboard bufferãqueue_end   equ $ - start       ;calculate offset as typeless constantããIF PRIVATESTACK             ;               v1.6ããstack_end   db   STACKSZ dup (0)    ;use our own private data stackãstack_start equ  $ãoldss   dw  0ãoldsp   dw  0ãoldax   dw  0ããENDIFãã;*****************************************************************************ã; Strategy procedureã;   Save the pointer to the request header for Intr in the req area.ã;   Enters with pointer in es:bxã;*****************************************************************************ãã	public  StratãStrat   proc    farã	mov cs:[req].ofs,bxã	mov cs:[req].segw,es    ;               v1.4ã	retãStrat   endpãã;*****************************************************************************ã; The main interrupt (driver)ã;   This is the actual driver.  Processes the command contained in theã;   request header.  (Remember, req points to the request header.)ã;*****************************************************************************ãã	public  Intrã	ASSUME  ds:Cseg, es:NOTHING ;               v1.4ãIntr    proc    farããIF PRIVATESTACK             ;If using private stack, processã	mov cs:oldax, ax        ;               v1.6ã	cli             ; turn ints offã	mov ax, ssã	mov cs:oldss, axã	mov cs:oldsp, spã	mov sp, offset stack_startã	mov ax, csã	mov ss, axã	sti             ; turn ints back onã	mov ax, cs:oldaxãENDIFãã	push    ds          ;save everything in sightã	push    esãIF USE286ã	pusha               ;               v1.5ãELSEã	push    axã	push    bxã	push    cxã	push    dxã	push    diã	push    siãENDIFãã	mov ax,csã	mov ds,ax           ;DS=code segmentãã	les bx,req          ;point to request hdr       v1.4aã	mov si,offset cmd_table ;our function tableã	mov cl,es:[bx].code     ;get commandã	xor ch,ch           ;clear msb          v1.4ã	shl cx,1            ;*2 for word addressesã	add si,cx           ;add to table baseãã	call    word ptr [si]       ;call our function      v1.4aã	les bx,cs:req       ;get back request hdr vectorã	mov es:[bx].status,ax   ;return statusãIF USE286ã	popa                ;               v1.5ãELSEã	pop si          ;clean everything upã	pop diã	pop dxã	pop cxã	pop bxã	pop axãENDIFã	pop esã	pop dsããIF PRIVATESTACKã	mov ax, cs:oldss        ;               v1.6ã	cli             ; turn ints offã	mov ss, axã	mov sp, cs:oldspã	mov ax, cs:oldaxã	sti             ; turn ints onãENDIFãã	retãã	public  cmd_tableãcmd_table:              ;command routing tableã	dw  Cmd_Init        ;0=initialization (we do that)ã	dw  Cmd_None        ;1=media check (always SUCCESS)ã	dw  Cmd_None        ;2=build BIOS param block (ditto)ã	dw  Cmd_None        ;3=IO control input (ditto)ã	dw  Cmd_None        ;4=input from device (ditto)ã	dw  Cmd_None        ;5=nondest input no-wait (ditto)ã	dw  Cmd_None        ;6=input status (ditto)ã	dw  Cmd_None        ;7=flush input queue (ditto)ã	dw  Cmd_Output      ;8=output to device (we do that)ã	dw  Cmd_Output      ;9=output with verify (same thing)ã	dw  Cmd_Output_Status   ;A=output status (we do that)ã	dw  Cmd_None        ;B=flush output queue (always SUCCESS)ã	dw  Cmd_None        ;C=IO control output (ditto)ããã;*****************************************************************************ã; Cmd_Output procedureã;*****************************************************************************ãã	public  Cmd_OutputãCmd_Output  proc    nearã	mov ax,BIOS_DATAã	mov ds,ax           ;BIOS data areaã	ASSUME  ds:BIOS_DATA        ;keep MASM happy        v1.4ãã	mov cx,es:[bx].countã	les bx,es:[bx].transãOutput_Loop:ã	mov al,es:[bx]ã	inc bxã	cliã	mov di,BUFFER_PUT       ;next free space        v1.4ã	call    Buf_Wrap        ;add 2, check for wraparoundã	cmp di,BUFFER_GET       ;is the buffer full?        v1.4ã	sti             ;ints back on           v1.4ã	je  Output_Error        ;buffer is full, error      v1.4ãã	xchg    BUFFER_PUT,di       ;save the old, get the new  v1.4ã	xor ah,ahã	mov [di],ax         ;               v1.4ã	loop    Output_Loopãã	public  Cmd_None        ;               v1.4ãCmd_None:               ;share this code        v1.4ã	mov ax,SUCCESSã	retããOutput_Error:ã	mov ax,ERRORã	retãCmd_Output  endpããã;*****************************************************************************ã; Buf_Wrap procedureã;*****************************************************************************ãã	public  Buf_WrapãBuf_Wrap    proc    nearã	inc diã	inc diã	cmp di,BUFFER_END       ;hit end yet?           v1.4ã	je  Wrap            ;>=, wrap around        v1.4ã	retãWrap:ã	mov di,BUFFER_START     ;force ptr to start     v1.4ã	retãBuf_Wrap    endpããã;*****************************************************************************ã; Cmd_Output_Status procedureã;*****************************************************************************ãã	public  Cmd_Output_StatusãCmd_Output_Status   proc    nearã	mov ax,BIOS_DATAã	mov ds,axã	mov di,BUFFER_PUT       ;ptr to next free space     v1.4ã	call    Buf_Wrap        ;wraparound if necessaryã	cmp di,BUFFER_GET       ;same as next char to get?  v1.4ã	jne Cmd_None        ;ok, return SUCCESS     v1.4aã	mov ax,BUSYã	retãCmd_Output_Status   endpãã	public  last_codeãlast_code   label   nearãã;*****************************************************************************ã; Initialization (installation) procedureã;*****************************************************************************ãã	public  Cmd_InitãCmd_Init    proc    nearã	mov ax,csã	mov ds,axã	mov es,ax           ;               v1.4aã	ASSUME  ds:Cseg,es:Cseg     ;               v1.4aãã; Is our new keyboard buffer within reach of the near pointers in BIOS_DATA?ãã	cmp ax,(0fffh+BIOS_DATA_SEG-queue_end/10h);         v1.6ã	ja  Init_Error      ;No, too far awayãã	mov dx,offset banner    ;Yes, 'Buf160 loaded'ã	mov ah,9            ;DOS display msgã	int 21hã	mov bx,0            ;Initialize size of buf     v1.5ã	mov cx,BIOS_DATA        ;PRESERVE THIS!         v1.4ã	mov ds,cx           ;BIOS data areaã	ASSUME  ds:BIOS_DATA        ;               v1.4ãã	cli             ;turn off ints          v1.6aããIF  TRANSFERã	public  Transfer_BufferãTransfer_Buffer:ã	mov si,BUFFER_GET       ;next key to read       v1.4ã	mov dx,BUFFER_PUT       ;next empty space       v1.4aãã	mov di,offset queue_start   ;gonna stuff here       v1.4aã	cld             ;insure fwd         v1.4ãTransfer_Loop:ã	cmp si,dx           ;hit empty yet?         v1.4aã	je  Transfer_Done       ;yep, transfer completeãã	lodsw               ;snarf the kbd wordã	stosw               ;stuff in OUR buffer        v1.4aã	inc bx          ;increment counter      v1.5ã	inc bx          ;increment counter      v1.5ã	cmp si,BUFFER_END       ;hit kbd buffer's end yet?  v1.4ã	jne Transfer_Loop       ; nope, keep goingã	mov si,BUFFER_START     ;yep, wrap around to start  v1.4ã	jmp Transfer_Loop       ; and keep goingãã	public  Transfer_DoneãTransfer_Done:ãENDIFãã	mov ax,cs           ;Code Segmentã	sub ax,cx           ; calculate difference b/w bios & thisãIF USE286ã	shl ax,4            ;               v1.5ãELSEã	shl ax,1            ;remainder * 16 (paras to bytes)ã	shl ax,1ã	shl ax,1ã	shl ax,1ãENDIFã	mov cx,ax           ;CX = driver starting offsetã	add ax,offset queue_start   ;AX = queue_start offsetã	mov BUFFER_START,ax     ;init BIOS buffer pointers  v1.4ã	mov BUFFER_GET,ax       ;               v1.4ã	add ax,bx           ;here'e next free spaceã	mov BUFFER_PUT,ax       ;tell BIOS          v1.4ãã	mov ax,cx           ;get back driver starting offset v1.4aã	add ax,queue_end        ;code start + queue end     v1.4aã	mov BUFFER_END,ax       ;tell BIOS          v1.4ãã	sti             ;restore ints           v1.6aãã	les bx,cs:[req]     ;complete driver headerã	mov es:[bx].trans.ofs,offset last_code  ;driver endã	jmp short Stuff_Seg     ;share code, return success v1.4aãã	public  Init_Errorã	ASSUME  ds:Cseg,es:Cseg     ;               v1.4ãInit_Error:ã	mov dx,offset msg_err   ;'Buf160 too far...'ã	mov ah,9            ;display msgã	int 21hãã	les bx,cs:[req]     ;complete driver header     v1.6ãã	IF  0           ;not sure if it works.ã	mov es:[bx].trans.ofs,0ã	ELSEã	mov es:[bx].trans.ofs,offset last_codeã	ENDIFããStuff_Seg:              ;               v1.4aã	mov es:[bx].trans.segw,cs   ;               v1.4ã	mov ax,SUCCESSã	retããCmd_Init    endpãã	public  banner, msg_errãbanner  db  PROGNAME,' ',VERSION,' installed.',CR,LF        ;v1.4ã	db  'Keyboard now has buffer of 160 characters.'ãIF PRIVATESTACKã	db  '  Using private stack.'ãENDIFã	db  CR,LF,CR,LF,TERMããmsg_err db  PROGNAME,' too far from BIOS data area.'        ;v1.4ã	db  CR,LF,CR,LF,TERMããIntr    endpããCseg    endsãã	endãããã------------8<-----[ Begin BUF160.DOC ]------>8----------------ãBUF160 v1.6aããBUF160 is a device driver which provides a 10-fold expansion of theãstandard keyboard buffer.  Specifically, while the default keyboardãbuffer is usually 16 characters, this becomes 160 characters afterãinstalling this device driver.  The driver is installed by copying itãto ones hard disk and including the command:ãã   DEVICE=<path>\BUF160.SYSããwhere "<path>" is the path of the directory holding the driver.  Itãis recommended that it be the first device driver installed (since itãneeds to be in the same segment and the ROM BIOS).  It has beenãtested under DOS 5.0 (loaded both high and not high) and DOS 3.3, andãno version incompatibilities are expected.ããThis archive contains 3 files:ãã   BUF160.DOC               This documentã   BUF160.ASM               The source codeã   BUF160.SYS               The device driverããThis release of the program was modified by Robert M. Ryan to supportãDOS 5.0.  The previous release, v1.4, sometimes froze the system onãstartup under DOS 5.0.  This corrects that problem.  This version alsoãcorrects some minor coding errors.ããThe original program was written by Donald "DJ" Delorie and wasãfurther modified by David Kirschbaum (?).  While originally developedãto work with MASM, v1.6 was developed with TASM, but hopefully fullãMASM compatibility has been retained.ããThis program has probably outlived the lifespan originally envisagedãby its creator, but I nevertheless find it quite useful.  I provideãit with no guarantee of satisfaction, but hope that you find it asãhelpful as I do.ããRobert M. Ryan, Robert_Ryan@brown.edu (internet)ã				st802200@brownvm (bitnet)ã				70324.227@compuserve.com (compuserve via internet)ãããThe following text is the original BUF160.DOC text file:ãã-----------------------------------------------------------------------------ããFrom: nelson@sun.soe.clarkson.edu (Russ Nelson)ãNewsgroups: comp.binaries.ibm.pcãSubject: buf160.sys (device driver)ãDate: 4 May 88 19:21:16 GMTããThis is a cheap 'n dirty keyboard buffer expander.  It works by installingãitself as the standard keyboard buffer in the bios.  It can only do thisãif it is in the same segment as the bios, so you are well advised toãinstall it as the first device driver.ããWhile it's installing itself into the bios, it also installs a deviceãdriver called KBUFFER.  Anything written to KBUFFER ends up in theãkeyboard buffer.ããWritten by Donald "Dj" Delorie:ãUUCP: uunet!unh!dgdhm!djãInternet: Delorie_D%DUR09.CEO.DG.COM@adam.DG.COMããToad Hall Notes:ãI was using BUF160.COM (without source), loading it via AUTOEXEC.BAT,ãand was pleasantly surprised to find this!ãTweaked it (naturally), now works a little faster, is a little smaller,ãand the tweaked source has comments!ãDJ's original code is still here (BUF160.ASM and BUF160.DVD), and my tweakedãversion is BUF160_4.ASM and BUF160_4.DVD.ããThis documentation says the product should be a .SYS file, while the sourceãsays .DVD.  Doesn't matter .. just so your CONFIG.SYS file says the rightãfile name!  Rename it as you will.ããDavid KirschbaumãToad Hallãkirsch@braggvax.ARPAã------------8<-----[ End BUF160.DOC ]------>8----------------ãUnknown Author(s)              KEYBOARD TEST CODES            KEYBOARD,TEST,CODES            Unknown Date (00:00)   QB, QBasic, PDS        28   920      USEKEYB.BAS 'To use cursor keys and function keys, etc ...ããDOã   'Get a key from the keyboardã   DOã      A$ = INKEY$ã   LOOP UNTIL LEN(A$)ã   'Check if it's a extended (special) keyã   IF LEN(A$) = 2 THENã      'If it is then, make the key code negativeã      KY = -ASC(RIGHT$(A$, 1))ã   ELSEã      'If normal (within ASCII 1 - 255 range), then make it positiveã      KY = ASC(A$)ã   END IFãã   'Un-comment the following line to test for keycodesã   'PRINT KY          'This will give you a specific number to put into yourã                      '  SELECT CASE structure for the key you pressedã   ã   'Use SELECT CASE structure to test for keysã   SELECT CASE KYã      CASE 27         'ESC key pressedã         EXIT DO      'bail outã      'Now you can do whatever you want to the keyã      'CASE ..., etc ...ã   END SELECTãLOOP                   'Infinite loop, bail out when ESC pressed (in SELECT)ãUnknown Author(s)              DISABLE KEYBOARD               DISABLE,KEYBOARD               Unknown (00:00)        QB, QBasic, PDS        21   401      DISKEYB.BAS DECLARE SUB DisableKeyboard ()ãDECLARE SUB EnableKeyboard ()ããSUB DisableKeyboardã   ã   'Purpose : To disable the keyboardã   'Input   : noneã   'Return  : noneãã   OUT &H21, (INP(&H21) OR 2)ãEND SUBããSUB EnableKeyboardãã   'Purpose : To enable keyboard use after being disabled by DisableKeyboardã   'Input   : noneã   'Output  : noneãã   OUT &H21, (INP(&H21) AND 253)ãEND SUBããUnknown Author(s)              KEY IN BUFFER                  KEY,IN,BUFFER                  Unknown Date (00:00)   QB, PDS                44   1470     KEYINBUF.BASDEFINT A-Zãã'$INCLUDE: 'QB.BI'ããDECLARE FUNCTION KeyInBuf ()ãã'***********************************************************************ã'* FUNCTION KeyInBufã'*ã'* PURPOSEã'*    Uses BIOS ISR 16H, Service 01H (Report Whether Character Ready)ã'*    to return a keypress if one is waiting in the keyboard buffer.ã'*    If the key pressed is a normal key, this function will return theã'*    ASCII value for that key; if the key pressed is an extended keyã'*    (such as F1) this function will return the ascii value for thatã'*    key negated.  This function does not remove the key from theã'*    keyboard buffer.ã'*ã'* EXTERNAL ROUTINE(S)ã'*    QBX.LIB:ã'*    --------ã'*    SUB Interrupt (IntNum, InRegs AS RegType, OutRegs AS RegType)ã'***********************************************************************ãFUNCTION KeyInBuf STATICã   InRegs.ax = &H100ã   Interrupt &H16, InRegs, OutRegsãã   IF ((OutRegs.flags AND 64) \ 64) = 0 THEN '0 if a key is pendingã      'If the key pressed is a normal key, alReg holds the ASCII code forã      'that key and ahReg holds the standard PC-keyboard scan code;ã      'otherwise, (a special key was pressed such as F1) alReg holds 0ã      'and ahReg holds the character ID.ã      alReg = OutRegs.ax AND &HFFã      ahReg = OutRegs.ax \ &HFFãã      IF alReg THENã         KeyInBuf = alRegã      ELSEã         KeyInBuf = -ahRegã      END IFã   ELSEã      KeyInBuf = 0ã   END IFãEND FUNCTIONãDave Navarro                   GET KEY                        GET KEY                        02/24/92 (02:07)       PB                     44   1375     GETKEY.BAS  'Here is some PowerBASIC code to read a key from the keyboard (101 keyã'aware).ãã'The "zero" flag us actually bit 7 of the "flags" register..ãã'GetKey - Check if a key is pending and return the key to your programã'         Extended keyboard aware.ããFUNCTION GetKey$ PUBLICã   REG 1, &HC000                            'BIOS get configurationã   CALL INTERRUPT &H15ã   DEF SEG=REG(9)ã     ExKy%=(PEEK(REG(2)+5) AND 16)=16       'returns true if extended KBã   DEF SEGã   IF ExKy% THEN Extendedã   REG 1, &H0100                            'regular BIOS check key routineã   CALL INTERRUPT &H16ã   IF (REG(0) AND 64)=64 THEN EXIT FUNCTION 'if zero flag then no keyã   REG 1, &H0000                            'regular BIOS read key routineã   CALL INTERRUPT &H16ã   K1%=REG(1) AND &HFF                      'ASCII code in ALã   K2%=(REG(1)\2 AND &H7FFF)\128            'scan code in AHã   IF K1%=0 THENã     GetKey$=CHR$(0,K2%)ã    ELSEã     GetKey$=CHR$(K1%)ã   END IFã   EXIT FUNCTIONã Extended:ã   REG 1, &H1100ã   CALL INTERRUPT &H16ã   IF (REG(0) AND 64)=64 THEN EXIT FUNCTIONã   REG 1, &H1000ã   CALL INTERRUPT &H16ã   K1%=REG(1) AND &HFFã   K2%=(REG(1)\2 AND &H7FFF)\128ã   IF K1%=0 THENã     GetKey$=CHR$(0,K2%)ã    ELSEIF K1%=224 AND K2%>0 THENã     GetKey$=CHR$(0,K2%)ã    ELSEã     GetKey$=CHR$(K1%)ã   END IFãEND FUNCTIONãUnknown Author(s)              SET KEYBOARD RATE              SET,KEYBOARD,RATE              Unknown Date (00:00)   QB, PDS                27   726      SETKB.BAS   '$INCLUDE: 'qb.bi'ããDECLARE SUB SetKBRate (InitDelay%, RepeatRate%)ããSetKBRate 10, 250ããSUB SetKBRate (InitDelay%, RepeatRate%) STATICã'**********************************************************************ã'* SUB SetKBRateã'*ã'* PURPOSEã'*    Uses BIOS ISR 16H, Service 03H (Set Typematic Rate and Delay) toã'*    set the typematic rate of an AT keyboard.ã'*ã'* EXTERNAL ROUTINE(S)ã'*    QBX.LIBã'*    -------ã'*    SUB Interrupt (IntNum%, IRegs AS RegType, ORegs AS RegType)ã'**********************************************************************ãã   DIM IRegs AS RegType, ORegs AS RegTypeãã   IRegs.ax = &H305ã   IRegs.bx = InitDelay% * 256 + RepeatRate%ã   INTERRUPT &H16, IRegs, ORegsãEND SUBããThe ABC Programmer             SPEED UP KEYBOARD INPUTS       SPEED,UP,KEYBOARD,INPUTS       04/10/95 (00:00)       TASM                   20   253      FASTKEY.ASM ;FASTKEY.ASMã;Purpose: To Increase Keyboard Input Rate   (Same as using MODE)ããIDEALãMODEL SMALLãDATASEGãCODESEGãPUBLIC FastKeyãEVENãPROC    FastKeyãã;DECLARE SUB FastKey      ããMov Ax, $305ãXor Bx, BxãInt $16ããENDP    FastKeyãENDã ãMatt Hart                      ALT/CTRL/SHIFT/CAPS/NUM/SCRL   ALT,CTRL,SHIFT,CAPS,NUM,SCRL   Unknown Date (00:00)   QB, PDS                105  2924     KEYSTUFF.BAS'ã' KEYSTUFF.BAS  by Matt Hartã' Uses Interrupt 16H for various keyboard operations.ã'ã' The scroll lock, num lock, caps lock, and insertã' key flags remain ON until pressed again, thus the need forã' the ?Flag variables in this demo program.ã'ã' Also see Keystuf.asm for assembly language equivilants.ã'ã    DEFINT A-Zã    TYPE RegTypeXã        ax    AS INTEGERã        bx    AS INTEGERã        cx    AS INTEGERã        dx    AS INTEGERã        bp    AS INTEGERã        si    AS INTEGERã        di    AS INTEGERã        flags AS INTEGERã        ds    AS INTEGERã        es    AS INTEGERã    END TYPEã    DECLARE FUNCTION RShift()ã    DECLARE FUNCTION LShift()ã    DECLARE FUNCTION CtrlKey()ã    DECLARE FUNCTION AltKey()ã    DECLARE FUNCTION ScrollLock()ã    DECLARE FUNCTION NumLock()ã    DECLARE FUNCTION CapsLock()ã    DECLARE FUNCTION InsertKey()ã    SFlag=0 : NFlag=0 : CFlag=0 : IFlag=0ã    DOã        IF RShift     THEN PRINT "Right Shift Key"ã        IF LShift     THEN PRINT "Left Shift Key"ã        IF CtrlKey    THEN PRINT "Control Key"ã        IF AltKey     THEN PRINT "Alt Key"ã        IF ScrollLock AND NOT SFlag THENã            PRINT "Scroll Lock Enabled"ã            SFlag = NOT SFlagã        ELSEIF NOT ScrollLock AND SFlag THENã            PRINT "Scroll Lock Disabled"ã            SFlag = NOT SFlagã        ENDIFã        IF NumLock AND NOT NFlag THENã            PRINT "Num Lock Enabled"ã            NFlag = NOT NFlagã        ELSEIF NOT NumLock AND NFlag THENã            PRINT "Num Lock Disabled"ã            NFlag = NOT NFlagã        ENDIFã        IF CapsLock AND NOT CFlag THENã            PRINT "Caps Lock Enabled"ã            CFlag = NOT CFlagã        ELSEIF NOT CapsLock AND CFlag THENã            PRINT "Caps Lock Disabled"ã            CFlag = NOT CFlagã        ENDIFã        IF (InsertKey AND NOT IFlag) OR_ã           (NOT InsertKey AND IFlag) THENã            PRINT "Insert Key Toggled"ã            IFlag = NOT IFlagã        ENDIFã    LOOP UNTIL INKEY$=CHR$(27)ã    ENDã'ãFUNCTION RShiftã    CALL KeyInt(AL) : RShift = (AL AND 1) = 1ãEND FUNCTIONã'ãFUNCTION LShiftã    CALL KeyInt(AL) : LShift = (AL AND 2) = 2ãEND FUNCTIONã'ãFUNCTION CtrlKeyã    CALL KeyInt(AL) : CtrlKey = (AL AND 4) = 4ãEND FUNCTIONããFUNCTION AltKeyã    CALL KeyInt(AL) : AltKey = (AL AND 8) = 8ãEND FUNCTIONã'ãFUNCTION ScrollLockã    CALL KeyInt(AL) : ScrollLock = (AL AND 16) = 16ãEND FUNCTIONã'ãFUNCTION NumLockã    CALL KeyInt(AL) : NumLock = (AL AND 32) = 32ãEND FUNCTIONã'ãFUNCTION CapsLockã    CALL KeyInt(AL) : CapsLock = (AL AND 64) = 64ãEND FUNCTIONã'ãFUNCTION InsertKeyã    CALL KeyInt(AL) : InsertKey = (AL AND 128) = 128ãEND FUNCTIONã'ãSUB KeyInt(AL)ã    DIM InRegs AS RegTypeXã    DIM OutRegs AS RegTypeXã    InRegs.AX = &H0200ã    CALL InterruptX(&H16,InRegs,OutRegs)ã    AL = OutRegs.AX MOD 256ãEND SUBãBrent Ashley                   QB SIMULTANEOUS KEY            QB,SIMULTANEOUS,KEY            Unknown Date (00:00)   ASM, QB, PDS           89   3020     KEYPRESS.BAS'BASIC test code:ãDECLARE FUNCTION KeyPressed%(ScanCode%)ãCALL InstKeyPress ' install resident codeãCLSãDOã  LOCATE 1,1ã  FOR i% = 2 TO 9 ' scancode of 1 to 8ã    IF KeyPressed(i%) THEN PRINT CHR$(47+i%); ELSE PRINT " ";ã  NEXTã  PRINTãLOOP UNTIL INKEY$=CHR$(27) ' escape to quitãCALL UnHookKeyPress ' unhook resident code - IMPORTANT!!!ãENDãã; KeyPress.ASM by Brent Ashleyã;   checks the "pressed" status of any keyã.model medium, basicã.codeãOld09        Label Dword       ;Label for to old Int 09h handlerãOld09Offset  dw ?              ;Offset partãOld09Segment dw ?              ;Segment partãHooked       db 0              ;Our installed flagãKeyMap       db 80 dup(0)      ;map of kybd, one byte per scancodeãInstKeyPress proc uses ds ax dx ; From BASIC: CALL InstKeyPressã                               ; REMEMBER to call UnhookKeyPress!ã        cmp cs:Hooked,0        ;Are we already hooked?ã        jnz InstallExit        ;If so, exitã        mov ax,3509h           ;Get current vector for int 09hã        int 21hã        mov cs:Old09Segment,es ;Remember it for laterã        mov cs:Old09Offset,bxã        mov ax,2509hã        push dsã        push csã        pop ds                 ;Point int 09h handler to our codeã        mov dx, offset OurInt09ã        int 21hã        pop dsã        mov cs:Hooked,-1       ;Set our installed flagãInstallExit:ã        retãOurInt09:                      ;Our Int 09h handlerã        push axã        push bxã        push dxã        push siã        in al, 60hã        test al, 080h          ;is "released" bit set?ã        jnz Released           ;yup - go to itã        mov dl, 0FFh           ;nope - set key pressed flagã        jmp PutFlagãReleased:ã        and al, 07Fh           ;yes - clear bit for indexã        mov dl, 0              ;and set flag for releaseãPutFlag:ã        xor ah, ahã        mov si, ax             ;assign indexã        mov cs:KeyMap[si], dl  ;put flag in placeã        pop siã        pop dxã        pop bxã        pop axãContinue:ã        jmp dword ptr cs:[Old09];Transfer ctrl to orig Int 09hãInstKeyPress endpãKeyPressed proc uses bx si, ScanCode:WORDã        ; from BASIC: TrueOrFalse% = KeyPressed(ScanCode%)ã        mov bx, ScanCode       ;get scan code addrã        mov si, [bx]           ;load value as indexã        mov al, cs:KeyMap[si]  ;put flag in alã        cbw                    ;convert to word for integer valueã        retãKeyPressed endpãUnhookKeyPress proc            ; from BASIC: CALL UnHookKeyPressã        cmp cs:Hooked,0        ; are we installed?ã        jz UnHooked            ; nope - exitã        push axã        push dsã        mov ax,2509h           ;Unhook ourselfã        mov ds,Old09Segmentã        mov dx,Old09Offsetã        int 21h                ;Point Int 09h back to orig hndlrã        pop dsã        pop axã        mov cs:Hooked,0        ;Set installed flag back to zeroãUnHooked:ã        retãUnhookKeyPress endpãENDãJeff Shantz                    HOTKEYS EXAMPLE                HOTKEYS,EXAMPLE                Unknown Date (00:00)   QB, QBasic, PDS        63   2349     EX_HOT.BAS  'Hotkeys Example By Jeff Shantzã'ã'Programmer's Noteã'ã'Many Programmers In QuickBasic Have Wanted To Know How To Have Hotkeysã'In Their Programs For A Long Time But Have Struggled Over It.  Thisã'Example Demonstrates The Incorporation Of Hotkeys Into Your QuickBasicã'Programs.  It Uses 2 Main Commands, INKEY$ And ASC.  Of Course, There AREã'Other Ways To Incorporate Hotkeys Into Your Programs But This Technique Isã'A Fast And Easy To Use Way To Use Hotkeys.   Hotkeys Improve The Feel Ofã'Your Program And Make It More Professional.ã'ãPlays = 0  'sets a variable for maintaining the octave level.  See 3ãCLSãX$ = STRING$(79, 196)  'sets the border as X$ãCOLOR 7ãPRINT X$ 'prints the borderãLOCATE 23, 1: PRINT X$ 'prints the lower borderãã'Titles And InstructionsãCOLOR 4: LOCATE 5, 25: PRINT "Hotkey Example"ãCOLOR 14ãLOCATE 9, 15: PRINT "[1] Hear 1 Beep"ãLOCATE 9, 40: PRINT "[2] Hear 2 Beeps"ãLOCATE 12, 13: PRINT "[M]ake Strange Noise"ãLOCATE 12, 41: PRINT "[Q]uit Program"ãLOCATE 18, 24: PRINT "Any Other Key Plays Music"ã1 FOR N% = 1 TO 9999 'starts the hotkey loopãA$ = INKEY$: IF LEN(A$) = 0 THEN GOTO 2 'program acts upon keypressãIF ASC(A$) = 49 THEN BEEP: GOTO 1  'if 1 is pressed, 1 beep is heardãIF ASC(A$) = 50 THEN BEEP: BEEP: GOTO 1  'if 2 is pressed, 2 beeps are heardã'in the statement below, if M is pressed, a strange noise is madeãIF ASC(A$) = 77 THEN PLAY "mf l64 t255 o4 A C E A C E A CE": GOTO 1ãIF ASC(A$) = 81 THEN SYSTEM 'exits to dos if run from dos, Qã'in the statement below, if m is pressed, a strange noise is madeãIF ASC(A$) = 109 THEN PLAY "mf l64 t255 o4A C E A C E A CE": GOTO 1ãIF ASC(A$) = 113 THEN SYSTEM ELSE GOTO 3 'exits to dos if run from dos, qã2 NEXT N%ãGOTO 1ãã3 IF Plays = 4 THEN PLAY "o4": Plays = 0 'resets the octave levelãPLAY "mf l12 t255 a c e < a c e" 'plays the musicãPlays = Plays + 1 'adds another point to the plays variableãGOTO 1ãã'Written by Jeff Shantzã'ã'A catalogue of other public domain programming examples and other types ofã'public domain software written by Jeff Shantz can be obtained by sendingã'$2.00 (for shipping & handling) to:ã'ã'Programming Examplesã'c/o Jeff Shantzã'162 Ann Streetã'Kitchener,Ontarioã'N2B 1Y3, CANADAã'ã'or by setting your modem to 8,N,1 and calling The Crypt at 1-(519)-576-3127ããããããDaniel Trimble                 DISABLE CTRL+BREAK             FidoNet QUIK_BAS Echo          Year of 1995           QB, QBasic, PDS        35   1464     NOBREAK.BAS 'QBasic NoBreak v1.0aã'Copyright (c)1995 by Daniel Trimbleã'Public Domain - use at your own risk.ããCLSãDOã   KEY 15, CHR$(4 + 128 + 32 + 64) + CHR$(70)ã   ON KEY(15) GOSUB NoBreak: KEY(15) ONã   KEY 16, CHR$(4 + 128) + CHR$(70): ON KEY(16) GOSUB NoBreak: KEY(16) ONã   KEY 17, CHR$(4 + 128 + 32) + CHR$(70): ON KEY(17) GOSUB NoBreakã   KEY(17) ON: KEY 18, CHR$(4 + 128 + 64) + CHR$(70): ON KEY(18) GOSUB NoBreakã   KEY(18) ON: KEY 19, CHR$(4) + CHR$(70): ON KEY(21) GOSUB NoBreakã   KEY(21) ON: KEY 22, CHR$(4 + 64) + CHR$(70)ã   ON KEY(22) GOSUB NoBreak: KEY(22) ON: KEY 23, CHR$(4 + 32) + CHR$(46)ã   ON KEY(23) GOSUB NoBreak: KEY(23) ON: KEY 24, CHR$(4 + 64) + CHR$(46)ã   ON KEY(24) GOSUB NoBreak: KEY(24) ONã   KEY 25, CHR$(4 + 32 + 64) + CHR$(46): ON KEY(25) GOSUB NoBreak: KEY(25) ONãã   LOCATE 1, 1, 0: PRINT "QBasic NoBreak v1.0a"ã   LOCATE 2, 1, 0: PRINT "Copyright (c)1995 by Daniel Trimble"ã   LOCATE 4, 1, 0: PRINT "This program and all source is public domain.  I will not be responsible"ã   LOCATE 5, 1, 0: PRINT "for any damage this program may cause.  I am not at fault.  Use at your"ã   LOCATE 6, 1, 0: PRINT "own risk - period!"ã   LOCATE 15, 1, 0: PRINT "Try pressing either CTRL-BREAK or CTRL-C.  Nothing will happen."ã   LOCATE 16, 1, 0: PRINT "To end the program, hit ENTER."ã   IF INKEY$ = CHR$(13) THEN ENDãLOOPããNoBreak: RETURNããã'ctrl =4          extended keys=128ã'num lock=32      c=46ã'cap lock=64ããUnknown Author(s)              SET CURSOR TYPEMATIC KEYRATE   FidoNet QUIK_BAS Echo          Unknown Date           QB, PDS                16   470      KEYSPEED.BAS'$INCLUDE: 'QBX.BI' or QB.BIããSUB KeySpeed (rate, delay)ã ã'Sets the cursor typematic keyrate.  Rate is the speed at whichã'the keys repeat, the range is from 0 to 31, 0 being fastest.ã'Delay is the amount of time in 250 millisecond parts before theã'keys begin to repeat.  The range is from 0 to 3, 0 being theã'shortest wait.ã ãDIM Regs AS RegTypeãRegs.ax = &H305ãRegs.bx = (delay AND 3) * 256 + (rate AND 31)ãCALL Interrupt(&H16, Regs, Regs)ãEND SUBããChristy Gemmell                STUFF KEYBOARD BUFFER          Ethan Winer                    06-01-95 (13:01)       QB, QBasic, PDS        141  5579     KEYBUFF.BAS ' >> I've been trying to use an example program from Ethan Winer'sã'  >> "Basic Tips and Tricks". I have successfully used other programsã'  >> of his, but I cannot get this example to work for love nor money..ãã' >> ------------------------ ethan winers Stuff Buffer example--------ã'  >> SUB StuffBuffer (Cmd$) STATICã'  >>ã'  >>   '----- Limit the string to 14 characters plus Enter and saveã'  >>   '      the length.ã'  >>   Work$ = LEFT$(Cmd$, 14) + CHR$(13)ã'  >>   Length = LEN(Work$)ã'  >>ã'  >>   '----- Set the segment for poking, define the buffer head and tail,ã'  >>   '      and then poke each character.ã'  >>   DEF SEG = 0ã'  >>   POKE 1050, 30ã'  >>   POKE 1052, 30 + Length * 2ã'  >>   FOR X = 1 TO Lengthã'  >>     POKE 1052 + X * 2, ASC(MID$(Work$, X))ã'  >>   NEXTã'  >>ã'  >> END SUBãã'There's nothing wrong with Ethan's code and the POKE addresses are theã'default ones for the keyboard buffer. However not all computers haveã'the buffer in the usual place and if, for example, you have a keyboardã'enhancer program that gives you a larger typeahead buffer then it mightã'have been moved elsewhere.ãã'As a quick check try running this little program...ãã'    DEF SEG = &H40ã'    X& = PEEK(&H80) + (256& * PEEK(&H81))ã'    PRINT X&ãã'If your keyboard buffer is in the standard place then X& should be equalã'to thirty. If you get any other value than 30 your buffer has definitelyã'been moved since the two bytes at 0040:0080 are a pointer to the start ofã'the keyboard buffer taken as an offset from segment 0040 (Hex) - the BIOSã'DATA area.ãã'Personally I would rewrite the second part of Ethan's procedure asã'follows:ãã'    DEF SEG = &H40                      ' Switch to BIOS data segmentã'    Head% = &H1A                        ' Buffer head pointerã'    Tail% = &H1C                        ' Buffer tail pointerã'    Start& = PEEK(&H80) + (256& * PEEK(&H81))ã                                        ' Pointer to keyboard bufferã'    FOR X = 1 TO Length                 ' Stuff the bufferã'        POKE Start& + (X - 1) * 2, ASC(MID$(work$, X, 1))ã'    NEXTã'    POKE Head%, Start&                  ' Set new head pointerã'    POKE Tail%, Start& + (X - 1) * 2    ' Set new tail pointerãã'This should work wherever the buffer is located.ãã'If you want to see how the keyboard buffer works, try running theã'program below. It displays the contents in real time so you canã'watch as each keypress is inserted.ãã'--- cut here ---------------------------------------------------------------ã' KEYBUFF.BAS   continuously displays contents of keyboard bufferã'ã'   Author:     Christy Gemmellã'   Date:       19/2/1990ã'ã    COLOR 15, 0: CLS : LOCATE , , 0ã    READ Items%ã    FOR I% = 1 TO Items%ã        READ Row%, Col%, Text$ã        LOCATE Row%, Col%: PRINT Text$;ã    NEXT I%ã    LOCATE 11, 68: COLOR 11ã    DEF SEG = &H40ã    Start& = &H400 + PEEK(&H80): Finish& = &H400 + PEEK(&H82)ã    PRINT RIGHT$("0000" + HEX$(Start&), 4); " ";ã    PRINT RIGHT$("0000" + HEX$(Finish&), 4);ã    IF Start& <> &H41E THENã       S& = Start& - &H400: Ix$ = ""ã       FOR I% = 0 TO 15ã           Ix$ = Ix$ + RIGHT$("0" + HEX$(S& + (I% * 2)), 2) + " "ã       NEXT I%ã       LOCATE 8, 17: COLOR 15: PRINT RTRIM$(Ix$);ã    END IFã    DOã       LOCATE 11, 4: COLOR 11ã       Head& = &H400 + PEEK(&H1A): Tail& = &H400 + PEEK(&H1C)ã       PRINT RIGHT$("0000" + HEX$(Head&), 4); " ";ã       PRINT RIGHT$("0000" + HEX$(Tail&), 4);ã       COLOR 13: LOCATE 9, 17: PRINT SPACE$(48);ã       LOCATE 9, 17 + ((Head& - &H41E) \ 2) * 3: PRINT CHR$(25);ã       COLOR 12: LOCATE 13, 17: PRINT SPACE$(48);ã       LOCATE 13, 17 + ((Tail& - &H41E) \ 2) * 3: PRINT CHR$(24);ã       FOR I% = 0 TO 15ã           Character% = PEEK((Start& - &H400) + (I% * 2))ã           Scancode% = PEEK((Start& - &H400) + (I% * 2) + 1)ã           IF Character% < 32 THENã              Ky$ = "  "ã           ELSEã              Ky$ = CHR$(Character%) + " "ã           END IFã           LOCATE 11, 17 + (I% * 3): COLOR 14: PRINT Ky$;ã           LOCATE 14, 17 + (I% * 3): COLOR 9ã           PRINT RIGHT$("0" + HEX$(Character%), 2);ã           LOCATE 15, 17 + (I% * 3): COLOR 10ã           PRINT RIGHT$("0" + HEX$(Scancode%), 2);ã'(Continued to next message)ã'(Continued from previous message)ã       NEXT I%ã       IF Head& >= Tail& THENã          Numkeys% = 16 - ((Head& - Tail&) \ 2)ã       ELSEã          Numkeys% = (Tail& - Head&) \ 2ã       END IFã       LOCATE 14, 76: IF Numkeys% = 16 THEN Numkeys% = 0ã       PRINT RIGHT$(" " + LTRIM$(RTRIM$(STR$(Numkeys%))), 2);ã       IF Numkeys% = 15 THENã          LOCATE 15, 67: COLOR 28: PRINT "BUFFER FULL";ã          Dummy$ = INPUT$(16)ã          LOCATE , 67: PRINT SPACE$(11);ã       END IFã    LOOP UNTIL PEEK((Tail& - &H400) - 2) = 27ã    DEF SEG : COLOR 7, 0: LOCATE 20, 1, 1ã    Dummy$ = INPUT$(Numkeys%)ãENDããDATA  20ãDATA  6, 4, "Head Tail", 6, 33, "Keyboard buffer"ãDATA  6, 67, "Buffer Area", 8, 4, "041A 041C"ãDATA  8, 17, "1E 20 22 24 26 28 2A 2C 2E 30 32 34 36 38 3A 3C"ãDATA  8, 68, "0480 0482", 10, 3, "-----|-----"ãDATA  10, 16, "|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|"ãDATA  10, 67, "-----|-----", 11, 3, "           ", 11, 16, " "ãDATA  11, 64, " ", 11, 67, "           ", 12, 3, "-----|-----"ãDATA  12, 16, "|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|"ãDATA  12, 67, "-----|-----", 14, 3, "ASCII Codes"ãDATA  14, 67, "Waiting", 15, 3, "Scan Codes"ãDATA  24, 31, "Press <Esc> to quit"ãããPeter Norton                   RETURNS KEY(S) PRESSED         Advanced BASIC Book            Unknown Date           QB, PDS                52   1317     INKEY.BAS   ' Returns the key(s) pressedã' Useful to find value of combined keysã' ie.  CTRL+UP     =  CHR$(0)+CHR$(141)ã'      CTRL+DOWN   =  CHR$(0)+CHR$(145)ããDECLARE FUNCTION InKeyNoEcho$ ()ãTYPE RegTypeã        ax      AS INTEGERã        bx      AS INTEGERã        cx      AS INTEGERã        dx      AS INTEGERã        bp      AS INTEGERã        si      AS INTEGERã        di      AS INTEGERã        flags   AS INTEGERãEND TYPEããDECLARE SUB INTERRUPT (IntNo AS INTEGER, InRegs AS RegType, OutRegs AS RegType)ãã        PRINT "Type a character: "ã        DOã        TheKey$ = InKeyNoEcho$ã        LOOP WHILE TheKey$ = ""ã        PRINT "That character was: ", TheKey$ããENDããFUNCTION InKeyNoEcho$ãã   DIM InRegs AS RegType, OutRegs AS RegTypeã   InRegs.ax = &H600ã   InRegs.dx = &HFFãã   CALL INTERRUPT(&H21, InRegs, OutRegs)ãã   REM No character ready if zero flag setãã   IF (OutRegs.flags AND 2 ^ 6) THENã       InKeyNoEcho$ = ""ã   ELSEã       IF (OutRegs.ax AND &HFF) <> 0 THENã           InKeyNoEcho$ = CHR$(OutRegs.ax AND &HFF)ã       ELSE    'Need one more callã           InRegs.ax = &H600ã           InRegs.dx = &HFFã           CALL INTERRUPT(&H21, InRegs, OutRegs)ã           InKeyNoEcho$ = CHR$(0) + CHR$(OutRegs.ax AND &HFF)ã      END IFã   END IFããEND FUNCTIONããUnknown Author(s)              DISABLE/ENABLE KEYBOARD        QBFAQ                          Unknown Date           QB, QBasic, PDS        17   340      DISKEYB.BAS SUB DisableKeyboard ()ã   ã   'Purpose : To disable the keyboardã   'Input   : noneã   'Return  : noneãã   OUT &H21, (INP(&H21) OR 2)ãEND SUBããSUB EnableKeyboard ()ãã   'Purpose : To enable keyboard use after being disabled by DisableKeyboardã   'Input   : noneã   'Output  : noneãã   OUT &H21, (INP(&H21) AND 253)ãEND SUBãDISABLE PAUSE BUTTON           EDWARD LAM/BRENT ASHLEY        NANET-BASIC                    02-01-93               ASM, QB, PDS           127  4174     NOPAUSE.BAS '   Because B_OnExit might have too many routines registered already, I've madeã'NoPause a function returning TRUE(-1) if everything is ok, otherwise FALSE(0).ã'   The B_OnExit routine does look a little eratic to me in the environment butã'try it and see what happens.ãã'cut here for NOPDEMO2.BASãã'Example program for NoPause2 module.ã'ãDECLARE FUNCTION NoPause%ã'ãCLSãPRINT "Press N for NoPause, U to Unhook NoPause, ESC to exit"ãDOã  I = (I + 1) MOD 1000ã  LOCATE 5, 5: PRINT "     ";ã  LOCATE 5, 5: PRINT I;ã  A$ = UCASE$(INKEY$)ã  IF A$ = "N" THENã     IF NOT NoPause% THEN   'We call NoPause hereã        LOCATE 2, 1ã        PRINT "B_OnExit Full!  Can't stop pause key"ã     END IFã  END IFã  IF A$ = "U" THENã      CALL UnhookNoPause  'Have option to disable nopause fromã                           'within programã      LOCATE 2, 1ã      PRINT SPACE$(36)ã  END IFãLOOP UNTIL A$ = CHR$(27)ã'Note that we don't care the state of the vectors since B_OnExit will callã'UnHookNoPause for us.  You can call UnHookExit as many times as you likeãã ;NoPause2.ASMãã;Note that this file has been modified so that the UnHookNoPause routineã;does not need ever (or should it) to be called.  --EKLããEXTRN   B_OnExit:FAR            ;QB's internal routine calls all cleanã                                ;up routines registered with it onyã_any_ exitãã;ã; NoPause.ASM by Brent Ashley  /  NoPause2.ASM modified by Edward Lam 01/31/93ã;ã.model medium, basicã.codeãOld1C        Label Dword          ;Label for to old Int 1ChãOld1COffset  dw ?                 ;Offset partãOld1CSegment dw ?                 ;Segment partãHooked       db 0                 ;Our installed flagãã;Note that if an error occurs registering NoHookPause, NoPause will returnã;FALSE.  Right, it's a function now instead of a sub -- EKLãNoPause proc uses ds dx           ;From BASIC: Ok% = NoPause%ã                                  ;Use UnhookNoPause to disable NoPauseãã        cmp cs:Hooked,0           ;Are we already hooked?ã        jnz InstallExit           ;If so, exitãã        ;following section just cut&paste from EVENTCHN.ASM by Jim Mackã        mov     dx, offset UnHookNoPauseã        push    cs                ; push far address of UnHookNoPauseã        push    dx                ; to register the exit routineã        call    B_OnExit          ; so that we don't hang machineã        or      ax, ax            ; registered OK?ã        jz      ErrorExit         ; error: too many registered routinesãã        mov ax,351Ch              ;Get current vector for int 09hã        int 21hãã        mov cs:Old1CSegment,es    ;Remember it for laterã        mov cs:Old1COffset,bxã        mov ax,251Chã        push dsã        push csã        pop ds                    ;Point int 1Ch to our codeã        mov dx, offset OurInt1Cã        int 21hã        pop dsã        mov cs:Hooked,-1          ;Set our installed flagã        mov ax, -1                ;return TRUE for okã        jmp InstallExitããErrorExit:ã        sub ax, ax                ;put 0 into ax to return with errorããInstallExit:ã        retããOurInt1C:                         ;Our Int 1Ch handlerã        push ds                   ;ã        push bxã        push axã        xor bx, bx                ;point DS to BIOS data areaã        mov ds, bx                ;ã        mov bx, 0418hã        mov al, [bx]ã        and al, 0F7h              ;reset nopause flagã        mov [bx], alã        pop axã        pop bxã        pop dsã        jmp dword ptr cs:[Old1C]  ;Transfer to orig Int 1ChããNoPause endpããUnhookNoPause proc                ; from BASIC: CALL UnHookNoPauseã        cmp cs:Hooked,0           ; are we installed?ã        jz UnHooked               ; nope - exitãã        push axã        push dsã        mov ax,251Ch              ;Unhook ourselfã        mov ds,Old1CSegmentã        mov dx,Old1COffsetã        int 21h                   ;Point Int 1Ch back to originalã        pop dsã        pop axã        mov cs:Hooked,0           ;Set installed flag back to zeroããUnHooked:ã        retãUnhookNoPause endpããENDãKerry S. Goodin                DETECTING KEY STATUS           kerry.goodin@shivasys.com      11-17-95 (00:00)       QB, PDS                108  2376     KEYFLAGS.BAS'**********************************************************ã'*      keyflags.bas by Kerry S. Goodin, D.D.S.           *ã'*        Placed in public domain 11-17-95                *ã'*               use at your own risk                     *ã'**********************************************************ãããDECLARE SUB keybFlags ()ãDEFINT A-Zãã'Quick Basic Code for detecting the status of alt, ctrl, left shift, ã'right shift, and insert or the state of the flags of numlock, capslock,ã'and scroll lock of ROM BIOS (ie. Flag set on or off)ãã'remember to start QB with the /lqb switchã'end program with esc keyãã'$INCLUDE: 'qb.bi'ãã'declare the types of the flagsãTYPE Keyboardã insert AS INTEGERã CapsLock AS INTEGERã NumLock  AS INTEGERã ScrollLock AS INTEGERã alt AS INTEGERã Ctrl AS INTEGERã LeftShift AS INTEGERã RightShift AS INTEGERãEND TYPEããDIM SHARED inRegs AS RegTypeãDIM SHARED outRegs AS RegTypeãDIM SHARED kb AS KeyboardããCLSãPRINT "Demo of reading the keyboard flags"ãPRINT "press esc to end"ããDOã COLOR 4, 7, 0ã LOCATE 20, 5, 0:ã CALL keybFlagsã IF kb.alt THENã     PRINT " alt ";ã ELSEã     PRINT "     ";ã END IFã IF kb.Ctrl THENã     PRINT " Ctrl ";ã ELSEã     PRINT "      ";ã END IFã IF kb.LeftShift THENã     PRINT " LeftShift ";ã ELSEã     PRINT "           ";ã END IFã IF kb.RightShift THENã     PRINT " RightShift ";ã ELSEã     PRINT "            ";ã END IFã IF kb.insert THENã     PRINT " Insert ";ã ELSEã     PRINT "        ";ã END IFã IF kb.CapsLock THENã     PRINT " CapsLock ";ã ELSEã     PRINT "          ";ã END IFã IF kb.NumLock THENã     PRINT " NumLock ";ã ELSEã     PRINT "         ";ã END IFã IF kb.ScrollLock THENã     PRINT " ScrollLock ";ã ELSEã     PRINT "            ";ã END IFã IF INKEY$ = CHR$(27) THEN EXIT DO 'get out of loopããLOOPããENDããSUB keybFlagsãã 'call the keyboard flags serviceã        'Int 16H Function 02Hãã inRegs.ax = &H200ã CALL interrupt(&H16, inRegs, outRegs)ãã 'extract the bits of the flag byteã kb.insert = outRegs.ax \ 128ã kb.CapsLock = (outRegs.ax AND &H40) \ 64ã kb.NumLock = (outRegs.ax AND &H20) \ 32ã kb.ScrollLock = (outRegs.ax AND &H10) \ 16ã kb.alt = (outRegs.ax AND &H8) \ 8ã kb.Ctrl = (outRegs.ax AND &H4) \ 4ã kb.LeftShift = (outRegs.ax AND &H2) \ 2ã kb.RightShift = (outRegs.ax AND 1)ããEND SUBãJustin Pasher/Vadim Kilshteyn  GET INPUT                      FidoNet QUIK_BAS Echo          11-06-95 (15:39)       QB, QBasic, PDS        114  3564     GETS.BAS    'Here's a nifty little code to get input from a user. It'll check everyã'key pressed to a verification string that you define. You can alsoã'define the keys to end the input. The sub returns a key code = to theã'ASC() of the key used to end the input. It'll also return a string ofã'the input. One neat affect is that it allows screen "wrapping". Tryã'defining a StrLeng value greater than the screen width. It's cool. Thisã'was coded by Vadim Kilshteyn and me. Enjoy..ããDECLARE FUNCTION GetInput$ (ReturnStr$, Row, Col, StrLeng, WhatChar, Cursor, DoSound, StrCRC$, RetCRC$, MaxCol)ã  DIM SHARED Nul AS STRING * 1ã  DIM SHARED Esc AS STRING * 1ã  DIM SHARED Enter AS STRING * 1ã  Nul = CHR$(0): Enter = CHR$(13): Esc = CHR$(27)ã  CONST True  = -1ã  CONST False = 0ã  CLSã  PRINT "Kewl Typing Program"ã  FOR Ver = 1 TO 254ã    IF Ver <> 7 AND Ver <> 27 THEN StrCRC$ = StrCRC$ + CHR$(Ver)ã  NEXTã  RetCRC$ = Enter + Escã  Row = 3: Col = 11ã  WhatChar$ = "ù"ã  LOCATE 3, 1: PRINT "Password ["; TAB(20); "]"ã  Returned$ = GetInput$(RetStr$, Row, Col, 20, ASC(WhatChar$), True, True, StrCRC$, RetCRC$, 19)ã  LOCATE 4, 1ã  IF Returned$ = CHR$(27) THEN PRINT "Aborted..." ELSE PRINT RetStr$ã  IF LEN(Returned$) = 1 THEN PRINT "Return Code: "; Returned$ ELSE PRINT "Return code: CHR$(0) +"; Returned$ããFUNCTION GetInput$ (ReturnStr$, Row, Col, StrLeng, WhatChar, Cursor, DoSound, StrCRC$, RetCRC$, MaxCol)ã  IF WhatChar = 0 OR WhatChar = 8 OR WhatChar = 9 OR WhatChar = 10 OR WhatChar = 11 OR WhatChar = 255 THEN WhatChar = 32ã  IF Cursor = True THEN Cursor = 1 ELSE Cursor = 0ã  CurX = Colã  CurY = Rowã  ScrnFull = 1ã  IF MaxCol - Col + 1 <= StrLeng THENã    SpaceC$ = STRING$(MaxCol - Col + 1, WhatChar)ã    Total = MaxCol - CurX + 1ã  ELSEã    SpaceC$ = STRING$(StrLeng, WhatChar)ã    Total = StrLengã  END IFã  MaxScrn = INT(StrLeng / Total)ã  StartX = Colã  LOCATE Row, Col: PRINT SpaceC$;ã  LOCATE Row, Col, CursorããGetKey:ã  Key$ = ""ãDO UNTIL LEN(Key$)ã  Key$ = INKEY$ãLOOPãã  IF INSTR(1, RetCRC$, Key$) = False AND INSTR(1, StrCRC$, Key$) = False THEN GOTO GetKeyã  IF INSTR(1, RetCRC$, Key$) > 0 THEN GOTO EndItã  IF Key$ = CHR$(25) THENã    LOCATE CurY, StartXã    ScrnFull = 1ã    Word$ = ""ã    PRINT SpaceC$ã    CurX = StartXã    LOCATE CurY, CurXã    GOTO GetKeyã  END IFã  IF Key$ = CHR$(3) THEN GOTO GetKeyã  IF Key$ = CHR$(0) + CHR$(144) THEN GOTO GetKeyããIF LEN(Word$) = StrLeng AND Key$ <> CHR$(13) AND Key$ <> CHR$(8) THENã  IF DoSound = True THEN SOUND 450, 1: SOUND 950, 1ã  GOTO GetKeyãEND IFããIF Key$ = CHR$(8) THENã  IF LEN(Word$) = 0 THENã    CurX = StartXã    LOCATE CurY, CurXã    IF DoSound = True THEN SOUND 450, 1: SOUND 950, 1ã    GOTO GetKeyã  END IFã  IF CurX = StartX + 1 AND ScrnFull > 1 THENã    ScrnFull = ScrnFull - 1ã    CurX = StartXã    LOCATE CurY, StartXã    'PRINT SpaceC$ã    Word$ = LEFT$(Word$, LEN(Word$) - 1)ã    LOCATE CurY, CurXã    PRINT MID$(Word$, Total * (ScrnFull - 1) + 1, Total);ã    CurX = MaxCol + 1ã    LOCATE , CurXã    GOTO GetKeyã  END IFã  CurX = CurX - 1ã  LOCATE CurY, CurXã  PRINT CHR$(WhatChar);ã  LOCATE CurY, CurXã  Word$ = LEFT$(Word$, LEN(Word$) - 1)ã  GOTO GetKeyãEND IFã  IF CurX > MaxCol THENã    CurX = StartXã    LOCATE CurY, StartXã    PRINT SpaceC$;ã    LOCATE , StartXã    ScrnFull = ScrnFull + 1ã  END IFã  LOCATE CurY, CurX: PRINT Key$;ã  CurX = CurX + 1ã  LOCATE CurY, CurXã  Word$ = Word$ + Key$ã  GOTO GetKeyãEndIt:ã  ReturnStr$ = Word$ã  GetInput$ = Key$ãEND FUNCTIONãRolf Genster                   NUMLOCK TOGGLE IN PB           Rolf@ice.prima.ruhr.de         01-19-96 (13:55)       PB                     57   1155     NUMLOCK.BAS $if 0ãã =========================================================================ãã  Small code for switching NUMLOCK on and offã  written in PowerBasic 3.20ã  by Rolf Genster on 01/19/96ãã  Bit 6 : Caps Lockã  Bit 5 : Num Lock           1 = active, 0 = offã  Bit 4 : Scroll Lockããã  Code for MS-Basics would look like:ã       POKE &H417, PEEK(&H417) OR 32       'NUM-Lock onã     orã       POKE &H417, PEEK(&H417) AND NOT 32  'NUM-Lock offãã =========================================================================ãã$endifãã$lib all offã$optimize speedã$error all offã$cpu 80386ããdefint a-zããa$=lcase$(command$)ããprintããdef seg = 0ãã if instr(a$,"on") > 0 thenã     X = PEEK(&H417)ã     BIT SET X, 5                 ' turn on NUM-Lockã     POKE &H417, Xã     print "Numlock set!"ã  elseif instr(a$,"off") > 0 thenã     X = PEEK( &H417 )ã     BIT RESET X, 5               ' turn off NUM-Lockã     POKE &H417, Xã     print "Numlock reset!"ã  elseã     X = PEEK( &H417 )ã     BIT TOGGLE X, 5              ' toggle NUM-Lockã     POKE &H417, Xã     print "Numlock toggled!"ã end ifããdef segããprintããendãUnknown Author(s)              SPECIAL KEY ASSIGNMENTS        mhscards@aol.com               02-03-96 (00:00)       QB, QBasic, PDS        134  4153     KEYCODES.BI 'FKeyDefs.biã' Special Key AssignmentsããCONST UpKey$ = CHR$(0) + CHR$(72)ãCONST DownKey$ = CHR$(0) + CHR$(80)ãCONST LeftKey$ = CHR$(0) + CHR$(75)ãCONST RightKey$ = CHR$(0) + CHR$(77)ãCONST PageUp$ = CHR$(0) + CHR$(73)ãCONST PageDown$ = CHR$(0) + CHR$(81)ãCONST HomeKey$ = CHR$(0) + CHR$(71)ãCONST EndKey$ = CHR$(0) + CHR$(79)ãCONST InsKey$ = CHR$(0) + CHR$(82)ãCONST DelKey$ = CHR$(0) + CHR$(83)ãCONST EnterKey$ = CHR$(13)ãCONST TabKey$ = CHR$(9)ããCONST sTabKey$ = CHR$(0) + CHR$(15)ããCONST cHomekey$ = CHR$(0) + CHR$(119)ãCONST cEndKey$ = CHR$(0) + CHR$(117)ãCONST cPrtSc$ = CHR$(0) + CHR$(114)ãCONST cLeftKey$ = CHR$(0) + CHR$(115)ãCONST cRightKey$ = CHR$(0) + CHR$(116)ãCONST cUpKey$ = CHR$(0) + CHR$(141)ãCONST cDownKey$ = CHR$(0) + CHR$(145)ãCONST cPageDown$ = CHR$(0) + CHR$(118)ãCONST cPageUp$ = CHR$(0) + CHR$(132)ãCONST cInsert$ = CHR$(0) + CHR$(146)ãCONST cDelete$ = CHR$(0) + CHR$(147)ããCONST ' Function KeysããCONST F1Key$ = CHR$(0) + CHR$(59)ãCONST F2Key$ = CHR$(0) + CHR$(60)ãCONST F3Key$ = CHR$(0) + CHR$(61)ãCONST F4Key$ = CHR$(0) + CHR$(62)ãCONST F5Key$ = CHR$(0) + CHR$(63)ãCONST F6Key$ = CHR$(0) + CHR$(64)ãCONST F7Key$ = CHR$(0) + CHR$(65)ãCONST F8Key$ = CHR$(0) + CHR$(66)ãCONST F9Key$ = CHR$(0) + CHR$(67)ãCONST F10Key$ = CHR$(0) + CHR$(68)ãCONST F11Key$ = CHR$(0) + CHR$(133)ãCONST F12Key$ = CHR$(0) + CHR$(134)ããCONST ' Shifted Function KeysããCONST sF1Key$ = CHR$(0) + CHR$(84)ãCONST sF2Key$ = CHR$(0) + CHR$(85)ãCONST sF3Key$ = CHR$(0) + CHR$(86)ãCONST sF4Key$ = CHR$(0) + CHR$(87)ãCONST sF5Key$ = CHR$(0) + CHR$(88)ãCONST sF6Key$ = CHR$(0) + CHR$(89)ãCONST sF7Key$ = CHR$(0) + CHR$(90)ãCONST sF8Key$ = CHR$(0) + CHR$(91)ãCONST sF9Key$ = CHR$(0) + CHR$(92)ãCONST sF10Key$ = CHR$(0) + CHR$(93)ãCONST sF11Key$ = CHR$(0) + CHR$(135)ãCONST sF12Key$ = CHR$(0) + CHR$(136)ããCONST ' Control Function KeysããCONST cF1Key$ = CHR$(0) + CHR$(94)ãCONST cF2Key$ = CHR$(0) + CHR$(95)ãCONST cF3Key$ = CHR$(0) + CHR$(96)ãCONST cF4Key$ = CHR$(0) + CHR$(97)ãCONST cF5Key$ = CHR$(0) + CHR$(98)ãCONST cF6Key$ = CHR$(0) + CHR$(99)ãCONST cF7Key$ = CHR$(0) + CHR$(100)ãCONST cF8Key$ = CHR$(0) + CHR$(101)ãCONST cF9Key$ = CHR$(0) + CHR$(102)ãCONST cF10Key$ = CHR$(0) + CHR$(103)ãCONST cF11Key$ = CHR$(0) + CHR$(137)ãCONST cF12Key$ = CHR$(0) + CHR$(138)ããCONST ' Alt Function KeysããCONST aF1Key$ = CHR$(0) + CHR$(104)ãCONST aF2Key$ = CHR$(0) + CHR$(105)ãCONST aF3Key$ = CHR$(0) + CHR$(106)ãCONST aF4Key$ = CHR$(0) + CHR$(107)ãCONST aF5Key$ = CHR$(0) + CHR$(108)ãCONST aF6Key$ = CHR$(0) + CHR$(109)ãCONST aF7Key$ = CHR$(0) + CHR$(110)ãCONST aF8Key$ = CHR$(0) + CHR$(111)ãCONST aF9Key$ = CHR$(0) + CHR$(112)ãCONST aF10Key$ = CHR$(0) + CHR$(113)ãCONST aF11Key$ = CHR$(0) + CHR$(139)ãCONST aF12Key$ = CHR$(0) + CHR$(140)ããCONST ' Alt other keysããCONST alt1$ = CHR$(0) + CHR$(120)ãCONST alt2$ = CHR$(0) + CHR$(121)ãCONST alt3$ = CHR$(0) + CHR$(122)ãCONST alt4$ = CHR$(0) + CHR$(123)ãCONST alt5$ = CHR$(0) + CHR$(124)ãCONST alt6$ = CHR$(0) + CHR$(125)ãCONST alt7$ = CHR$(0) + CHR$(126)ãCONST alt8$ = CHR$(0) + CHR$(127)ãCONST alt9$ = CHR$(0) + CHR$(128)ãCONST alt0$ = CHR$(0) + CHR$(129)ãCONST altHyphen$ = CHR$(0) + CHR$(130)ãCONST altEqual$ = CHR$(0) + CHR$(131)ãCONST altQ$ = CHR$(0) + CHR$(16)ãCONST altW$ = CHR$(0) + CHR$(17)ãCONST altE$ = CHR$(0) + CHR$(18)ãCONST altR$ = CHR$(0) + CHR$(19)ãCONST altT$ = CHR$(0) + CHR$(20)ãCONST altY$ = CHR$(0) + CHR$(21)ãCONST altU$ = CHR$(0) + CHR$(22)ãCONST altI$ = CHR$(0) + CHR$(23)ãCONST altO$ = CHR$(0) + CHR$(24)ãCONST altP$ = CHR$(0) + CHR$(25)ããCONST altA$ = CHR$(0) + CHR$(30)ãCONST altS$ = CHR$(0) + CHR$(31)ãCONST altD$ = CHR$(0) + CHR$(32)ãCONST altF$ = CHR$(0) + CHR$(33)ãCONST altG$ = CHR$(0) + CHR$(34)ãCONST altH$ = CHR$(0) + CHR$(35)ãCONST altJ$ = CHR$(0) + CHR$(36)ãCONST altK$ = CHR$(0) + CHR$(37)ãCONST altL$ = CHR$(0) + CHR$(38)ããCONST altZ$ = CHR$(0) + CHR$(44)ãCONST altX$ = CHR$(0) + CHR$(45)ãCONST altC$ = CHR$(0) + CHR$(46)ãCONST altV$ = CHR$(0) + CHR$(47)ãCONST altB$ = CHR$(0) + CHR$(48)ãCONST altN$ = CHR$(0) + CHR$(49)ãCONST altM$ = CHR$(0) + CHR$(50)ãããEric Carr                      SIMULTANEOUS KEY DEMO          FidoNet QUIK_BAS Echo          03-18-96 (13:12)       QB, QBasic, PDS        70   3011     KEYINPUT.BAS'Ok..Here is the sample keyboard routine I promised..I haven't tested it on anyã'other computer excpet mine, but it should work for anyone..  This program letsã'you move a box around by pressing the arrow keys..The acual routine in only 4ã'lines as i have marked..This program requires a minimum of a 486sx 25mhz ifã'not compiled to run fast enough for all the keys to be updated..I alsoã'reprogrammed the internal timer from 18.2 to 30, so I could time it to 30 fps.ã'To see if a key is being currently pressed, the variable KS is used (IFã'KS(75)=1 THEN button is pressed). Instead of ASCII, this uses scan codes,ã'which you can look at in the QB help..Hope you can understand it! :)ãã DEFINT A-Z: DIM B(300): CLSãã N& = 39772                  'Reprogram the timer to 30hzã LB& = N& AND &HFF           'instead of 18.2 (for 30 framesã HB& = (N& / 256) AND &HFF   'per second.)ã OUT &H43, &H3C: OUT &H40, LB&: OUT &H40, HB&ãã DIM KS(255), SC(255), DU(255)ã FOR E = 0 TO 127      ' Setup key data table KSC()ã SC(E) = E: DU(E) = 1ã NEXTã FOR E = 128 TO 255ã SC(E) = E - 128: DU(E) = 0ã NEXTãã SCREEN 13: COLOR 4ã LOCATE 10, 3: PRINT "Keyboard input routine by Eric Carr"ã COLOR 7: PRINT : COLOR 2ã PRINT "  Use the arrow keys to move the box."ã PRINT "Note that you can press two or more keys"ã PRINT "    at once for diagnal movement!"ã PRINT : COLOR 8: PRINT "          Press [Esc] to quit"ã X = 150: Y = 100: BX = X: BY = Yã DEF SEG = 0ã POKE (1132), 0ã GET (X, Y)-(X + 15, Y + 15), Bã DO  'main loopãT:ã I$ = INKEY$       ' So the keyb buffer don't get full     \routine/ã I = INP(&H60)     ' Get keyboard scan code from port 60h   \lines/ã OUT &H61, INP(&H61) OR &H82: OUT &H20, &H20       '         \!!!/ã KS(SC(I)) = DU(I) ' This says what keys are pressed          \!/ã ã IF PEEK(1132) < 1 THEN GOTO T  'If not enough time was passed goto Tã POKE (1132), 0  'reset timer againã BX = X: BY = Yã IF KS(75) = 1 THEN XC = XC - 2: IF XC < -15 THEN XC = -15ã IF KS(77) = 1 THEN XC = XC + 2: IF XC > 15 THEN XC = 15ã IF KS(72) = 1 THEN YC = YC - 2: IF YC < -15 THEN YC = -15ã IF KS(80) = 1 THEN YC = YC + 2: IF YC > 15 THEN YC = 15ã IF XC > 0 THEN XC = XC - 1 ELSE IF XC < 0 THEN XC = XC + 1ã IF YC > 0 THEN YC = YC - 1 ELSE IF YC < 0 THEN YC = YC + 1ã Y = Y + YC: X = X + XCã IF X > 300 THEN X = 300 ELSE IF X < 0 THEN X = 0ã IF Y > 180 THEN Y = 180 ELSE IF Y < 0 THEN Y = 0ã IF X <> BX OR Y <> BY THENã WAIT 936, 8: PUT (BX, BY), B, PSETã GET (X, Y)-(X + 15, Y + 15), B: LINE (X, Y)-(X + 15, Y + 15), 9, BFã END IFã LOOP UNTIL KS(1) = 1 'loop until [Esc] (scan code 1) is pressedãã N& = 65535                      'Program the timer back toã LB& = N& AND &HFF               '18.2hz before exiting!ã HB& = (N& / 256) AND &HFFã OUT &H43, &H3C: OUT &H40, LB&: OUT &H40, HB&ãã OUT &H61, INP(&H61) OR &H82: OUT &H20, &H20ã CLEAR   'need to have this if reprograming the timerã END      'I think this ends the program. I'm not quite sure.. :)ããEric Benson                    DETECT KEYDOWN & KEYUP EVENTS  comp.lang.basic.misc           04-11-96 (18:17)       QB, QBasic, PDS        119  3539     KEYPRESS.BAS'This routine I wrote to detect keydown and keyup events works great (using ã'INP(&H60) as someone suggested a while back). To get the ascii of the key thatã'was pressed I am using INKEY$.  It sometimes returns zero, I guess the BIOSã'hasn't translated the key when I call INKEY$.  But if you run the programã'below you may notice a fairly substantial (0.5 sec) delay sometimes.  ã'Suggestions to get around this?ã'I figure I could load an array with ascii codes and index it with the scancode ã'i.e. ascii=scan2ascii(scancode), but I would still need to take care of the ã'shift key.ã'Or maybe I should run this in straight DOS and not in a Win95 DOS box.ãã'Program Keypress.bas by Eric Benson - April 1996ãDEFINT A-ZãDECLARE SUB KernelKeyPress (scancode AS INTEGER, ascii AS INTEGER, keystate AS INTEGER)ãREM DECLARE SUB BYTECOPY (SEG SOURCE AS ANY, SEG DESTINATION AS ANY, NUMBYTES&)ãCONST TRUE = -1, FALSE = 0ãCONST keybuffermax = 10, kdown = 1, kpressed = 2, kup = 3ãTYPE keyvarã  keyin AS INTEGERã  keyup AS INTEGERã  scancode AS INTEGERã  ascii AS INTEGERã  extended AS INTEGERãEND TYPEããCLSãREM GOTO testãDOã  keystate = 0ã  KernelKeyPress scancode, ascii, keystateã  IF keystate = kdown THENã    PRINT "keydown     "; scancode, asciiã  ELSEIF keystate = kup THENã    PRINT "keyup       "; scancode, asciiã  END IFãLOOP UNTIL scancode = 1ãENDããtest:ã'used to look at what the keyboard is outputingãDOã  keyin = INP(&H60)ã'  LOCATE 1, 1: PRINT "    "ã  LOCATE 1, 1: PRINT keyinã  b$ = INKEY$ãLOOP UNTIL keyin = 1ãENDããSUB KernelKeyPress (scancode AS INTEGER, ascii AS INTEGER, keystate AS INTEGER)ãSTATIC init AS INTEGER, buffer() AS keyvarãSTATIC ibuf AS INTEGER, pressedkey AS INTEGERãIF init THENã  keyin = INP(&H60)ã  b$ = INKEY$ã  'Warning inkey$ above does not always trap the keystrokeã  IF keyin > 128 AND pressedkey THENã    FOR i = 1 TO ibufã      IF keyin = 170 OR buffer(i).keyup = keyin THENã        scancode = buffer(i).scancodeã        ascii = buffer(i).asciiã        keystate = kupã        IF ibuf = 1 THENã          pressedkey = 0ã        ELSEIF i < ibuf THENã          pressedkey = buffer(i).keyupã          FOR j = i TO ibuf - 1ã            SWAP buffer(j), buffer(j + 1)ã          NEXTã          REM BYTECOPY buffer(i + 1), buffer(i), (ibuf - i) * 10ã        ELSEã          'top key in buffer is unpressedã          pressedkey = buffer(i).keyupã        END IFã        ibuf = ibuf - 1ã        EXIT SUBã      END IFã    NEXTã  END IFã  IF pressedkey <> keyin AND keyin < 129 THENã    IF ibuf THENã      FOR i = 1 TO ibufã        IF buffer(i).keyin = keyin THEN EXIT SUBã      NEXTã    END IFã    IF ibuf < keybuffermax THENã      ibuf = ibuf + 1ã      buffer(ibuf).keyin = keyinã      buffer(ibuf).keyup = keyin + 128ã     ã      'Remove this IF..ENDIF block for normal executionã      'Will hang if shift is pressedã      IF LEN(b$) = 0 THENã        DOã          b$ = INKEY$ã        LOOP UNTIL LEN(b$)ã      END IFã     ã      IF LEN(b$) = 2 THENã        buffer(ibuf).extended = ASC(RIGHT$(b$, 1))ã      ELSEIF LEN(b$) THENã        buffer(ibuf).ascii = ASC(b$)ã      ELSEã        buffer(ibuf).ascii = 0ã      END IFã      buffer(ibuf).scancode = keyinã      pressedkey = keyinã      scancode = keyinã      ascii = buffer(ibuf).asciiã      keystate = kdownã      EXIT SUBã    END IFã  END IFãELSEã  DIM buffer(1 TO keybuffermax) AS keyvarã  ibuf = 0ã  pressedkey = 0ã  init = TRUEãEND IFãEND SUBãJeremy Stanley                 LEFT/RIGHT SHIFT (USING BITS)  FidoNet QUIK_BAS Echo          04-13-96 (11:22)       QB, QBasic, PDS        36   916      BITKEY.BAS  '> "There's a byte in the BIOS area, the bits of which say which Ctrl, Alt andã'> Shift keys are depressed.  There's another which helps you differentiate leftã'> from right keys.  But I can't remember what they are... Anyone?"ãã'The first byte in question is at 0040:0017.  This example program shouldã'demonstrate how to read the status of these keys:ããDEFINT A-ZããCLSãPRINT "Byte at 0040:0017  Press ESC to exit"ãPRINT "   - bit 0 - Right shift"ãPRINT "   - bit 1 - Left shift"ãPRINT "   - bit 2 - Ctrl"ãPRINT "   - bit 3 - Alt"ãPRINT "   - bit 4 - Scroll lock"ãPRINT "   - bit 5 - Num lock"ãPRINT "   - bit 6 - Caps lock"ãPRINT "   - bit 7 - Insert"ããDEF SEG = &H40ããDOã  c = PEEK(&H17)ã  FOR x = 0 TO 7ã    LOCATE x + 2, 1ã    e = 2 ^ xã    PRINT (c AND e) \ eã  NEXTãLOOP UNTIL INKEY$ = CHR$(27)ããDEF SEGãã'jeremy.stanley@darkstarbbs.comã'http://pages.prodigy.com/perigee/ããRaymond Joh                    MOUSE AND KEY DEMO             dslayer@worldnet.att.net       05-27-96 (13:08)       QB, PDS                84   2968     KEYNMSE.BAS 'This demo is designed to integrate extended key(as well as normal key)ã'functions into mouse routines. Be sure to load with the QB/L switch toã'make use of the Interrupt Calls.Though setup for QuickBasic, this codeã'can easily be modified for QB.ã'Author : Raymond Johã'Status : Public Domainãã'$INCLUDE: 'qb.bi'ãDECLARE FUNCTION GetKeyBuf$ ()ãDECLARE SUB KeyStroke (keyboard$)ãDEFINT A-Zã'=========================== Demo code(Remove) ============================ãCOLOR 15, 9ãCLSãLOCATE 1, 30: PRINT "Mouse and Key Demo"ãLOCATE 3, 1: PRINT "DEFINED KEYS"ãPRINT STRING$(12, "Í")ãPRINT "<F1 KEY>"ãPRINT "<F3><KEY>"ãPRINT "<F5><KEY>"ãPRINT "<TAB>"ãPRINT "<ENTER>"ãPRINT "<ALT><F>"ãPRINT "<ALT><E>"ãPRINT "<ALT><H>"ãPRINT ""ãPRINT "<ESCAPE> TO EXIT PROGRAM"ãPRINT ""ãPRINT ""ãPRINT "To define your own <Hot> keys. Press any key"ãPRINT "and note the ascii value below.That value will"ãPRINT "need to be defined in the KeyStroke sub."ãLOCATE 24, 14: PRINT "ASCII KEY VALUE";ãCOLOR 0, 7ãLOCATE 25, 1: PRINT STRING$(80, " ");ã'---------------------------- End of Demo Code ----------------------------ãDO    'Remove - For demo use onlyã'============ Place the following two lines in your mouse loop ============ã  keyboard$ = GetKeyBuf$ã  IF keyboard$ <> "" THEN CALL KeyStroke(keyboard$)ãLOOP  'Remove - For demo use onlyãENDããFUNCTION GetKeyBuf$ãDIM InRegs AS RegType, OutRegs AS RegTypeãInRegs.ax = &H600ãInRegs.dx = &HFFãCALL INTERRUPT(&H21, InRegs, OutRegs)ã				 ' No character ready if zero flag setãIF (OutRegs.flags AND 2 ^ 6) THENã  GetKeyBuf$ = ""ãELSEã  IF (OutRegs.ax AND &HFF) <> 0 THENã    GetKeyBuf$ = CHR$(OutRegs.ax AND &HFF)ã  ELSEIF (OutRegs.ax AND &HFF) = 0 THENã    InRegs.ax = &H600ã    InRegs.dx = &HFFã    CALL INTERRUPT(&H21, InRegs, OutRegs)ã    GetKeyBuf$ = CHR$(0) + CHR$(OutRegs.ax AND &HFF)ã  END IFãEND IFãEND FUNCTIONããSUB KeyStroke (keyboard$)ãIF LEN(keyboard$) = 2 THENã  Real.Key% = -ASC(RIGHT$(keyboard$, 1))ãELSEã  Real.Key% = ASC(keyboard$)ãEND IFã'============================== Demo Stuff =============================ãLOCATE 25, 50: PRINT "UNDEFINED";        'Remove - For demo use onlyãLOCATE 25, 20: PRINT Real.Key%;          'Remove - For demo use onlyãã'======================= USER DEFINED KEY AREA =========================ãIF Real.Key% = -59 THEN LOCATE 25, 50: PRINT "<F1 KEY> ";    'F1ãIF Real.Key% = -61 THEN LOCATE 25, 50: PRINT "<F3 KEY> ";    'F3ãIF Real.Key% = -63 THEN LOCATE 25, 50: PRINT "<F5 KEY> ";    'F5ãIF Real.Key% = 27 THEN SYSTEM                                'ESCAPEãIF Real.Key% = 13 THEN LOCATE 25, 50: PRINT "<ENTER>  ";     'ENTERãIF Real.Key% = 9 THEN LOCATE 25, 50: PRINT "<TAB KEY>";      'TABãIF Real.Key% = -33 THEN LOCATE 25, 50: PRINT "<ALT><F> ";    '<ALT><F>ãIF Real.Key% = -18 THEN LOCATE 25, 50: PRINT "<ALT><E> ";    '<ALT><E>ãIF Real.Key% = -35 THEN LOCATE 25, 50: PRINT "<ALT><H> ";    '<ALT><H>ãEND SUBãJason Laviska                  KEYBOARD LIGHT CONTROL         jason.laviska@outdoor.com      06-12-96 (08:05)       QB, QBasic, PDS        53   1596     KEYLITE.BAS 'Controlling the keyboard light indicators by Jason Laviska.ã'LaserArts' Library Function K-02-Bã'--- Public Domain --- Use at your own risk ---ãã'     This is a very short subprogram I made that will enable/disableã'the Num, Caps, and Scroll lock indicators on your keyboard.  All youã'have to do is to call the Keylite subprogram with a integer from 0 toã'7 and your keyboard lights will automatically adjust.  If you enterã'any other number using this subprogram, it will not do anything.  Iã'have found that Keylite works successfully if the user presses a key,ã'if Basic askes for a key (such as using Inkey$), or any other way youã'can think of to talk to the 8042-based keyboard controller chip.ã'This has been successfully tested using a 101-key enhanced keyboard.ã'This will not work on the original 83-key PC/XT keyboards that areã'not bidirectional.ããCLSãPRINT "Press any key to begin keyboard demostration. :)"ãSLEEPãCLSãFOR Temp% = 0 TO 7ã  Keylite Temp%ã  Temp$ = INKEY$ã  PRINT "Mode"; Temp%, "Press any key."ã  SOUND 1000, .3ã  SLEEP (5)ãNEXT Temp%ããSUB Keylite (KeyMode%)ãã'KeyMode% ... Valid values must be in the range of 0 to 7.ãã'Cap   Num   Scr = KeyMode%ã'---   ---   ---   --------ã' 0     0     0       0ã' 0     0     1       1ã' 0     1     0       2ã' 0     1     1       3ã' 1     0     0       4ã' 1     0     1       5ã' 1     1     0       6ã' 1     1     1       7ãã' 0 = Inactiveã' 1 = ActiveããIF KeyMode% > -1 AND KeyMode% < 8 THENã  DEF SEG = 0ã  POKE &H417, (KeyMode% * 16) + 128ã  DEF SEGãEND IFããEND SUBãSteven Sensarn                 KEYBOARD ISR                   comp.lang.basic.misc           06-22-96 (22:14)       QB, QBasic, PDS        162  7658     KEYISR.BAS  'Here is a nice program that uses its own ISR to handle keyboard I/O.  ã'Normally, BIOS handles interrupt calls from the keyboard.  Unfortunately, ã'BIOS is relatively slow and often cannot catch up with the user pressing the ã'keys on the keyboard.  This results in a keyboard buffer overflow and the PC ã'starts beeping (it's happend to all of us).  To correct this error, the ã'programmer writes his own ISR (interrupt service routine) and replaces the ã'old ISR with it.  The keyboard is connected to IRQ1 (or it should be--if ã'you're having keyboard problems, that might be the reason).  Therefore, the ã'ISR must be connected to interrupt 9h (IRQ1's alias).  Enjoy!ããDECLARE SUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ãDECLARE SUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ãDECLARE SUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)ãDECLARE SUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)ãã'$STATICããDIM RAWKEY AS INTEGERãDIM OLD.ISR.SEG AS INTEGER, OLD.ISR.OFF AS INTEGERããCALL KEYBOARD.IN(OLD.ISR.SEG, OLD.ISR.OFF)ããDOã    PRINT RAWKEY 'DISPLAY SCANCODE OF LAST KEY PRESSEDã                 'NOTICE THAT EACH KEY HAS A PRESS AND RELEASE CODEãLOOP UNTIL RAWKEY = 1ããCALL KEYBOARD.OUT(OLD.ISR.SEG, OLD.ISR.OFF)ããSUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ãã    'GETVECT RETURNS THE ADDRESS OF A FUNCTION POINTED TO IN THEã    'INTERRUPT VECTOR TABLE (STARTS AT 0000:0000H)ãã    STATIC ASM AS STRING 'THE CODE FOR GETVECTãã    STATIC INI AS INTEGER 'USED TO DETECT WHETHER GETVECT HAS PREVIOUSLYã                          'BEEN CALLEDã    IF INI = 0 THENã        ã        'CREATE ML FUNCTION IF NOT ALREADY CREATEDãã        ASM = ASM + CHR$(&H55)                          'PUSH    BPã        ASM = ASM + CHR$(&H89) + CHR$(&HE5)             'MOV     BP,SPã        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV     BX,[BP+06]ã        ASM = ASM + CHR$(&H8A) + CHR$(&H7)              'MOV     AL,[BX]ã        ASM = ASM + CHR$(&HB4) + CHR$(&H35)             'MOV     AH,35ã        ASM = ASM + CHR$(&HCD) + CHR$(&H21)             'INT     21ã        ASM = ASM + CHR$(&H53)                          'PUSH    BXã        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV     BX,[BP+0A]ã        ASM = ASM + CHR$(&H8C) + CHR$(&H7)              'MOV     [BX],ESã        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV     BX,[BP+08]ã        ASM = ASM + CHR$(&H58)                          'POP     AXã        ASM = ASM + CHR$(&H89) + CHR$(&H7)              'MOV     [BX],AXã        ASM = ASM + CHR$(&H5D)                          'POP     BPã        ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'RETF    0006ã        INI = 1 'FLAG CREATIONã    END IFãã    DEF SEG = VARSEG(ASM)ã    CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN FUNCTIONãEND SUBããSUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)ã    SHARED RAWKEY AS INTEGER 'GLOBAL VARIABLE HOLDS SCANCODEãã    DIM SGL AS INTEGER, SGH AS INTEGER 'SEGMENT OF RAWKEYã    DIM OFL AS INTEGER, OFH AS INTEGER 'OFFSET OF RAWKEYãã    DIM BYTE AS STRING * 1 'USED TO ACTIVATE IRQ 1 IN PICãã    STATIC ASM AS STRING 'HOLDS ISRãã    SGL = VARSEG(RAWKEY) AND &HFF 'LOAD LOW "BYTE" SEGMENTã    SGH = INT(VARSEG(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENTãã    OFL = VARPTR(RAWKEY) AND &HFF 'LOAD LOW "BYTE" OFFSETã    OFH = INT(VARPTR(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSETãã    'THIS IS THE ISR.  IT READS A SCANCODE FROM THE KEYBOARD BUFFERã    'AND RESETS IT.  THE BEST PART IS, BIOS CAN'T TOUCH IT!ãã    ASM = ""ã    ASM = ASM + CHR$(&H52)                          'PUSH DXã    ASM = ASM + CHR$(&H51)                          'PUSH CX      ã    ASM = ASM + CHR$(&H53)                          'PUSH BXã    ASM = ASM + CHR$(&H50)                          'PUSH AXã    ASM = ASM + CHR$(&H6)                           'PUSH ESã    ASM = ASM + CHR$(&H57)                          'PUSH DIã    ASM = ASM + CHR$(&H1E)                          'PUSH DSã    ASM = ASM + CHR$(&H56)                          'PUSH SIã    ASM = ASM + CHR$(&HFB)                          'STIã    ASM = ASM + CHR$(&HBA) + CHR$(&H60) + CHR$(&H0) 'MOV DX,0060ã    ASM = ASM + CHR$(&HEC)                          'IN AL,DXã    ASM = ASM + CHR$(&H30) + CHR$(&HE4)             'XOR AH,AHã    ASM = ASM + CHR$(&HBA) + CHR$(SGL) + CHR$(SGH)  'MOV DX,SEG RAWKEYã    ASM = ASM + CHR$(&H8E) + CHR$(&HDA)             'MOV DS,DXã    ASM = ASM + CHR$(&HBE) + CHR$(OFL) + CHR$(OFH)  'MOV SI,OFFSET RAWKEYã    ASM = ASM + CHR$(&H88) + CHR$(&H4)              'MOV [SI],ALã    ASM = ASM + CHR$(&HBA) + CHR$(&H61) + CHR$(&H0) 'MOV DX,0061ã    ASM = ASM + CHR$(&HEC)                          'IN AL,DXã    ASM = ASM + CHR$(&HC) + CHR$(&H82)              'OR AL,82ã    ASM = ASM + CHR$(&HEE)                          'OUT DX,ALã    ASM = ASM + CHR$(&H24) + CHR$(&H7F)             'AND AL,7Fã    ASM = ASM + CHR$(&HEE)                          'OUT DX,ALã    ASM = ASM + CHR$(&HB0) + CHR$(&H20)             'MOV AL,20ã    ASM = ASM + CHR$(&HBA) + CHR$(&H20) + CHR$(&H0) 'MOV DX,0020ã    ASM = ASM + CHR$(&HEE)                          'OUT DX,ALã    ASM = ASM + CHR$(&H5E)                          'POP SIã    ASM = ASM + CHR$(&H1F)                          'POP DSã    ASM = ASM + CHR$(&H5F)                          'POP DIã    ASM = ASM + CHR$(&H7)                           'POP ESã    ASM = ASM + CHR$(&H58)                          'POP AXã    ASM = ASM + CHR$(&H5B)                          'POP BXã    ASM = ASM + CHR$(&H59)                          'POP CXã    ASM = ASM + CHR$(&H5A)                          'POP DXã    ASM = ASM + CHR$(&HCF)                          'IRETãã    BYTE = CHR$(INP(&H21)) 'LOAD IRQ ENABLE REGISTER IN PICãã    OUT &H21, (ASC(BYTE) AND (255 XOR 2)) 'CLEAR BIT 2 (IRQ 1)ãã    CALL GETVECT(OLDSEG, OLDOFF, &H9) 'LOAD OLD ISRã    CALL SETVECT(VARSEG(ASM), SADD(ASM), &H9) 'STORE NEW ISRãEND SUBããSUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)ã    CALL SETVECT(OLDSEG, OLDOFF, &H9) 'RESTORE OLD ISRãEND SUBããSUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ãã    'SETVECT CHANGES THE ADDRESSES IN THE INTERRUPT VECTOR TABLEã    'TO POINT TO NEW FUNCTIONSãã    STATIC ASM AS STRING 'HOLDS THE SETVECT FUNCTIONã    STATIC INI AS INTEGER 'USED TO TEST WHETHER OR NOT FUNCTION HAS PREVOUSLYã                          'BEEN CALLEDã    IF INI = 0 THENãã        'CREATE FUNCTION IF NOT ALREADY CREATEDãã        ASM = ""ã        ASM = ASM + CHR$(&H55)                          'PUSH BPã        ASM = ASM + CHR$(&H89) + CHR$(&HE5)             'MOV BP,SPã        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]ã        ASM = ASM + CHR$(&H8B) + CHR$(&H17)             'MOV DX,[BX]ã        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]ã        ASM = ASM + CHR$(&H8A) + CHR$(&H7)              'MOV AL,[BX]ã        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0A]ã        ASM = ASM + CHR$(&H1E)                          'PUSH DSã        ASM = ASM + CHR$(&H8E) + CHR$(&H1F)             'MOV DS,[BX]ã        ASM = ASM + CHR$(&HB4) + CHR$(&H25)             'MOV AH,25ã        ASM = ASM + CHR$(&HCD) + CHR$(&H21)             'INT 21ã        ASM = ASM + CHR$(&H1F)                          'POP DSã        ASM = ASM + CHR$(&H5D)                          'POP BPã        ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'RETF 0006ã        INI = 1 'FLAG CREATIONã    END IFã    DEF SEG = VARSEG(ASM)ã    CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN SETVECTãEND SUBãCharlie Quante                 A FILTERED INKEY$ ROUTINE      charlie@charlie.seanet.com     11-05-96               QB, QBasic, PDS        66   2503     TESTKEY.BAS 'FULL Header Extraction for this Source Code has been Enabledã' A sample program to demonstrate the TestKey subroutine.ããDECLARE SUB TestKey (KeyFlag%, CaseFlag%, KeysAccepted$)ãã    CLSã    DEFINT A-Zã'----------------------------------------------------------------------------ã'   Prompt the user for a number from 1 to 4.ã'   call TestKey - CaseFlag is unimportant for this example.ã'   Print the number of the item selected.ãã    PRINT "Select a number from 1 to 4: "ã    TestKey KeyFlag, -1, "1234"ã    PRINT "You selected item"; KeyFlagã'----------------------------------------------------------------------------  ãã'   Prompt the user for a letter from A to Zã'   Call TestKey - Note: Notice that you can have a combination of upper andã'                        lowercase letters.ã'   In this example CaseFlag is set to -1 and any key pressed is convertedã'   into uppercase. The same applies to the KeysAccepted$ string.ã'   Convert the number returned by KeyFlag back into a letter.ãã    PRINTã    PRINT "Select a letter from A to Z: "ã    TestKey KeyFlag, -1, "ABCDEfghijklmnopqrstuvwxyz"ã    PRINT "You selected letter "; CHR$(34); CHR$(KeyFlag + 64); CHR$(34)ã'----------------------------------------------------------------------------ã  ã'   Now CaseFlag is set to 0, and the user must enter either an uppercaseã'   A through E, or a lowercase f through zãã    PRINTã    PRINT "Okay, select another letter from A to Z: "ã    TestKey KeyFlag, 0, "ABCDEfghijklmnopqrstuvwxyz"ã    PRINT "You selected letter "; CHR$(34); CHR$(KeyFlag + 64); CHR$(34)ããSUB TestKey (KeyFlag, CaseFlag, KeysAccepted$)ã'Purpose: ã'           Get input from the user, and test it to see if it is one ofã'           the keys that are acceptable.ã'Variables:ã'           CaseFlag      - If CaseFlag is -1 then all input, is convertedã'                           to uppercase.ã'           KeyFlag       - Returns a number indicating which acceptable keyã'                           was pressed.ã'           KeysAccepted$ - Holds the acceptable keys.ã'           GetKey$ - Gets the key pressed via the INKEY$ command. ããã    KeyFlag = 0ã    IF CaseFlag THEN KeysAccepted$ = UCASE$(KeysAccepted$)ãã    DO WHILE KeyFlag = 0ã        GetKey$ = ""ã       ã        DO WHILE GetKey$ = ""ã            GetKey$ = INKEY$ã        LOOPã       ã        IF CaseFlag THEN GetKey$ = UCASE$(GetKey$)ã        KeyFlag = INSTR(KeysAccepted$, GetKey$)ã    LOOPãEND SUBããChris McKenzie                 CHECK ASCII CHARACTER CODE     unknown@sprynet.com            12-29-96 (14:06)       QB, QBasic, PDS        34   1067     CHKASC.BAS  'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄã' This is a seemingly useless program, run it to find out what it is.ã'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄããCLSãFOR WaitFiveSeconds% = 5 TO 1 STEP -1ã  LOCATE 1, 1: PRINT "Press key and HOLD.  You have"; WaitFiveSeconds%;"seconds to choose key."ã  SLEEP 1ãNEXT WaitFiveSeconds%ãCLSããFOR KeyBeingChecked = 1 TO 255ã  Button$ = INKEY$ã  SLEEP 1ã  IF Button$ = CHR$(KeyBeingChecked) THEN GOTO ItHasBeenFoundã  LOCATE 1, 1: PRINT "Checking code"; KeyBeingCheckedã  PercentDone = (KeyBeingChecked / 255) * 100 MOD 100ã  LOCATE 2.1: PRINT PercentDone; "% done."ãNEXT KeyBeingCheckedããNotFound:             ã  CLSã  PRINT "I'm sorry but the Ascii character code was not found."ã  GOTO FinalããItHasBeenFound:ã  CLSã  PRINT "The key has been found!  It is Ascii character"; KeyBeingChecked;ã  GOTO FinalããFinal:ã  PRINT "Press [Esc] to quit."ãNotPressingAButton: Button$ = INKEY$: IF Button$ <> CHR$(27) THEN GOTO NotPressingAButtonãENDãNick Kochakian                 KEY GENERATOR                  NickK@worldnet.att.net         02-12-97 (15:23)       QB, QBasic, PDS        314  3850     KEYGETR.BAS '----------------------------------------------------------------------------ã'Fast key getterã'ã'1/20/97ã'1997 By: - Nick Kochakian -ã'ã'Use this to get keys for a game, etc.ã'ã'If you have any comments or questions please e-mail me at:ã'ã'nickK@worldnet.att.netã'ã'Have fun! :)ã'----------------------------------------------------------------------------ãã'To exit just press: ESC -> ( CHR$(27) )ãã'How to use the information with your program:ã'Say the computer returns something like this:ã'CHR$( 0 ) + ;ã'What you'd need to enter into your program to make it work would be:ã'IF A$=CHR$(0)+; THEN  ,etc...ããCLSããA = 255ãDIM A$(A)ãFOR A = 1 TO 255ãREAD A$(A)ãNEXT AããA = 1ããPRINT "Press any key... Press ESC to exit..."ãDOããDOãA$(A) = INKEY$ãLOOP UNTIL A$(A) <> ""ãPRINT "CHR$(";ãPRINT ASC(A$(A));ãPRINT ") + "; A$(A)ã'A$(A) = INEKY$ãLOOP UNTIL A$(A) = CHR$(27)ããã'Up: IF a$(a) = CHR$(0) + "H" THEN BEEPã'Down: IF a$(a) = CHR$(0) + "P" THEN BEEPã'CHR$(0)+"K"  <- Leftã'CHR$(0)+"M"  <- Rightã'CHR$(0)+";"  <- F1ã'all chr$(0)+""""" from hereã'< <- F2ã'= <- F3ã'> <- F4ã'? <- F5ã'@ <- F6ããENDãDATA  1ãDATA  2ãDATA  3ãDATA  4ãDATA  5ãDATA  6ãDATA  7ãDATA  8ãDATA  9ãDATA  10ãDATA  11ãDATA  12ãDATA  13ãDATA  14ãDATA  15ãDATA  16ãDATA  17ãDATA  18ãDATA  19ãDATA  20ãDATA  21ãDATA  22ãDATA  23ãDATA  24ãDATA  25ãDATA  26ãDATA  27ãDATA  28ãDATA  29ãDATA  30ãDATA  31ãDATA  32ãDATA  33ãDATA  34ãDATA  35ãDATA  36ãDATA  37ãDATA  38ãDATA  39ãDATA  40ãDATA  41ãDATA  42ãDATA  43ãDATA  44ãDATA  45ãDATA  46ãDATA  47ãDATA  48ãDATA  49ãDATA  50ãDATA  51ãDATA  52ãDATA  53ãDATA  54ãDATA  55ãDATA  56ãDATA  57ãDATA  58ãDATA  59ãDATA  60ãDATA  61ãDATA  62ãDATA  63ãDATA  64ãDATA  65ãDATA  66ãDATA  67ãDATA  68ãDATA  69ãDATA  70ãDATA  71ãDATA  72ãDATA  73ãDATA  74ãDATA  75ãDATA  76ãDATA  77ãDATA  78ãDATA  79ãDATA  80ãDATA  81ãDATA  82ãDATA  83ãDATA  84ãDATA  85ãDATA  86ãDATA  87ãDATA  88ãDATA  89ãDATA  90ãDATA  91ãDATA  92ãDATA  93ãDATA  94ãDATA  95ãDATA  96ãDATA  97ãDATA  98ãDATA  99ãDATA  100ãDATA  101ãDATA  102ãDATA  103ãDATA  104ãDATA  105ãDATA  106ãDATA  107ãDATA  108ãDATA  109ãDATA  110ãDATA  111ãDATA  112ãDATA  113ãDATA  114ãDATA  115ãDATA  116ãDATA  117ãDATA  118ãDATA  119ãDATA  120ãDATA  121ãDATA  122ãDATA  123ãDATA  124ãDATA  125ãDATA  126ãDATA  127ãDATA  128ãDATA  129ãDATA  130ãDATA  131ãDATA  132ãDATA  133ãDATA  134ãDATA  135ãDATA  136ãDATA  137ãDATA  138ãDATA  139ãDATA  140ãDATA  141ãDATA  142ãDATA  143ãDATA  144ãDATA  145ãDATA  146ãDATA  147ãDATA  148ãDATA  149ãDATA  150ãDATA  151ãDATA  152ãDATA  153ãDATA  154ãDATA  155ãDATA  156ãDATA  157ãDATA  158ãDATA  159ãDATA  160ãDATA  161ãDATA  162ãDATA  163ãDATA  164ãDATA  165ãDATA  166ãDATA  167ãDATA  168ãDATA  169ãDATA  170ãDATA  171ãDATA  172ãDATA  173ãDATA  174ãDATA  175ãDATA  176ãDATA  177ãDATA  178ãDATA  179ãDATA  180ãDATA  181ãDATA  182ãDATA  183ãDATA  184ãDATA  185ãDATA  186ãDATA  187ãDATA  188ãDATA  189ãDATA  190ãDATA  191ãDATA  192ãDATA  193ãDATA  194ãDATA  195ãDATA  196ãDATA  197ãDATA  198ãDATA  199ãDATA  200ãDATA  201ãDATA  202ãDATA  203ãDATA  204ãDATA  205ãDATA  206ãDATA  207ãDATA  208ãDATA  209ãDATA  210ãDATA  211ãDATA  212ãDATA  213ãDATA  214ãDATA  215ãDATA  216ãDATA  217ãDATA  218ãDATA  219ãDATA  220ãDATA  221ãDATA  222ãDATA  223ãDATA  224ãDATA  225ãDATA  226ãDATA  227ãDATA  228ãDATA  229ãDATA  230ãDATA  231ãDATA  232ãDATA  233ãDATA  234ãDATA  235ãDATA  236ãDATA  237ãDATA  238ãDATA  239ãDATA  240ãDATA  241ãDATA  242ãDATA  243ãDATA  244ãDATA  245ãDATA  246ãDATA  247ãDATA  248ãDATA  249ãDATA  250ãDATA  251ãDATA  252ãDATA  253ãDATA  254ãDATA  255ãJoe Huber, Jr.                 MULTIPLE KEYS                  huberjjr@nicom.com             03-08-97 (13:07)       QB, QBasic, PDS        97   3058     MULTIKEY.BASDECLARE FUNCTION MULTIKEY (KEYNUM)ãã'MUTIKEY FUNCTION - LETS YOU TRAP SEVERAL KEYS AT ONCE (BETTER THAN INKEY$!!)ã'ã'USAGE:ã'  riable=MULTIKEY(KEYNUM)ã'WHERE KEYNUM IS THE KEY YOU WANT TO TRAPã'  riable = 1 IF KEY IS DEPRESSED, 0 IF IT ISN'Tã'ã'EMAIL ME AT: huberjjr@nicom.comã'ã'HAVE FUN!!!ãããDIM SHARED KEYS(255), SC(255), DU(255)  'ALWAYS NEED THIS!!!ããCLSããX = 10: Y = 10ãXX = X: YY = YããDOãã'FOR I = 1 TO 255                    '\ã' TEST = MULTIKEY(I)                 ' |-TEST LOOPã' LOCATE 1, 1: PRINT TEST; I         ' |ã' WHILE INKEY$ = "": WEND            ' | PRESS KEY IN QUESTION UNTILã'  IF TEST = 1 THEN END              ' | LOOP ENDS. THE SECOND NUMBER IS THEã'NEXT I                              '/  SCAN CODE FOR MULTIKEYããRIGHT = MULTIKEY(75)    ' GET SOME KEYS' STATUSESãLEFT = MULTIKEY(77)ãUP = MULTIKEY(72)ãDOWN = MULTIKEY(80)ãSPACE = MULTIKEY(57)ãESC = MULTIKEY(1)ããIF ESC = 1 THEN END    'TEMINATE WHEN ESCAPE IS PRESSEDããIF TIMELOOP = 100 THEN             'THIS MOVES YOU AROUNDã IF RIGHT = 1 THEN X = X - 1ã IF LEFT = 1 THEN X = X + 1        'THE TIMELOOP   RIABLE DELAYSã IF UP = 1 THEN Y = Y - 1          'MOVEMENT WITHOUT SLOWING DOWNã IF DOWN = 1 THEN Y = Y + 1        'INPUT (WITHOUT IT YOU WOULD GOã TIMELOOP = 0                      'WAAAAYYY TOO FAST)ãEND IFããIF X >= 80 THEN X = 80        'KEEPS YOU FROM GOING OFF THE SCREEN ANDãIF X <= 0 THEN X = 1          'MAKING AN ERRORãIF Y >= 23 THEN Y = 23ãIF Y <= 0 THEN Y = 1ãããIF SPACE = 1 THEN                    'CHANGES YOUTR SHAPE WHENã LOCATE Y, X: PRINT CHR$(94)         'YOU HIT SPACEãELSEã LOCATE Y, X: PRINT CHR$(127)ãEND IFããIF XX <> X OR YY <> Y THEN           'UPDATES YOUR POSITIONã LOCATE YY, XX: PRINT " "ã LOCATE Y, X: PRINT CHR$(127)ãEND IFãããXX = X: YY = Y                     'TELLS ME WHERE I WAS LASTããTIMELOOP = TIMELOOP + 1ããLOOP                 'LOOP (DUH...) :)ãã'THANX TO Eric Carr FOR FIGURING OUT HOW TO TRAP SEVERAL KEYS AT ONCEã'EVERYTHING ELSE WRITTEN BY ME,              ããFUNCTION MULTIKEY (KEYNUM)ãã STATIC FIRSTIMEãã IF FIRSTIME = 0 THENã  FOR E = 0 TO 127              '\ã  SC(E) = E: DU(E) = 1          '|ã  NEXT                          '|-ERIC CARR'S CODE--------------------\ã  FOR E = 128 TO 255            '|                                     |ã  SC(E) = E - 128: DU(E) = 0    '|                                     |ã  NEXT                          '/                                     |ã  FIRSTIME = -1                 '                                      |ã END IF                         '                                      |ã                                '                                      |ã I$ = INKEY$       ' So the keyb buffer don't get full     \routine/ \ |ã I = INP(&H60)     ' Get keyboard scan code from port 60h   \lines/  |-/ã OUT &H61, INP(&H61) OR &H82: OUT &H20, &H20       '         \!!!/   |ã KEYS(SC(I)) = DU(I) ' This says what keys are pressed        \!/    /ããMULTIKEY = KEYS(KEYNUM)ãããEND FUNCTIONãJoe Huber, Jr.                 MULTIKEY FUNCTION UPDATE       huberjjr@nicom.com             05-13-97 (14:46)       QB, QBasic, PDS        127  3287     MULTIKEY.BASDECLARE SUB KEYTEST (LOWERLIMIT!, UPPERLIMIT!)ãDECLARE FUNCTION MULTIKEY (KEYNUM)ãã'MUTIKEY FUNCTION - LETS YOU TRAP SEVERAL KEYS AT ONCE (BETTER THAN INKEY$!!)ã'ã'USAGE:ã'  riable=MULTIKEY(KEYNUM)ã'WHERE KEYNUM IS THE KEY YOU WANT TO TRAPã'  riable = 1 IF KEY IS DEPRESSED, 0 IF IT ISN'Tã'ã'CALL KEYTEST(lower,upper)ã'Use this to find new keycodesã'(unrem below to test)ãã' CALL KEYTEST(1, 200)ãã'Gives all keynums between 1 & 200ã'If the 0 by the number becomes a 1, then the key with that keycode isã'currently being depressedãã'EMAIL ME AT: huberjjr@nicom.comã'ã'HAVE FUN!!!ãã'ããããCLSããX = 10: Y = 10ãXX = X: YY = YããDOããRIGHT = MULTIKEY(75)    ' GET SOME KEYS' STATUSESãLEFT = MULTIKEY(77)ãUP = MULTIKEY(72)ãDOWN = MULTIKEY(80)ãSPACE = MULTIKEY(57)ãESC = MULTIKEY(1)ããIF ESC = 1 THEN END    'TEMINATE WHEN ESCAPE IS PRESSEDããIF TIMELOOP = 100 THEN             'THIS MOVES YOU AROUNDã IF RIGHT = 1 THEN X = X - 1ã IF LEFT = 1 THEN X = X + 1        'THE TIMELOOP   RIABLE DELAYSã IF UP = 1 THEN Y = Y - 1          'MOVEMENT WITHOUT SLOWING DOWNã IF DOWN = 1 THEN Y = Y + 1        'INPUT (WITHOUT IT YOU WOULD GOã TIMELOOP = 0                      'WAAAAYYY TOO FAST)ãEND IFããIF X >= 80 THEN X = 80        'KEEPS YOU FROM GOING OFF THE SCREEN ANDãIF X <= 0 THEN X = 1          'MAKING AN ERRORãIF Y >= 23 THEN Y = 23ãIF Y <= 0 THEN Y = 1ãããIF SPACE = 1 THEN                    'CHANGES YOUTR SHAPE WHENã LOCATE Y, X: PRINT CHR$(94)         'YOU HIT SPACEãELSEã LOCATE Y, X: PRINT CHR$(127)ãEND IFããIF XX <> X OR YY <> Y THEN           'UPDATES YOUR POSITIONã LOCATE YY, XX: PRINT " "ã LOCATE Y, X: PRINT CHR$(127)ãEND IFãããXX = X: YY = Y                     'TELLS ME WHERE I WAS LASTããTIMELOOP = TIMELOOP + 1ããLOOP                 'LOOP (DUH...) :)ãã'THANX TO Eric Carr FOR FIGURING OUT HOW TO TRAP SEVERAL KEYS AT ONCEã'EVERYTHING ELSE WRITTEN BY ME,              ããSUB KEYTEST (LOWERLIMIT, UPPERLIMIT)ãããDOãX = 1ãY = 1ãã FOR I = LOWERLIMIT TO UPPERLIMITã  TEST = MULTIKEY(I)ã  LOCATE Y, Xã  PRINT TEST; Iã ã  IF Y < 23 THENã   Y = Y + 1ã  ELSEã   Y = 1ã   X = X + 7ã  END IFã NEXT IããLOOP WHILE MULTIKEY(1) = 0ãENDãEND SUBããFUNCTION MULTIKEY (KEYNUM)ãã STATIC FIRSTIME, KEYS(), SC(), DU()ãã IF FIRSTIME = 0 THENã  DIM KEYS(255), SC(255), DU(255)ã  FOR E = 0 TO 127              '\ã  SC(E) = E: DU(E) = 1          '|ã  NEXT                          '|-ERIC CARR'S CODE--------------------\ã  FOR E = 128 TO 255            '|                                     |ã  SC(E) = E - 128: DU(E) = 0    '|                                     |ã  NEXT                          '/                                     |ã  FIRSTIME = -1                 '                                      |ã END IF                         '                                      |ã                                '                                      |ã I$ = INKEY$       ' So the keyb buffer don't get full     \routine/ \ |ã I = INP(&H60)     ' Get keyboard scan code from port 60h   \lines/  |-/ã OUT &H61, INP(&H61) OR &H82: OUT &H20, &H20       '         \!!!/   |ã KEYS(SC(I)) = DU(I) ' This says what keys are pressed        \!/    /ããMULTIKEY = KEYS(KEYNUM)ãããEND FUNCTIONãRobert Fortune                 KEYBOARD PORT TO SET DELAY     Ethan Winer's BASIC Techniques 07-01-97 (19:00)       QB, QBasic, PDS        45   2220     KEYPORTS.BAS'>I am making this "action"-game, where you have to avoid asteroids to getã'>points. However, I don't know how to get rid of keyboard delay, which isã'>VERY disturbing in a game like this. Does anyone know to get completelyã'>rid of it? I have gotten it to minimum with DOS-command:ã'>"mode con rate=32 delay=1", but there is still delay. Can anyone helpã'>me?ãã'   From Ethan Winer's book "BASIC: Techniques and Utilities" (availableã'   in freeware form in the WINER.ZIP file):ãã'   Keyboard Portsãã'   There are several ports associated with the keyboard, and one is ofã'   particular interest. The enhanced keyboards that come with AT-classã'   and later computers allow you to control how quickly keystrokes areã'   repeated automatically. There are actually two values - one sets theã'   initial delay before keys begin to repeat, and the other establishesã'   the repeat rate. By sending the correct values through the keyboardã'   port, you can control the keyboard's typematic response. The completeã'   program that follows shows how to do this, and Table 10.3 shows howã'   the delay and repeat values are determined.ãã   OUT &H60, &HF3        ' get keyboard's attentionã   FOR D& = 1 TO 100     ' brief delay to give the hardware time to settleã   NEXTãã   Value = 7             ' 1/4 second initial delay, 16 CPSã   OUT &H60, Valueãã'   Table 10.3 shows only some of the possible values that can be used.ã'   However, you can interpolate additional values for delay times andã'   repeat rates between those shown.ãã'  Table 10.3ã'  Sample Values for Setting the initial and Repeat Rate on AT-Style Keyboardã'  --------------------------------------------------------------------------ã'     Initial Delay                 0.25  0.50  0.75  1.00ã'     30 characters per second       00    20    40    60ã'     16 characters per second       07    27    47    67ã'      8 characters per second       0F    2F    4F    6Fã'      4 characters per second       17    37    57    77ã'      2 characters per second       1F    3F    5F    7Fãã'     Note: All values are shown in hexadecimalã'  ---------------------------------------------------------------------------ãKerry S. Goodin                TEST KEYBOARD BUFFER FOR CHAR  medvrsys@venus.net             08-19-97 (09:59)       QB, PDS                33   1547     INSTAT.BAS  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''ã' -----Instat.bas----                                                      'ã' Function to test the keyboard buffer to see if a character is present.   'ã'                                                                          'ã' ( A key has been pressed).                                               'ã' It will not read the character but will return -1 if there is a          'ã' character or 0 is there is not a character in the buffer thus leaving    'ã' the buffer undisturbed.  This mimics the same function in PowerBasic(c)  'ã' but for QB 4.5.                                                          'ã' Written by: Kerry S. Goodin, D.D.S.                                      'ã'                                                                          'ã' USE AT YOUR OWN RISK.                                                    'ã'                                                                          'ã'note: start QB with the /L QB switch                                      'ã'                                                                          'ã''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''ããDEFINT A-ZãDECLARE FUNCTION instat ()ãã'$INCLUDE: 'c:\qb45\qb.bi'ããDIM SHARED inRegs AS RegType, outRegs AS RegTypeããFUNCTION instatã	inRegs.ax = &HB00ã	CALL INTERRUPT(&H21, inRegs, outRegs)ã	IF (outRegs.ax AND &HFF) <> 0 THENã		instat = -1ã	ELSEã		instat = 0ã	END IFãEND FUNCTIONãTommi Utriainen                CAPS ON/OFF ROUTINE            tomppa@pcuf.fi                 09-14-97 (21:42)       QB, QBasic, PDS        28   508      CAPS.BAS       ' caps on/offã   ' PRG BY TOMPPA 92ãã   CLSãã                ' 0 normalã                ' 1 shift-ã                ' 2 shift-ã                ' 4 Ctrl-ã                ' 8 Alt-ã                ' 16 scroll lockã                ' 32 numlockã                ' 64 CAPSLOCK ã                ' 128 -ã                ' 256 -ãã   DEF SEG = 0ã   POKE &H417, 0ã   DEF SEGããã   LINE INPUT "lowecase:"; text$ãã   DEF SEG = 0ã   POKE &H417, 64ã   DEF SEGãã   LINE INPUT "uppercase:"; text$ãJoe Huber, Jr.                 NEW ASSEMBLY MULTIKEY FUNCTION Milo Sedlacek                  12-20-97 (10:33)       QB, QBasic, PDS        285  11719    MULTIKEY.BASDECLARE SUB KEYTEST ()ãDECLARE FUNCTION MULTIKEY (T)ãã'New and Improved MULTIKEY function!!ã'This version eliminates the key lock-up problem fromã'previous verions.  And is MUCH, MUCH faster!!ãã'ASM Interrupt & support code by Milo Sedlacekã'Everything else by              ãã'MULTIKEY - main routineã'    Usage:ã'    X = MULTIKEY(T)ã'    where t can equal -1,-2, and 1-128ã'    t = -1: IMPORTANT!!!  Make sure you pass this value toã'             the function before -2 and 1-128!  It turns theã'             interrupt on so you can start reading keys.ã'             Returns: nothingã'    t = -2: EXTREMELY IMPORTANT!!!!!!!!ã'             ALWAYS pass this before you end your program!ã'             If you don't, your computer won't be able toã'             read your keyboard & you'll have to reset!ã'             i.e., CTRL-ALT-DEL won't work!!ã'             Returns: nothingã'    t = keycode (1-128): Returns status of a key.ã'             Returns: 1 or 0 where     ã'                   1 = pressedã'                   0 = unpressedã'ã'KEYTEST - helps you find new keycodesã'    Usage:ã'    CALL KEYTEST or KEYTESTã'    This will show all 128 keycodes & their statuses.ã'    Press & hold a key & a 1 will appear somewhere.ã'    The number that the 1 is by will be the keycodeã'    for that key.  Simple!ãã' Send any qustions, comments, etc. to:  huberjjr@nicom.comãã'Demo code:ã'Use arrows to turn & accelerateã'Press space to come to a total stopã'Hit ESC to exitããZ = MULTIKEY(-1)    ' Initalize ASM & hook interruptãããSCREEN 12ãCLSããX = 320ãY = 240ãcPI = (3.141592654# / 180)ãANGLE = 0ãRADIUS = 5ãSPEED = .2ãDOã        IF MULTIKEY(77) THEN ANGLE = ANGLE - 7 ' Leftã        IF MULTIKEY(75) THEN ANGLE = ANGLE + 7 ' Rightã        IF MULTIKEY(72) THEN                   ' Upã         VX = VX + (SIN(cPI * ANGLE) * SPEED)ã         VY = VY + (COS(cPI * ANGLE) * SPEED)ã        END IFã        IF MULTIKEY(80) THEN                   ' Downã         VX = VX - (SIN(cPI * ANGLE) * SPEED)ã         VY = VY - (COS(cPI * ANGLE) * SPEED)ã        END IFã        IF MULTIKEY(57) THEN                   ' Spaceã         VX = 0ã         VY = 0ã        END IFãã        IF ANGLE > 360 THEN                   ' Wrap-around angleã         ANGLE = 0 + (ANGLE - 360)ã        END IFã        IF ANGLE < 0 THENã         ANGLE = 360 - (0 + ANGLE)ã        END IFãã        IF X < 0 + RADIUS THEN VX = -VX        ' Bounce limitsã        IF X > 640 - RADIUS THEN VX = -VXã        IF Y < 0 + RADIUS THEN VY = -VYã        IF Y > 480 - RADIUS THEN VY = -VYã     ã        X = X + VX                             ' Move itã        Y = Y + VYã      ã        X2 = X + SIN(cPI * ANGLE) * RADIUS     ' White dot calcã        Y2 = Y + COS(cPI * ANGLE) * RADIUS     ' dittoã       ã        VX = VX * .998                         ' Frictionã        VY = VY * .998                         ' dittoã      ã        CIRCLE (XX, YY), RADIUS, 0             ' Eraseã        PSET (XX2, YY2), 0ã        PSET (XX, YY), 0ã        CIRCLE (X, Y), RADIUS, 4               ' Drawã        PSET (X2, Y2), 15ã        PSET (X, Y), 4ã        XX = X: YY = Y: YY2 = Y2: XX2 = X2ã        WAIT &H3DA, 8                          ' Wait to vert. retarceã        WAIT &H3DA, 8, 8ãLOOP UNTIL MULTIKEY(1) = 1                     ' Hit ESC to exitããZ = MULTIKEY(-2)         'Unhook interruptããENDããã'KB Interrrupt sourceã' &HE9,&H1D,&H00          : '0000   JMP 0020        ;Jump to INSTALL INTERRUPTã' &HE9,&H3C,&H00          : '0003   JMP 0042        ;Jump to UNINSTALL INTERRUPTã' &H00,&H00               : '0006   ADD [BX+SI],AL  ;\ã' &H00,&H00               : '0008   ADD [BX+SI],AL  ;  \ã' &H00,&H00               : '000A   ADD [BX+SI],AL  ;   } Unused spaceã' &H00,&H00               : '000C   ADD [BX+SI],AL  ;  /ã' &H00,&H00               : '000E   ADD [BX+SI],AL  ;/ã' &H00,&H00               : '0010   ADD [BX+SI],AL  ;variable: keyboard_matrix_segmentã' &H00,&H00               : '0012   ADD [BX+SI],AL  ;variable: keyboard_matrix_offsetã' &H00,&H00               : '0014   ADD [BX+SI],AL  ;variable: dos_isr_handler_offsetã' &H00,&H00               : '0016   ADD [BX+SI],AL  ;variable: dos_isr_handler_segmentã' &H00,&H00               : '0018   ADD [BX+SI],AL  ;\ã' &H00,&H00               : '001A   ADD [BX+SI],AL  ;  \ã' &H00,&H00               : '001C   ADD [BX+SI],AL  ;  / Unused spaceã' &H00,&H00               : '001E   ADD [BX+SI],AL  ;/ã' &H1E                    : '0020   PUSH  DS        ;INSTALL INTERRUPT save DS for QBASICã' &H31,&HC0               : '0021   XOR AX,AX       ;\ã' &H8E,&HD8               : '0023   MOV DS,AX       ; } DS:SI -> interrupt vector 9ã' &HBE,&H24,&H00          : '0025   MOV SI,0024     ;/ã' &H0E                    : '0028   PUSH  CS        ;ã' &H07                    : '0029   POP ES          ;ES = CSã' &HBF,&H14,&H00          : '002A   MOV DI,0014     ;ES:DI -> dos_isr_handler_offsetã' &HFC                    : '002D   CLD             ;Increment SI, DI on string movesã' &HA5                    : '002E   MOVSW           ;\ã' &HA5                    : '002F   MOVSW           ;/ Read address of old handlerã' &H8C,&HC3               : '0030   MOV BX,ES       ;BX = CSã' &H8E,&HC0               : '0032   MOV ES,AX       ;ES = 0ã' &HBF,&H24,&H00          : '0034   MOV DI,0024     ;ES:DI -> keyboard interrupt vectorã' &HB8,&H56,&H00          : '0037   MOV AX,0056     ;AX = Offset of new handler from CSã' &HFA                    : '003A   CLI             ;Disable interruptsã' &HAB                    : '003B   STOSW           ;\ã' &H89,&HD8               : '003C   MOV AX,BX       ; } Change keyboard interrupt vectorã' &HAB                    : '003E   STOSW           ;/  to point to new handlerã' &HFB                    : '003F   STI             ;Enable interruptsã' &H1F                    : '0040   POP DS          ;Restore DS for QBASICã' &HCB                    : '0041   RETF            ;ã' &H1E                    : '0042   PUSH  DS        ;UNINSTALL INTERRUPT save DS for QBASICã' &H31,&HC0               : '0043   XOR AX,AX       ;\ã' &H8E,&HC0               : '0045   MOV ES,AX       ; } ES:DI -> keyboard interrupt vectorã' &HBF,&H24,&H00          : '0047   MOV DI,0024     ;/ã' &HBE,&H14,&H00          : '004A   MOV SI,0014     ;\ã' &H0E                    : '004D   PUSH  CS        ; } DS:SI -> address of old handlerã' &H1F                    : '004E   POP DS          ;/ã' &HFC                    : '004F   CLD             ;Increment SI, DI on string movesã' &HFA                    : '0050   CLI             ;Disable interruptsã' &HA5                    : '0051   MOVSW           ;\ã' &HA5                    : '0052   MOVSW           ;/ Change interrupt vectorã' &HFB                    : '0053   STI             ;Enable interruptsã' &H1F                    : '0054   POP DS          ;Restore DS for QBASICã' &HCB                    : '0055   RETF            ;ã' &HFB                    : '0056   STI             ;INTERRUPT HANDLER enable interruptsã' &H9C                    : '0057   PUSHF           ;Save flagsã' &H50                    : '0058   PUSH  AX        ;Save registersã' &H53                    : '0059   PUSH  BX        ;ã' &H51                    : '005A   PUSH  CX        ;ã' &H52                    : '005B   PUSH  DX        ;ã' &H1E                    : '005C   PUSH  DS        ;ã' &H56                    : '005D   PUSH  SI        ;ã' &H06                    : '005E   PUSH  ES        ;ã' &H57                    : '005F   PUSH  DI        ;ã' &HE4,&H60               : '0060   IN  AL,60       ;AL = Scan codeã' &HB4,&H01               : '0062   MOV AH,01       ;Assume it's a make codeã' &HA8,&H80               : '0064   TEST  AL,80     ;ã' &H74,&H04               : '0066   JZ  006C    ÚÄÄÄ;If it's not a break code then jumpã' &HB4,&H00               : '0068   MOV AH,00   ³   ;  It's a break codeã' &H24,&H7F               : '006A   AND AL,7F   ³   ;  key index = code AND 127ã' &HD0,&HE0               : '006C   SHL AL,1    ÀÄÄ>;\ã' &H88,&HC3               : '006E   MOV BL,AL       ; } BX = key index * 2ã' &HB7,&H00               : '0070   MOV BH,00       ;/ã' &HB0,&H00               : '0072   MOV AL,00       ;ã' &H2E                    : '0074   CS:             ;ã' &H03,&H1E,&H12,&H00     : '0075   ADD BX,[0012]   ;BX = BX + offset of matrixã' &H2E                    : '0079   CS:             ;ã' &H8E,&H1E,&H10,&H00     : '007A   MOV DS,[0010]   ;DS = segment of matrixã' &H86,&HE0               : '007E   XCHG  AH,AL     ;ã' &H89,&H07               : '0080   MOV [BX],AX     ;Store key stateã' &HE4,&H61               : '0082   IN  AL,61       ;Interrupt Clean upã' &H0C,&H82               : '0084   OR  AL,82       ;ã' &HE6,&H61               : '0086   OUT 61,AL       ;ã' &H24,&H7F               : '0088   AND AL,7F       ;ã' &HE6,&H61               : '008A   OUT 61,AL       ;ã' &HB0,&H20               : '008C   MOV AL,20       ;ã' &HE6,&H20               : '008E   OUT 20,AL       ;ã' &H5F                    : '0090   POP DI          ;Restore registersã' &H07                    : '0091   POP ES          ;ã' &H5E                    : '0092   POP SI          ;ã' &H1F                    : '0093   POP DS          ;ã' &H5A                    : '0094   POP DX          ;ã' &H59                    : '0095   POP CX          ;ã' &H5B                    : '0096   POP BX          ;ã' &H58                    : '0097   POP AX          ;ã' &H9D                    : '0098   POPF            ;Restore flagsã' &HCF                    : '0099   IRET            ;Exit interruptããSUB KEYTESTããSCREEN 0ãCLSããZ = MULTIKEY(-1)ãDOãX = 1ãY = 1ãã FOR I = 1 TO 128ã ã  TEST = MULTIKEY(I)ã  LOCATE Y, Xã  PRINT USING "## =###"; TEST; Iãã  IF Y < 23 THENã   Y = Y + 1ã  ELSEã   Y = 1ã   X = X + 9ã  END IFãã NEXT IããLOOP WHILE MULTIKEY(1) = 0ããZ = MULTIKEY(-2)ããENDããEND SUBããFUNCTION MULTIKEY (T)ããSTATIC kbcontrol%(), kbmatrix%(), Firsttime, StatusFlagããIF Firsttime = 0 THEN          'Initalizeã DIM kbcontrol%(128)ã DIM kbmatrix%(128)ã code$ = ""ã code$ = code$ + "E91D00E93C00000000000000000000000000000000000000000000000000"ã code$ = code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB"ã code$ = code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053"ã code$ = code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12"ã code$ = code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59"ã code$ = code$ + "5B589DCF"ã DEF SEG = VARSEG(kbcontrol%(0))ã FOR I% = 0 TO 155                     ' Load ASMã     d% = VAL("&h" + MID$(code$, I% * 2 + 1, 2))ã     POKE VARPTR(kbcontrol%(0)) + I%, d%ã NEXT I%ã I& = 16       ' I think this stuff connects the interrupt with kbmatrix%()ã N& = VARSEG(kbmatrix%(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2ã N& = VARPTR(kbmatrix%(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2ã DEF SEGã Firsttime = 1ãEND IFããSELECT CASE Tã CASE -1ã  IF StatusFlag = 0 THENã   DEF SEG = VARSEG(kbcontrol%(0))ã   CALL ABSOLUTE(0)                     ' Run interruptã   DEF SEGã   StatusFlag = 1ã  END IFã CASE -2ã  IF StatusFlag = 1 THENã   DEF SEG = VARSEG(kbcontrol%(0))      ' Turn off interruptã   CALL ABSOLUTE(3)ã   DEF SEGã   StatusFlag = 0ã  END IFã CASE 1 TO 128ã  MULTIKEY = kbmatrix%(T)               ' Return statusã CASE ELSEã  MULTIKEY = 0                          ' User Supidity ErrorãEND SELECTããEND FUNCTIONãEgbert Zijlema                 SIMULATE KEYPRESS              alt.lang.powerbasic            07-06-98 (12:47)       PB                     60   1658     STUFF.BAS   '> Anyway, I know how to put regular characters in the keyboard buffer.ã'> but unfortunately this does not allow to send along extendedã'> key information...ã'> So I can send "X", but don't know how to send ALT-X...ã'> ã'> Any ideas?ã'--------------------ãã' STUFF.BAS  - simulate keypressã' Author: Egbert Zijlema (e.zylema@castel.nl)ã' Status: Public Domain / freewareã' Code  : PowerBASICããDEFINT A-Zãã' name constants for registersã  %AX = 1ã  %CX = 3ãã' name constants for demo keysã  %ALTX = 45 * 256                      ' Alt-xã  %ESC  = 27                            ' Escapeã  %F1   = 59 * 256                      ' F1ã  %A    = 65                            ' A (uppercase)ããFUNCTION GetKey() AS INTEGERã  ' function to test the result of StuffBuffã  ' returns keystroke from buffer in the following format:ã  '   - ascii code when typewriter keyã  '   - 256 times scancode when extended keyãã  DOã  LOOP UNTIL INSTATã  FUNCTION = CVI(INKEY$ + CHR$(0))ãEND FUNCTIONããSUB StuffBuff(KeyCode AS WORD)ã  ' procedure to simulate keypressã  ' KeyCode must be passed as either a valid ASCII orã  ' (256 times scancode) for extended keysãã  REG %AX, &H0500              ' service 05h to AXã  REG %CX, KeyCode             ' key value to CXã  CALL INTERRUPT &H16          ' call keyboard interruptãEND SUBãã' demoãCLSã  StuffBuff %ALTX              ' simulate pressing Alt-xã  ? "Scancode of Alt-x ="; GetKey \ 256ã  ã  StuffBuff %F1                ã  ? "Scancode of F1 ="; GetKey \ 256ã  ã  StuffBuff %ESC               ã  ? "ASCII code of Escape ="; GetKeyãã  StuffBuff %Aã  ? CHR$(GetKey)ãENDãAndre Victor                   MULTIPLE KEY PROCESSING        anvictor@ruralsp.com.br        08-08-98 (05:29)       QB, QBasic, PDS        136  3662     KBD.BAS     ' multiple keys processing for QBasic 1.1ã' by Andre V1ctor / BRAZIL 1998ã' 100% public domain - but please give some credit if you use it. :)ã'ã' WARNING!!! after call KbdInit, Ctrl-Break, Ctrl-Alt-Del andã'            the BASIC's procedures: INKEY$ and SLEEP don't will work.ã'ãDEFINT A-ZããTYPE KEYBOARD                                   ' keyboard struct (258 bytes)ã aANY    AS INTEGERã ESC     AS INTEGERã NPD     AS STRING * 20ã f000000 AS STRING * 4ã BSPC    AS INTEGERã tTAB    AS INTEGERã f000001 AS STRING * 24ã ENTER   AS INTEGERã Ctrl    AS INTEGERã f000002 AS STRING * 24ã LFSH    AS INTEGERã f000003 AS STRING * 22ã RGSH    AS INTEGERã PRT     AS INTEGERã Alt     AS INTEGERã sSPC    AS INTEGERã CAP     AS INTEGERã F1      AS INTEGERã F2      AS INTEGERã F3      AS INTEGERã F4      AS INTEGERã F5      AS INTEGERã F6      AS INTEGERã F7      AS INTEGERã F8      AS INTEGERã F9      AS INTEGERã F10     AS INTEGERã NUM     AS INTEGERã SCRL    AS INTEGERã HOME    AS INTEGERã UP      AS INTEGERã PGUP    AS INTEGERã MIN     AS INTEGERã LEFT    AS INTEGERã MID     AS INTEGERã RIGHT   AS INTEGERã PLUS    AS INTEGERã eEND    AS INTEGERã DOWN    AS INTEGERã PGDW    AS INTEGERã INS     AS INTEGERã Del     AS INTEGERã f000004 AS STRING * 6ã F11     AS INTEGERã F12     AS INTEGERã f000005 AS STRING * 80ãEND TYPEã'ãDECLARE SUB KbdInit (kbd AS KEYBOARD)ãDECLARE SUB KbdDone ()ã     DIM KbdCode(0 TO 87) AS INTEGER            ' my dataã     DIM KbdFlag AS INTEGERãã     DIM kbd AS KEYBOARD                        ' your dataã    ã     KbdInit kbd                                ' initializeãã     CLSã    DOã    ã     LOCATE 1, 1: PRINT kbd.tTAB; kbd.UP; kbd.ENTER; "     "ã     LOCATE 2, 1: PRINT kbd.LEFT; kbd.sSPC; kbd.RIGHT; "     "ã     LOCATE 3, 1: PRINT kbd.Ctrl; kbd.DOWN; kbd.Alt; "     "ã   ã    LOOP UNTIL kbd.ESCãã     KbdDone                                    ' terminate (don't forget)ããã':::::::::::::::::::::::::::::::::::::::::::::::::ãKbdCode:                                        ' machine codeãDATA 50,53,56,1E,FB,BE,34,12,B8,34,12,8E,D8,E4ãDATA 60,88,C4,24,7F,32,FF,8A,D8,D1,E3,03,DE,D0ãDATA E4,1A,E4,F6,D4,88,27,22,C4,88,04,E4,61,88ãDATA C4,0C,80,E6,61,88,E0,E6,61,FA,B0,20,E6,20ãDATA FB,1F,5E,5B,58,CF,55,89,E5,57,06,1E,8B,5EãDATA 0A,8B,3F,8B,5E,0C,8B,07,8E,C0,8B,5E,06,8BãDATA 07,50,26,89,45,06,8B,5E,08,8B,07,50,26,89ãDATA 45,09,8C,C0,8E,D8,B4,35,B0,09,CD,21,89,9DãDATA A0,00,8C,C0,89,85,A3,00,89,FA,B4,25,B0,09ãDATA CD,21,07,5F,33,C0,B9,80,00,F3,AB,1F,07,5FãDATA 5D,CA,08,00,06,1E,B8,40,00,8E,C0,26,A1,1CãDATA 00,26,A3,1A,00,BA,34,12,B8,34,12,8E,D8,B4ãDATA 25,B0,09,CD,21,1F,07,CBãã':::::::::::::::::::::::::::::::::::::::::::::::::ãSUB KbdDoneã' restores old keyboard handler. must be called before exiting program.ãã     SHARED KbdCode() AS INTEGERã     SHARED KbdFlag AS INTEGERãã    IF (KbdFlag) THENã     KbdFlag = 0ãã     DEF SEG = VARSEG(KbdCode(0))ãã     CALL absolute(VARPTR(KbdCode(0)) + 144)ã    END IFããEND SUBãã':::::::::::::::::::::::::::::::::::::::::::::::::ãSUB KbdInit (kbd AS KEYBOARD)ã' initializes new keyboard handler.ãã     SHARED KbdCode() AS INTEGERã     SHARED KbdFlag AS INTEGERã     DIM bt AS STRINGã     DIM i AS INTEGERãã    IF (NOT KbdFlag) THENã     KbdFlag = -1ãã     DEF SEG = VARSEG(KbdCode(0))ã    ã     RESTORE KbdCodeã     FOR i = 0 TO 175ã      READ btã      POKE VARPTR(KbdCode(0)) + i, VAL("&H" + bt)ã     NEXT iã  ã     CALL absolute(VARSEG(KbdCode(0)), VARPTR(KbdCode(0)), VARSEG(kbd), VARPTR(kbd), VARPTR(KbdCode(0)) + 62)ã    END IFããEND SUBãTim Nordell                    KEYBOARD HANDLER FOR PB        tim@techmaster.roseville.k12.mn03-30-99 (13:12)       PB                     140  2381     KEYHAND.BAS   DECLARE FUNCTION SetOnExit%(BYVAL ProcedurePointer???)ããshared sf??,foff??ãdim ckeys(128,1) as shared byteãsub enablekey() publicã	dim h as byte ptrã   h=codeptr32(skppp)+1ã   @h=1ãend subãsub disablekey() publicã	dim h as byte ptrã   h=codeptr32(skppp)+1ã   @h=0ãend subãsub enable() publicã	dim h as integer ptrã	dim g as dword ptrã	h=codeptr32(locat)+1ã	@h=varseg(ckeys(0,0))ã	h=h+3ã	@h=varptr(ckeys(0,0))ã	g=codeptr32(hjkl)+1ã	getinterruptvector 9,sf??,foff??ã	@g=sf??*&h10000+foff??ã	setinterruptvector 9,codeseg(keyhand),codeptr(keyhand)ã	a???=codeptr32(disable)ã	call setonexit(a???)ãend subããsub disable() publicã	setinterruptvector 9,sf??,foff??ãend subããsub kyhand()ã	print "Not to be called directly..."ã	exit subã	keyhand:ã		!	push axã		!	push bxã		!	push dsã		!	push siã		!	push cxã		!	push dxã		locat:ã			!	mov ax,&hffefã			!	Mov bx,&hfeffã			!	push axã			!	pop dsã			!	push bxã			!	pop siã			!	xor ax,axã			!	mov al,ds:[si]ã			!	cmp al,1ã			!	jne notexã				!	add bx,129ã				!	mov ax,0ã				!	mov ds:[si],alã				!	push bxã				!	pop siã			notex:ã			!	mov ah,0ã			!	in al,&h60ã			!	cmp al,&he0ã			!	je extttã			!	cmp ax,127ã			!	jle ofã			!	mov ds:[Si],alã			!	sub al,128ã			!	add bx,axã			!	push bxã			!	pop siã			!	xor al,alã			!	mov ds:[Si],alã			!	jmp skpppã		of:ã			!	mov ds:[Si],alã			!	add bx,axã			!	push bxã			!	pop siã			!	mov al,1ã			!	mov ds:[Si],alã		skppp:ã         !  mov al,&h01ã			!  cmp al,0ã         !  je  hjkllã			!	pop dxã			!	pop cxã			!	pop siã			!	pop dsã			!	pop bxã			!	pop axã		hjkl:ã			$inline &HeA,&Hff,&hff,&hff,&hffã			!	iretã		exttt:ã			!	mov al,1ã			!	mov ds:[si],alã			!	jmp skpppã		hjkll:ã         !  mov  al,&h20ã         !  out  &h20,alã			!	pop dxã			!	pop cxã			!	pop siã			!	pop dsã			!	pop bxã			!	pop axã			!	iretãend subããããã SUB SetInterruptVector(Intr%,Segment??,Offset??)ã	!	cliã REG 1,&H2500 + Intr%ã REG 4,Offset??ã REG 8,Segment??ã CALL INTERRUPT &H21ã 	!	stiã END SUBãã SUB GetInterruptVector(Intr%,S??,O??)ã 	!	cliã REG 1,&H3500 + Intr%ã CALL INTERRUPT &H21ã S??=REG(9)ã O??=REG(2)ã 	!	stiã END SUBãenableãdisablekeyãdoãif ckeys(1,0) then disable:stopãfor i%=1 to 128ã  if ckeys(i%,0) then print "   ";hex$(i%);ã  if ckeys(i%,1) then print "   E";hex$(i%);ãnext i%ãprintãloopãDon Schullian                  FINPUT FOR QBASIC              d83@DASoftVSS.com              03-17-00 (16:37)       QB, QBasic, PDS        257  8520     QB_INPUT.BAS'------------------------------------------------------------------------ã' fInput% function for Qbasicã'    coded by: Don Schullian  d83@DASoftVSS.comã'    public domainã'ã' Welcome,ã'ã'   This code is offered as an (better?) alternative to INPUT$. Itã' allows for cursoring around a field, deletion, insertion, overwrite,ã' scrolling, and bail out without saving the/any changes.ã'ã'   Its use is demonstrated below using an array to allow for editingã' a screen full of data in one loop. This code could, very easily beã' placed into it's own function and called several times in a singleã' program.ã'ã'   There are a series of CONSTant variables set that are used by theã' function. You may, of course, put their values into the function or,ã' in some cases, send the values to the function to allow for moreã' control by varied other functions.ã'ã'   This offering is just a starting point for those of you who areã' more adventurous. Over the years I've developed 10 differentã' variations of this function that control and guide the users' input.ã' One of them works only for numerical input and looks & feels likeã' a calculator; another allows input of only specific characters;ã' while others handle hexadecimal input, masked fields, multiple linesã' and other varied field types. A bit of imagination goes a LONG way!ã'ã'   fGetKey% is my basic keyboard input function and I never leaveã' home without it. There is a full discussion on how and why onã' either of my web pages. www.basicguru.com/scullian orã' www.DASoftVSS.com along with some other goodies.ã'ã'   If you have any questions, give me a shout.ã'ã' Donã'----------------------------------------------------------------------ã' fGetKey%(Datum$,Row%,Col%,VisCols%,MaxLen%,ExitKeys$)ã'ã' PURPOSE: Allow user input in an editable, friendly environmentã'  PARAMS: Datum$     incoming the data already found in the fieldã'                     returning the edited dataã'          Row%, Col% the left most screen position of the fieldã'          VisCols%   the number of visable characters on screen      ã'          MaxLen%    the maximum number of characters in the fieldã'          ExitKeys$  the MKI$(keyvalue%) of all the keys OTHER THANã'                       <ESC> and <ENTER> that will return from theã'                       functionã'    NOTE: If VisCols% =< MaxLen% then the value will be set to matchã'          that of MaxLen%ã'--------------------------------------------------------------------------ãDECLARE FUNCTION fGetKey% ()ãDECLARE FUNCTION fInput% (Datum$, Row%, Col%, VisCols%, MaxLen%, ExitKeys$)ããCONST cEscKey% = &H1BãCONST cEnterKey% = &HDãCONST cBkSpcKey% = &H8ãCONST cDelKey% = &H5300ãCONST cUpKey% = &H4800ãCONST cDownKey% = &H5000ãCONST cInsKey% = &H5200ãCONST cLeftKey% = &H4B00ãCONST cRightKey% = &H4D00ãCONST cF10key% = &H4400ãCONST cHomeKey% = &H4700ãCONST cEndKey% = &H4F00ãCONST cFgrnd% = 15          ' editing foregroundãCONST cBgrnd% = 1           ' editing backgroundãCONST cMaxLen% = 80         ' maximum length used by fInput%ããTYPE InputTYPE              ' used to store a screen full of dataã  Dat AS STRING * cMaxLen   ' the field of dataã  Row AS INTEGER            ' screen positionã  Col AS INTEGER            'ã  MaxLen AS INTEGER         ' maximum data length for this fieldãEND TYPEã'---------------------------------------------------------------ã'-------------------- start of test codeã'---------------------------------------------------------------ãCLSã' ================================================ã' ======= this demonstrates the use for one fieldã' ================================================ãD$ = "Mary had a little lamb, its fleece was white as snow."ãG% = fInput%(D$, 1, 10, 20, 70, "")ãLOCATE 2, 1: PRINT D$;ã' ==================================================ã' ====== the following uses an array for 5 fieldsã' ==================================================ãDIM tI(5) AS InputTYPEããRESTORE TestDataãFOR X% = 1 TO 5ã  READ Prompt$ã  READ tI(X%).Dat, tI(X%).Row, tI(X%).Col, tI(X%).MaxLenã  Col% = tI(X%).Col - LEN(Prompt$) - 1ã  COLOR 7, 0ã  LOCATE tI(X%).Row, Col%ã  PRINT Prompt$;ã  COLOR 15, 0ã  LOCATE tI(X%).Row, tI(X%).Colã  PRINT LEFT$(tI(X%).Dat, tI(X%).MaxLen)ãNEXTããLOCATE 25, 1: PRINT "Use Arrows to move - F-10 to save & exit - <ESC> to quit";ããExitKeys$ = MKI$(cF10key%) + MKI$(cUpKey%) + MKI$(cDownKey%)ããFld% = 1ãDOã  IF Fld% < 1 THENã      Fld% = 5ã    ELSEIF Fld% > 5 THENã      Fld% = 1ã  END IFã  G% = fInput%(tI(Fld%).Dat, tI(Fld%).Row, tI(Fld%).Col, 0, tI(Fld%).MaxLen, ExitKeys$)ã  SELECT CASE G%ã    CASE cF10key: EXIT DOã    CASE cEscKey: EXIT DOã    CASE cUpKey: Fld% = Fld% - 1ã    CASE ELSE: Fld% = Fld% + 1ã  END SELECTãLOOPãFOR X% = 1 TO 5ã  LOCATE X% + 10, 1ã  PRINT tI(X%).DatãNEXTããTestData:ã  DATA "Last Name:", "Schullian", 6, 20, 17ã  DATA "Frst Name:", "Don", 7, 20, 17ã  DATA "Street:", "My Street 27", 8, 20, 30ã  DATA "City:", "Hometown", 9, 20, 30ã  DATA "Zip:", "12345-2433", 9, 56, 10ãã'ãFUNCTION fGetKey%ã ã  DOã    G$ = INKEY$ã    L% = LEN(G$)ã  LOOP UNTIL L% > 0ã ã  IF L% = 1 THENã      fGetKey% = ASC(G$)ã    ELSEã      fGetKey% = CVI(G$)ã  END IFããEND FUNCTIONããFUNCTION fInput% (Datum$, Row%, Col%, VisLen%, MaxLen%, ExitKeys$)ãã  DIM Bgrnd  AS INTEGER              ' original background colorã  DIM Cpos   AS INTEGER              ' current cursor position within stringã  DIM Exet   AS STRING               ' string vals of all exit keysã  DIM Fgrnd  AS INTEGER              ' original foreground colorã  DIM Inzert AS INTEGER              ' insert stateã  DIM KeyVal AS INTEGER              ' incoming key-press valueã  DIM MaxOff AS INTEGER              ' maximum offset positionã  DIM Offset AS INTEGER              ' 1st character shown in fieldã  DIM Temp   AS STRING * cMaxLen     ' working data stringãã  Temp$ = LTRIM$(LEFT$(Datum$, MaxLen%))ã  Inzert% = 31ã  Exet$ = MKI$(cEscKey%) + MKI$(cEnterKey%) + ExitKeys$ã  Bgrnd% = SCREEN(Row%, Col%, 1)ã  Fgrnd% = (Bgrnd% AND 15)ã  Bgrnd% = (Bgrnd% \ 16)ã  Offset% = 1ã ã  IF (VisLen% = 0) OR (VisLen% > MaxLen%) THEN VisLen% = MaxLen%ã  MaxOff% = (MaxLen% - VisLen% + 1)ãã  GOSUB fInputEOLã  COLOR cFgrnd%, cBgrnd%ã  LOCATE , , , Inzert%, 31ã ã  DOã    IF Cpos% < 1 THENã        Cpos% = 1ã      ELSEIF Cpos% > MaxLen% THENã        Cpos% = MaxLen%ã    END IFã    IF Cpos% < Offset% THENã        Offset% = Cpos%ã      ELSEIF (Cpos% - Offset% + 2) > VisLen% THENã        Offset% = (Cpos% - VisLen% + 1)ã        IF Offset% > MaxOff% THEN Offset% = MaxOff%ã    END IFã    GOSUB fInputPrintã    LOCATE Row%, (Col% + Cpos% - Offset%), 1ã    KeyVal% = fGetKey%ã    IF (INSTR(Exet$, MKI$(KeyVal%)) AND 1) THEN EXIT DOã    SELECT CASE KeyVal%ã      CASE 32 TO 255ã        IF (Inzert% = 0) OR (Cpos% = MaxLen%) THENã            MID$(Temp$, Cpos%, 1) = CHR$(KeyVal%)ã          ELSEã            Temp$ = LEFT$(Temp$, Cpos% - 1) + CHR$(KeyVal%) + MID$(Temp$, Cpos%)ã        END IFã        Cpos% = Cpos% + 1ã      CASE cBkSpcKey%ã        IF Cpos% > 1 THENã          Cpos% = Cpos% - 1ã          GOSUB fInputStripã        END IFã      CASE cDelKey%ã        GOSUB fInputStripã      CASE cHomeKey%ã        Cpos% = 1ã      CASE cEndKey%ã        GOSUB fInputEOLã      CASE cLeftKey%ã        Cpos% = Cpos% - 1ã      CASE cRightKey%ã        Cpos% = Cpos% + 1ã      CASE cInsKey%ã        Inzert% = (Inzert% XOR 31)ã        LOCATE , , , Inzert%, 31ã    END SELECTã  LOOPãã  Offset% = 1ã  Temp$ = LTRIM$(Temp$)ã  IF KeyVal% <> cEscKey% THENã      Datum$ = LEFT$(Temp$, MaxLen%)ã      Datum$ = RTRIM$(Temp$)ã    ELSEã      Temp$ = Datum$ã  END IFã  COLOR Fgrnd%, Bgrnd%ã  GOSUB fInputPrintã ã  fInput% = KeyVal%ã  EXIT FUNCTIONã  '-----------------------------------------------------------------ã  '------------- local routinesã  '-----------------------------------------------------------------ãfInputPrint:ã  LOCATE Row%, Col%, 0ã  PRINT MID$(Temp$, Offset%, VisLen%);ãRETURNã  '-----------------------------------------------------------------ãfInputStrip:ã  Temp$ = LEFT$(Temp$, Cpos% - 1) + MID$(Temp$, Cpos% + 1)ãRETURNã  '-----------------------------------------------------------------ãfInputEOL:ã  FOR Cpos% = MaxLen% TO 1 STEP -1ã    IF ASC(MID$(Temp$, Cpos%)) <> 32 THEN EXIT FORã  NEXTã  Cpos% = Cpos% + 1ãRETURNããEND FUNCTIONãJeremiah Hyde                  JOYSTICK LIBRARY               fishoffire@yahoo.com           08-30-00 (14:48)       QB, QBasic, PDS        1    12387    JOYSTICK.BAS'PPPPPP
'PP  PP
'PP  PP rr rrr   oooo   ggg gg rr rrr  aaaa   mm  mm    eeee   rr rrr   zzzzzz
'PPPPP   rrr rr oo  oo gg  gg   rrr rr    aa  mmmmmmm  ee  ee   rrr rr  z  zz
'PP      rr  rr oo  oo gg  gg   rr  rr aaaaa  mmmmmmm  eeeeee   rr  rr    zz
'PP      rr     oo  oo  ggggg   rr    aa  aa  mm m mm  ee       rr       zz  z
'PP     rrrr     oooo      gg  rrrr    aaaaa  mm   mm   eeee   rrrr     zzzzzz
'                        ggggg                            (  /\__________/\  )
'                                                          \(^ @___..___@ ^)/
'  ###########                                              /\ (\/\/\/\/) /\
'  # ___ ___ #   RRRRR          lll          !!   !!       /  \(/\/\/\/\)/  \ 
'  { (0) (0) }   RR  RR          ll         !!!! !!!!     (    """"""""""    )
'  |    P    |   RR  RR uu  uu   ll  zzzzzz !!!! !!!!     \      _____      /
'   \ \___/ /    RRRRR  uu  uu   ll  z  zz  !!!! !!!!     (     /(   )\     )
'    \_____/     RR RR  uu  uu   ll    zz    !!   !!      _)   (_V) (V_)   (_
' Jeremiah "BJ"  RR  RR uu  uu   ll   zz  z              (V)(V)(V)   (V)(V)(V)
'     Hyde       RR  RR  uuu uu llll zzzzzz  !!   !!          My dog Smokey,
'                                                            aka Stupid Mutt
'
' This code released under the GNU General Public License. This means you
' can use it, compile it, pass it around, modify it, WHATEVER! However,
' if you do this, I will expect notification and a copy of whatever you've
' done, unless it's a virus, or breaking into the CIA, etc.
'                                                    Jeremiah "BJ" Hyde
'E-Mail me at: fishoffire@yahoo.com                fishoffire Industries:
' Visit me at: www.fishoffire.com                     Your source for
'                                                    EVERYTHING QBasic
'Note:
' This code has been tested on my machines:
'   ASUS TX97x WOA: AMD K6-266, 160MB RAM, 20.5 GB HD, 15" PnP(SVGA+) Monitor,
'       Win98 DOSBox
'   AT&T Globalyst 520: Intel 486 DX 66mhz, 19MB RAM, 14" SVGA Monitor,
'       Win95 DOSBox
'   Compaq Deskpro 4/33i: Intel 386 33mhz, 4MB RAM, 14" SVGA Monitor,
'       MS-DOS 6.22/Win3.11
' and has run correctly under those environments. However, no guarantee,
' warranty, or any other declaration of safety, etc. is offered. If your
' computer system is taken over by smurfs, or the ROM is RAMed, or
' anything else of a detrimental nature happens to your PC as a result
' of this code, I am *not* responsible for it. The full burden of blame
' rests squarely on your shoulders.(Of course, if something GOOD happens to
' your computer as a result of this code, well, obviously, I did it!)
' -------------
' In other words: You're on your own, pal!

' This piece of code is one of the simplest joystick libraries out there.
' Not only does it handle 4 buttons, a rudder, AND a 4-position hat-switch,
' but it is about a bajillion times faster than QB's STRIG and STICK commands.
' At least, on my PCs it is. Anyway, I figure its more useful as a tutorial
' or learning code, than as a finished product to drop into your game.

' BTW: If you want to use this in a commercial program email me
' and we'll talk.

' Okay, enough chatter, time to get to the CODE!!!

DEFINT A-Z      ' Ahh, the holy DEFINT command!

' At last! Clear, fast(?) and simple joystick routines!
DECLARE SUB jsCalibrate ()          ' Yes, I think we know what calibrating
                                    ' is. And yes, you DO have to call it
                                    ' before jsGet%(). However, jsGetRaw% is
                                    ' fine to call whenever.
DECLARE FUNCTION jsGet% (Value%)    ' Hmm...Lemme guess what this does...Well
                                    ' DUHH! It gets values from the joystick!
                                    ' Value%=0 | return buttons as bitfield
                                    '       =1 | return X-coordinate(values
                                    '          | scaled from -100 to 100)
                                    '       =2 | return Y-coordinate(values
                                    '          | scaled from -100 to 100)
                                    '       =3 | return Z-coordinate(values
                                    '          | scaled from -100 to 100)
                                    '       =4 | return hat-switch. 0=center,
                                    '          | 1=up,2=right,3=down,4=left
DECLARE FUNCTION jsGetRaw% (Value%) ' This, obviously, returns the raw data
                                    ' straight from the joystick. Use this if
                                    ' you don't want to calibrate, or you
                                    ' just can't stand my coordinate scheme.

' The joystick port! There should never be any reason to change this.
' At least, I can't think of any. On a different port, all kinds of
' NASTY things could happen(ex: low-level hard-drive formatting).
CONST jsPort = &H201    ' This can be anything from &H200 to &H207. It doesn't
                        ' seem to make any difference.

' The value to send to the port! When you write to the joystick port,
' the lower nybble of data from the port remain set for as many port
' reads as the value of that particular coordinate. So, you read until
' a bit goes dead, and the number of reads is the value of that coordinate.
' This CONST is only here because someday, I might find a stick that
' requires a particular value to read say, its Q-coordinate, or the other
' 16 positions on its hat-switch.
CONST jsInitVal = 0

' These variables are used by jsGet%, to scale the values from the
' joystick to a 100x100 playing area, and to calibrate the hat switch.
' They are all set by jsCalibrate, and could be used in conjungtion(sp?!?!)
' with jsGetRaw% to make your own jsGet%
DIM SHARED jsCenterX%   ' Center X
DIM SHARED jsCenterY%   ' Center Y
DIM SHARED jsCenterZ%   ' Center Rudder

DIM SHARED jsMaxX%      '\
DIM SHARED jsMinX%      ' \
DIM SHARED jsMaxY%      '  \__Limits
DIM SHARED jsMinY%      '  /
DIM SHARED jsMaxZ%      ' /
DIM SHARED jsMinZ%      '/

DIM SHARED jsHatUp%     '\
DIM SHARED jsHatRight%  ' \__Hat switch positions
DIM SHARED jsHatDown%   ' /
DIM SHARED jsHatLeft%   '/

DIM SHARED jsDeadZone%  ' How much the stick can move
                        ' without the program noticing.

' Ahh, the unholy demo. This demo should be deleted within seconds of
' your downloading this file. It was used only for me to ensure I had
' it all right, and displays all the current values from the joystick
CLS
jsCalibrate ' Calibrate the joystick. No NASTY comments about my anti-GUI.
CLS
DO          ' The main loop. Read the values, print 'em, then do it again.
    LOCATE 1, 1
    PRINT "Buttons: ";
        tmpBtn% = jsGet%(0)
        IF tmpBtn% AND 1 THEN PRINT "<A>  ";  ELSE PRINT " A   ";
        IF tmpBtn% AND 2 THEN PRINT "<B>  ";  ELSE PRINT " B   ";
        IF tmpBtn% AND 4 THEN PRINT "<C>  ";  ELSE PRINT " C   ";
        IF tmpBtn% AND 8 THEN PRINT "<D>  ";  ELSE PRINT " D   ";
        PRINT ""
    PRINT "  X-Pos: "; jsGet%(1); "   "
    PRINT "  Y-Pos: "; jsGet%(2); "   "
    PRINT " Rudder: "; jsGet%(3); "   "
    PRINT "  HatSw: "; jsGet%(4)
    ' There should probably be a delay loop here, but
    ' I never had any need for it. Also, if your computer
    ' is slow enough, the read from the joystick will be
    ' more than enough of a drag
LOOP UNTIL INKEY$ = CHR$(27)

SUB jsCalibrate
jsDeadZone% = 6

PRINT "Center joystick, and press <Enter>."
GOSUB Pause
jsCenterX% = jsGetRaw%(1)
jsCenterY% = jsGetRaw%(2)
jsCenterZ% = jsGetRaw%(3)

PRINT "Move joystick all the way to the top-left corner, and press <Enter>"
GOSUB Pause
jsMinX% = jsGetRaw%(1)
jsMinY% = jsGetRaw%(2)

PRINT "Move joystick all the way to the bottom-right corner, and press <Enter>"
GOSUB Pause
jsMaxX% = jsGetRaw%(1)
jsMaxY% = jsGetRaw%(2)

PRINT "Does your joystick have a Z-axis(rudder)? ";
DO: key$ = UCASE$(INKEY$): LOOP UNTIL key$ = "Y" OR key$ = "N"
PRINT key$
IF key$ = "Y" THEN
    PRINT "Move the rudder all the way to the left, and press <Enter>"
    GOSUB Pause
    jsMinZ% = jsGetRaw%(3)
  
    PRINT "Move the rudder all the way to the right, and press <Enter>"
    GOSUB Pause
    jsMaxZ% = jsGetRaw%(3)
END IF

PRINT "Does your joystick have a hat-switch? ";
DO: key$ = UCASE$(INKEY$): LOOP UNTIL key$ = "Y" OR key$ = "N"
PRINT key$
IF key$ = "Y" THEN
    PRINT "Move the hat-switch to the top, and press <Enter>"
    GOSUB Pause
    jsHatUp% = jsGetRaw%(4)
   
    PRINT "Move the hat-switch to the right, and press <Enter>"
    GOSUB Pause
    jsHatRight% = jsGetRaw%(4)
   
    PRINT "Move the hat-switch to the bottom, and press <Enter>"
    GOSUB Pause
    jsHatDown% = jsGetRaw%(4)
   
    PRINT "Move the hat-switch to the left, and press <Enter>"
    GOSUB Pause
    jsHatLeft% = jsGetRaw%(4)
END IF
PRINT "Joystick succesfully calibrated!"

EXIT SUB

Pause:
DO: LOOP UNTIL INKEY$ = ""          ' Clear keyboard
DO: LOOP UNTIL INKEY$ = CHR$(13)    ' Wait for <Enter>
RETURN

END SUB

FUNCTION jsGet% (Value%)
' Return a current joystick value
' Value%=
' ------------------------------------
' 0, return buttons as bitfield
'       <A> = 1, <B> = 2, <C> = 4, <D> = 8
' 1, return current X-position. X is scaled from -100 to 100,
'   to make things easier.
' 2, return current Y-position. Y is scaled from -100 to 100.
' 3, return current Z-position(rudder). Z is scaled from -100 to 100.
' 4, return current hat-switch position. Returns 0=Center, 1=Up, 2=Right,
'   3=Down, 4=Left.

SELECT CASE Value%
    CASE 0  ' Buttons
        jsGet% = jsGetRaw%(0)' Get buttons as bit-field. 1=A, 2=B, 4=C, 8=D
   
    CASE 1  ' X-Position
        X% = jsGetRaw%(1) - jsCenterX%
        IF X% < 0 THEN
            X% = (X% / (jsCenterX% - jsMinX%)) * 100
        ELSE
            X% = (X% / (jsMaxX% - jsCenterX%)) * 100
        END IF
        IF ABS(X%) <= jsDeadZone% THEN X% = 0
        jsGet% = X%
   
    CASE 2  ' Y-Position
        Y% = jsGetRaw%(2) - jsCenterY%
        IF Y% < 0 THEN
            Y% = -(Y% / (jsCenterY% - jsMinY%)) * 100
        ELSE
            Y% = -(Y% / (jsMaxY% - jsCenterY%)) * 100
        END IF
        IF ABS(Y%) <= jsDeadZone% THEN Y% = 0
        jsGet% = Y%
   
    CASE 3  ' Z-Position, rudder
        Z% = jsGetRaw%(3) - jsCenterZ%
        IF Z% < 0 THEN
            Z% = (Z% / (jsCenterZ% - jsMinZ%)) * 100
        ELSE
            Z% = (Z% / (jsMaxZ% - jsCenterZ%)) * 100
        END IF
        IF ABS(Z%) <= jsDeadZone% THEN Z% = 0
        jsGet% = Z%
   
    CASE 4  ' Hat-switch
        tmpHat% = jsGetRaw%(4)
        Hat% = 0
       
        ' IF tmpHat% IS WITHIN 5 OF jsHatUp% THEN Hat% = 1
        ' IF tmpHat% IS . . .
        IF (((tmpHat% + 5) > jsHatUp%) AND ((tmpHat% - 5) < jsHatUp%)) THEN Hat% = 1
        IF (((tmpHat% + 5) > jsHatRight%) AND ((tmpHat% - 5) < jsHatRight%)) THEN Hat% = 2
        IF (((tmpHat% + 5) > jsHatDown%) AND ((tmpHat% - 5) < jsHatDown%)) THEN Hat% = 3
        IF (((tmpHat% + 5) > jsHatLeft%) AND ((tmpHat% - 5) < jsHatLeft%)) THEN Hat% = 4
        jsGet% = Hat%

    CASE ELSE
        ERROR 5
END SELECT
END FUNCTION

FUNCTION jsGetRaw% (Value%)
' Returns the current position of the joystick.
' This is RAW, straight from port &H200.
' Coord%=0, return buttons as a bitfield
' Coord%=1, return X-coord
' Coord%=2, return Y-coord
' Coord%=3, return Z-coord
' Coord%=4, return hat-switch
' Anything else, return -1
SELECT CASE Value%
    CASE 0
        tmp% = INP(jsPort)
        tmp% = ((NOT (tmp% \ 16)) AND 15)
        Coord% = tmp%
    CASE 1
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 1 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 1) = 0
    CASE 2
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 2 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 2) = 0
    CASE 3
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 4 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 4) = 0
    CASE 4
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 8 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 8) = 0
    CASE ELSE
        Coord% = -1
END SELECT
jsGetRaw% = Coord%
END FUNCTION

ãJoel Nothman                   KEY CHOOSER/CONFIGURATION      jnothman@crosswinds.net        11-20-00 (23:11)       QB, QBasic, PDS        195  5045     KEYBOARD.BASã'this set of routines should allow users to choose their keys in games etc.ã'it stores the names of the keys in an array it buildsã'pity i didn't know the existence or use of scan codes! o well!ã'it's pretty cheap and buggy.ã'ã' - Joel NothmanããDECLARE FUNCTION Trim$ (t$)ãDECLARE FUNCTION NotIt! (Num!)ãDECLARE FUNCTION GetKey! (x!, y!)ãDECLARE FUNCTION KKeyName$ (a$)ãDECLARE FUNCTION KKeyNameFromNum$ (Num!)ãDECLARE FUNCTION KKeyNum! (a$)ãDECLARE FUNCTION KKeyPress$ (Num!)ãDECLARE SUB KSetKeys (Pre$, Lets$, start!)ãDECLARE SUB KSetKeys2 (Pre$, Words$(), l!, start!)ãDECLARE SUB SetUpKeyArray ()ãDECLARE SUB ChangeKeys ()ããCONST NumGameKeys = 5ãDIM SHARED KeyNames(512) AS STRING * 15ãDIM GameKeys(-1 TO NumGameKeys - 1) AS STRINGãDIM GameKeyNum(-1 TO NumGameKeys - 1) AS INTEGERããSetUpKeyArrayããCLSãPRINT "set the keys:"ãGameKeys(-1) = "Quit"ãGameKeyNum(-1) = 27ãFOR k = 0 TO NumGameKeys - 1ã     LOCATE k + 3, 1ã     GameKeys(k) = "Key" + STR$(k)ã     PRINT GameKeys(k)ã     DOã          GameKeyNum(k) = GetKey(k + 3, 10)ã          flag = 0ã          FOR j = -1 TO k - 1ã               IF GameKeyNum(k) = GameKeyNum(j) THEN flag = 1ã          NEXTã          IF flag = 1 THEN BEEPã     LOOP UNTIL flag = 0ã     PRINT KKeyNameFromNum$((GameKeyNum(k)))ãNEXTããPRINTãPRINTãPRINT "Press your keys!!! esc to quit:"ãDOã     DOã          a$ = INKEY$ã     LOOP UNTIL a$ <> ""ã     k = KKeyNum(UCASE$(a$))ã     PRINT KKeyNameFromNum(k),ã     FOR j = -1 TO NumGameKeys - 1ã          IF k = GameKeyNum(j) THEN PRINT GameKeys(j),ã     NEXTã     PRINTãLOOP UNTIL k = GameKeyNum(-1)ããFUNCTION GetKey (x, y)ã     DOã     LOOP UNTIL INKEY$ = ""ã     DOã          IF TIMER - .2 > q THENã               q = TIMERã               j = NotIt(j)ã               COLOR j * 15ã               LOCATE x, yã               PRINT "_"ã          END IFã          a$ = INKEY$ã     LOOP UNTIL a$ <> "" AND KKeyName(a$) <> ""ãã     IF LEN(a$) = 1 THENã          a$ = UCASE$(a$)ã     END IFãã     GetKey = KKeyNum(a$)ãã     LOCATE x, yã     PRINT " "ã     LOCATE x, yã     COLOR 7ãEND FUNCTIONããFUNCTION KKeyName$ (a$)ã     KKeyName$ = Trim$(KeyNames(KKeyNum(a$)))ãEND FUNCTIONããFUNCTION KKeyNameFromNum$ (Num)ã     KKeyNameFromNum$ = Trim$(KeyNames(Num))ãEND FUNCTIONããFUNCTION KKeyNum (a$)ã     IF a$ = "" THENã          KKeyNum = 0ã     ELSEã          KKeyNum = 256 * (LEN(a$) - 1) + ASC(RIGHT$(a$, 1))ã     END IFãEND FUNCTIONããFUNCTION KKeyPress$ (Num)ã     IF Num / 256 >= 1 THENã          a$ = CHR$(0)ã     END IFã     KKeyPress$ = a$ + CHR$(Num MOD 256)ãEND FUNCTIONããSUB KSetKeys (Pre$, Lets$, start)ã     FOR j = 1 TO LEN(Lets$)ã          KeyNames(start + j - 1) = Pre$ + MID$(Lets$, j, 1)ã     NEXTãEND SUBããSUB KSetKeys2 (Pre$, Words$(), l, start)ã     FOR j = 0 TO l - 1ã          KeyNames(start + j) = Pre$ + Words$(j)ã     NEXTãEND SUBããFUNCTION NotIt (Num)ã     IF Num = 0 THENã          NotIt = 1ã     ELSEã          NotIt = 0ã     END IFãEND FUNCTIONããSUB SetUpKeyArrayã     KSetKeys "ALT + ", "1234567890-=", 256 + 120ã     KSetKeys "ALT + ", "QWERTYUIOP", 256 + 16ã     KSetKeys "ALT + ", "ASDFGHJKL", 256 + 30ã     KSetKeys "ALT + ", "ZXCVBNM", 256 + 44ã     KSetKeys "ALT + F", "123456789", 256 + 104ã     KeyNames(256 + 104 + 9) = "ALT + F10"ã     KeyNames(256 + 139) = "ALT + F11"ã     KeyNames(256 + 140) = "ALT + F12"ã     KSetKeys "F", "123456789", 256 + 59ã     KeyNames(256 + 59 + 9) = "F10"ã     KeyNames(256 + 133) = "F11"ã     KeyNames(256 + 134) = "F12"ã     KSetKeys "CTRL + F", "123456789", 256 + 94ã     KeyNames(256 + 103) = "CTRL + F10"ã     KeyNames(256 + 137) = "CTRL + F11"ã     KeyNames(256 + 138) = "CTRL + F12"ãã     DIM TempArray(12) AS STRINGã     TempArray(0) = "HOME"ã     TempArray(1) = "UP"ã     TempArray(2) = "PAGE UP"ã     TempArray(3) = ""ã     TempArray(4) = "LEFT"ã     TempArray(5) = "NUMPAD 5"ã     TempArray(6) = "RIGHT"ã     TempArray(7) = ""ã     TempArray(8) = "END"ã     TempArray(9) = "DOWN"ã     TempArray(10) = "PAGE DOWN"ã     TempArray(11) = "INSERT"ã     TempArray(12) = "DELETE"ã     KSetKeys2 "", TempArray(), 13, 256 + 71ãã     TempArray(0) = "CTRL + LEFT"ã     TempArray(1) = "CTRL + RIGHT"ã     TempArray(2) = "CTRL + END"ã     TempArray(3) = "CTRL + PGDN"ã     TempArray(4) = "CTRL + HOME"ã     KSetKeys2 "", TempArray(), 5, 256 + 115ã     KeyNames(256 + 132) = "CTRL+PGUP"ãã     KSetKeys "CTRL + ", "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 1ã     ã     FOR j = 33 TO 127ã          KeyNames(j) = UCASE$(CHR$(j))ã     NEXTãã     KeyNames(8) = "BACK"ã     KeyNames(9) = "TAB"ã     KeyNames(13) = "ENTER"ã     KeyNames(27) = "ESCAPE"ã     KeyNames(32) = "SPACE"ãEND SUBããFUNCTION Trim$ (t$)ã     txt$ = LTRIM$(RTRIM$(t$))ã     FOR j = 1 TO LEN(txt$)ã          IF ASC(MID$(txt$, j)) > 0 THENã               txt$ = MID$(txt$, j)ã               j = LEN(txt$) + 1000ã          END IFã     NEXTã     Trim$ = txt$ãEND FUNCTIONãWalt Decker                    2 Key Input Routines           lydia2hg@Yahoo.com             06-21-01 (20:30)       QB, QBasic, PDS, PB    110  3516     Kybd2.bas   DECLARE FUNCTION GetKeyMask% ()ãDECLARE FUNCTION gstFNGetKey$ (intF AS INTEGER, intE AS INTEGER, intB AS INTEGER)ããDEFINT A-ZãFUNCTION GetKeyMaskã'********************** CHECKS FOR KEY PRESSES *****************************ã'      This function can be modified to detect multiple (up to 3) simultaneousã'      key presses.ã'***************************************************************************ã   ExtKeySeg = INP(96)ã  SELECT CASE ExtKeySegã    CASE 75ã      L = ExtKeySeg                        'cursor leftã    CASE 72ã      U = ExtKeySeg                        'cursor upã    CASE 77ã      R = ExtKeySeg                        'cursor rightã    CASE 80ã      D = ExtKeySeg                        'cursor downã    CASE 28ã      ent = ExtKeySeg                      'Enterã    CASE 57ã      SB = ExtKeySeg                       'Space Barã    CASE 1ã      esc = ExtKeySeg                      'Escapeã    CASE 73ã      PgU = ExtKeySeg                      'page upã    CASE 81ã      PgD = ExtKeySeg                      'page downã    CASE 71ã      Hm = ExtKeySegã    CASE 79ã      EndKey = ExtKeySegã  END SELECTãã'********************** CLEAR KEYBOARD BUFFER ******************************ãã   DEF SEG = &H40                      'point head to tail thus emptyingã   POKE &H1A, PEEK(&H1C)               'the keyboard bufferãã'********************** SETUP CHECK FOR PROPER KEY PRESS *******************ãã   lowbyte = L OR U OR R OR D OR ent OR SB OR esc OR PgUã   highbyte = PgD OR Hm OR EndKeyãã   DEF SEG                                       'default segmentã   hbptr = VARPTR(highbyte)ã   POKE hbptr + 1, PEEK(hbptr)                   'move low byte to highã   POKE hbptr, 0                                 'clear low byteããã   GetKeyMask = lowbyte OR highbyte              'return all of itããEND FUNCTIONããFUNCTION gstFNGetKey$ (intF AS INTEGER, intE AS INTEGER, intB AS INTEGER)ãã'****************************************************************************ã'    This function checks for keys equal to those contained in the moduleã'    level arrays gstFkeys(), gstEkeys(), and gstBkeys().ã'    If a match is found, the array element is returned in intF, intE, orã'    intB.ãã'    If a match is not found, it is assumed that the key was one of the normalã'    keys and the keystroke is returned through gstFNGetKey.ãã'****************************************************************************ãã  DIM strKey AS STRING         ' temporary variablesã  DIM intI AS INTEGERãã  gstFNGetKey = ""             'initialize variablesã  intF = 0ã  intE = 0ã  intB = 0ãã  DO                           'loop until a key is pressedã    strKey = INKEY$ã  LOOP WHILE strKey = ""ãã  IF LEN(strKey) < 2 THEN GOTO Other.Keys   'must be a "normal" keyãã  FOR intI = 1 TO 10                        'Check for keys F1 - F10ã    IF strKey = gstFkeys(intI) THENã      intF = intIã      EXIT FUNCTIONã    END IFã  NEXT intIãã  FOR intI = 1 TO 11                       'Check for arrow keys and suchã    IF strKey = gstEkeys(intI) THENã      intE = intIã      EXIT FUNCTIONã    END IFã  NEXT intIããOther.Keys: 'ãã  FOR intI = 1 TO 4                       'Check for ESC, ENTER, etcã    IF strKey = gstBkeys(intI) THENã      intB = intIã      EXIT FUNCTIONã    END IFã  NEXT intIããgstFNGetKey = strKey                      'Normal key (i.e., A - Z, 0 - 9,ã                                          'etc.ããEND FUNCTIONããMario LaRosa                   Keyboard Handler               CMLAROSA73@aol.com             03-15-02 (  :  )       QB,Qbasic,PDS          105  2660     qkeys.bas   '''ã' Qkeys v1.2, a pure QB keyhandler that replaces INKEY$ã'ã' Brought to you by... MARIO SOFT.ã'ã' (C)opyright 2000ã'ã' Contact me at CMLAROSA73@aol.comã' If you have any questions or comments concerning these routines.ã'ã' THIS PROGRAM MAY BE DISTRIBUTED FREELY AS PUBLIC DOMAIN SOFTWAREã' AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.ã' IF YOU DO WISH TO USE THESE ROUTINES IN YOUR OWN PROGRAMSã' THEN PLEASE GIVE CREDIT TO THE AUTHOR... Mario LaRosa.ã'ã'''ã'$DYNAMICãDEFINT A-Zã'ãDECLARE SUB QKEYS ()ã'ãCOMMON SHARED KB1, KB2ã'ãBoxX = 154ãBoxY = 94ãcolour = 1ã'ãSCREEN 13ã'ãDOã '                                 Scan KeyBoard...ã QKEYSã '                                 Handle scanned keys...ã SELECT CASE KB1ã  CASE 32                          'Space Barã   colour = colour + 1ã   IF colour > 15 THEN colour = 1ã END SELECTã 'ã SELECT CASE KB2ã  CASE 1                           'Esc...ã   SYSTEMã  'CASE 57                         'Space Bar...ã  ' colour = colour + 1ã  ' IF colour > 15 THEN colour = 1ã  CASE 79                          'Numeric Key-Pad [1]ã   BoxY = BoxY + 1ã   BoxX = BoxX - 1ã   IF BoxY > 199 THEN BoxY = 199ã   IF BoxX < -10 THEN BoxX = -10ã  CASE 80                          'Numeric Key-Pad [2]ã   BoxY = BoxY + 1ã   IF BoxY > 199 THEN BoxY = 199ã  CASE 81                          'Numeric Key-Pad [3]ã   BoxY = BoxY + 1ã   BoxX = BoxX + 1ã   IF BoxY > 199 THEN BoxY = 199ã   IF BoxX > 319 THEN BoxX = 319ã  CASE 75                          'Numeric Key-Pad [4]ã   BoxX = BoxX - 1ã   IF BoxX < -10 THEN BoxX = -10ã  CASE 77                          'Numeric Key-Pad [6]ã   BoxX = BoxX + 1ã   IF BoxX > 319 THEN BoxX = 319ã  CASE 71                          'Numeric Key-Pad [7]ã   BoxY = BoxY - 1ã   BoxX = BoxX - 1ã   IF BoxY < -10 THEN BoxY = -10ã   IF BoxX < -10 THEN BoxX = -10ã  CASE 72                          'Numeric Key-Pad [8]ã   BoxY = BoxY - 1ã   IF BoxY < -10 THEN BoxY = -10ã  CASE 73                          'Numeric Key-Pad [9]ã   BoxY = BoxY - 1ã   BoxX = BoxX + 1ã   IF BoxY < -10 THEN BoxY = -10ã   IF BoxX > 319 THEN BoxX = 319ã END SELECTã '                                 Draw box...ã 'ã LINE (BoxX, BoxY)-(BoxX + 10, BoxY + 10), colour, BFã 'ã '                                 Wait for Vsync...ã WAIT &H3DA, 8ã '                                 Erase box...ã 'ã LINE (BoxX, BoxY)-(BoxX + 10, BoxY + 10), 0, BFã 'ãLOOPããREM $STATICãSUB QKEYSã '''ã DEF SEG = &H40ã 'ã KB = PEEK(&H1A)ã KB1 = PEEK(KB)ã KB2 = PEEK(KB + 1)ã 'ã POKE KB, 0ã POKE KB + 1, 0ã 'ã POKE &H1C, KBã '''ãEND SUBã