'===========================================================================
' Subject: QBASIC ROUTINES                   Date: 11-06-95 (03:31)       
' Author:  Douggie Green                     Code: QBasic                 
' Origin:  comp.lang.basic.misc            Packet: DOS.ABC
'===========================================================================
'>  I need some advise. I'm writing a small program with menus and one of 
'> selection should display contents of the diskette or HD.
'> I know I can do it going to Shell, but I want to have them displayed in
'> a small box on the same screen with menus. I'd like to have a feature 
'> of tagging these files and process them later.

'Um, well, I was going to wait until I'd plugged in a few more snippets,
'but seeing as one of the things this does is read directories and display
'file info, here it is.

'This is a beta posting of the new code snipets faq format. It currently
'runs in screen 0 only as the hi-liting routines only work in this mode.
'This will change (hopefully).
'This file will become the new code faq in a week or so. 

'There are no attributations(!) yet, or many comments. I think most of the
'code is fairly self-explanatory.

'Comments, criticisms, suggestions to me at :-
'Douggie@blissinx.demon.co.uk

'-----------------------------begin--cut here-------------------------------
DEFINT A-Z
DECLARE SUB Inverse (x%, y%, w$) 'Invert the word and it's backgound (toggle)
DECLARE SUB ShowBitMap (data$)   'Display a 16 colour bitmap
DECLARE SUB OpenHelpWindow ()    'Does what it says!
DECLARE SUB OpenAboutWindow ()   'More of the same
DECLARE SUB PageDown ()          'Show more files if there's more than a
DECLARE SUB PageUp ()            'screenful - PageUp does the reverse
DECLARE SUB OpenDropDown (x%, w%, d%)  'Open and close dropdown menus
DECLARE SUB CloseDropDown (x%, w%, d%)
DECLARE SUB ShowKeyboardStatus ()  'Status of Num lock, Insert, Alt, etc.
DECLARE SUB DoCommand (comm$)    'All commands are launched from here.
DECLARE SUB FileInfoWindow (filenumber%)
DECLARE SUB ShowFileDetails (filename$)
DECLARE SUB AlertWindow (message$)

DECLARE FUNCTION IsDirectory% (entry$)
DECLARE FUNCTION DropDownMenu$ (menu%)
DECLARE FUNCTION GetWhichCommand% (menu$)
DECLARE FUNCTION BitClear% (Number%, bit%)
DECLARE FUNCTION BitSet% (Number%, bit%)
DECLARE FUNCTION BitTest% (Number%, bit%)

DECLARE FUNCTION QueryWindow% (question$)
DECLARE SUB ShowFiles (first%, last%)
DECLARE SUB DrawBorder (x%, y%, w%, d%, bordertype%)
DECLARE SUB WriteWindow (x%, y%, w%, d%, windw() AS ANY)
DECLARE SUB ClearWindow (x%, y%, w%, d%)
DECLARE SUB ReadWindow (x%, y%, w%, d%, windw() AS ANY)
DECLARE SUB DrawScreen ()
DECLARE SUB Pause (message$)
DECLARE FUNCTION ScanWord$ (x%, y%, att%)
DECLARE FUNCTION Rstr$ (x%, LX%)

DECLARE SUB Interrupt (IntNum%, Regs AS ANY) 'Interrupt interface
DECLARE SUB GetMousePos (xp%, yp%)        'All these routines use interrupts
DECLARE FUNCTION ButtonStatus% (button$)
DECLARE FUNCTION ButtonRelease% (button$)
DECLARE SUB SetMousePos (xmpos%, ympos%)
DECLARE FUNCTION InitMouse% ()
DECLARE SUB ShowMouse ()
DECLARE SUB HideMouse ()

DECLARE FUNCTION ReadThisDir% ()
DECLARE FUNCTION GetBootDrive$ ()
DECLARE FUNCTION GetFreeSpace% (drive$)
DECLARE FUNCTION GetDosVer$ ()
DECLARE FUNCTION GetDefaultDrive$ ()
DECLARE FUNCTION GetCurrentDir$ ()
DECLARE FUNCTION Dir$ (DTA AS ANY, attr%)
DECLARE FUNCTION KeyBoardStatus% ()    'Last of the interrupt driven routines

TYPE DataTransferArea
	Reserved1   AS STRING * 21
	attribute   AS STRING * 1
	FileTime    AS INTEGER
	filedate    AS INTEGER
	filesize    AS LONG
	filename    AS STRING * 13
END TYPE

TYPE DirectoryRecord
	filename    AS STRING * 13
	filesize    AS LONG
	filedate    AS STRING * 12
	FileTime    AS STRING * 14
	fileattb    AS STRING * 2
END TYPE

DIM SHARED FileDetails(200) AS DirectoryRecord
DIM SHARED TempFileDetails AS DirectoryRecord

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

DIM SHARED Regs AS RegTypeX

TYPE windowdetails
	character AS STRING * 1
	attribute AS STRING * 1
END TYPE

CONST Rshift = 0, Lshift = 1, Ctrl = 2, Alt = 3, Scrollock = 4
CONST NumLock = 5, CapsLock = 6, Insert = 7
CONST kpageup = 73, kpagedown = 81
CONST ret = 13, maxfiles = 95, maxsize = 2000

DIM SHARED windw(maxsize) AS windowdetails
DIM SHARED page, fst, lst, count AS INTEGER

COMMON SHARED selection$

'-------------------------start of main code-------------------------
SCREEN 0
CLS
mousebuttons = InitMouse  '' This will usually return 2, even with 3 button
																										'' mice <dg>
IF mousebuttons = 0 THEN
		PRINT "Mouse not present"
		END
END IF

DrawScreen

CALL SetMousePos(30, 10)              '' x,y format, based on 80x25 screen
	
ShowMouse

count = ReadThisDir%    'How many files in this directory?

ShowFiles 0, maxfiles   'List first page of files

DO                      'Main control loop

 ShowKeyboardStatus      'Alt, numlock status etc.
 
 IF ButtonRelease("l") THEN              'Deal with the mouse first
 
	GetMousePos mxp, myp
 
	word$ = ScanWord$(mxp, (myp), attr)
 
	IF word$ <> "" AND myp = 0 THEN        'Got a menubar command
	 maincomm = GetWhichCommand%(word$)    'Find which menu to open
	 menuselection$ = DropDownMenu$(maincomm) 'Get the actual command (Help etc)
	 DoCommand menuselection$                 'Do it
	END IF
 
	IF word$ <> "" AND IsDirectory(word$) THEN  'This is a directory (.. etc)
	 CHDIR MID$(word$, 2, LEN(word$) - 2)      'Trim the "<" and ">"
	 selection$ = "": word$ = ""         'Clear these to avoid problems
	 DrawScreen                               'Change directory, re-read and
	 count = ReadThisDir%                    'update the display
	 ShowFiles 0, maxfiles
	END IF
	
	IF word$ <> "" AND myp < 22 AND myp > 1 THEN  'It's a filename
	
	 IF attr = 7 THEN              'Not a hi-lited filename, so it's a new
		IF selection$ <> "" THEN     'selection
			Inverse selxpos, selypos, selection$  'un-hilite the old selection
			selection$ = ""                       'and clear it
		END IF
	 END IF
	
	 IF selection$ = word$ THEN    'clicked on the old selection
		 selection$ = ""          'so clear it
	 ELSE
		selection$ = word$        'new selection, so store co-ords for future
		selypos = myp
		selxpos = mxp
	 END IF

	 Inverse mxp, myp, word$    'hilite the new selection or un-hilite the
															'current selection
	 LOCATE 25, 1: PRINT STRING$(26, 32);
	 LOCATE 25, 1: PRINT "Selection : "; selection$;
 
	END IF              'End of the filename handler
 
 END IF                       'End of mouse interface bits
 
 a$ = INKEY$                  'Now handle any key presses
 ctrlkey = 0                  'simple toggle
 
 IF a$ <> "" THEN
	IF LEN(a$) = 2 THEN keypress = ASC(RIGHT$(a$, 1)): ctrlkey = 1
	
	IF ctrlkey THEN            'handle control keys (pageup, pagedown etc)
	 IF keypress = kpageup THEN PageUp
	 IF keypress = kpagedown THEN PageDown
	END IF
 
 END IF
 
LOOP UNTIL a$ = " "          'End of main loop

END


''hex data for interrupt routines

DATA  &H55, &H8B, &HEC, &H83, &HEC, &H08, &H56, &H57, &H1E, &H55, &H8B, &H5E
DATA  &H06, &H8B, &H47, &H10, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA  &H10, &H8B, &H47, &H12, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA  &H12, &H8B, &H47, &H08, &H89, &H46, &HF8, &H8B, &H07, &H8B, &H4F, &H04
DATA  &H8B, &H57, &H06, &H8B, &H77, &H0A, &H8B, &H7F, &H0C, &HFF, &H77, &H12
DATA  &H07, &HFF, &H77, &H02, &H1E, &H8F, &H46, &HFA, &HFF, &H77, &H10, &H1F
DATA  &H8B, &H6E, &HF8, &H5B, &HCD, &H21, &H55, &H8B, &HEC, &H8B, &H6E, &H02
DATA  &H89, &H5E, &HFC, &H8B, &H5E, &H06, &H1E, &H8F, &H46, &HFE, &HFF, &H76
DATA  &HFA, &H1F, &H89, &H07, &H8B, &H46, &HFC, &H89, &H47, &H02, &H89, &H4F
DATA  &H04, &H89, &H57, &H06, &H58, &H89, &H47, &H08, &H89, &H77, &H0A, &H89
DATA  &H7F, &H0C, &H9C, &H8F, &H47, &H0E, &H06, &H8F, &H47, &H12, &H8B, &H46
DATA  &HFE, &H89, &H47, &H10, &H5A, &H1F, &H5F, &H5E, &H8B, &HE5, &H5D, &HCA
DATA  &H02, &H00          

menubar:
DATA 3,"Disk","File","Help"

menuitems:
DATA 2,7,3,"Format","Dir","Shell"
DATA 10,5,5,"List","Edit","Info","View","Exit"
DATA 72,6,2,"Help","About"


about:
DATA 4,"The new BASIC code FAQ","Version 0.1 - 2/NOV/95"
DATA "email Douggie@blissinx.demon.co.uk"
DATA "or basicfaq@blissinx.demon.co.uk"

help:
DATA 3,"Use pageup and pagedown if the list"
DATA "of files is bigger than the screen"
DATA "Press the space bar to exit the program."

SUB AlertWindow (m$)
ln = LEN(m$)

x = 40 - ((ln + 2) / 2)
y = 10: w = ln + 4: d = 4

ReadWindow x, y, w, d, windw()
ClearWindow x, y, w, d
DrawBorder x, y, w, d, 2
'nbeep

LOCATE y + 1, x + ((w - ln) / 2)
PRINT m$;
LOCATE y + 2, x + ((w - 2) / 2)
PRINT "Ok";

DO
		IF ButtonRelease("l") THEN
				GetMousePos tx, ty
				IF ty = y + 1 THEN
						ans$ = ScanWord$(tx, (ty), dum)
						IF ans$ = "Ok" THEN
								'flash tx, ty + 1, ans$
								'writewindow x, y, w, d, windw%()
						END IF
				END IF
		END IF

key$ = INKEY$
IF key$ <> "" THEN ky = ASC(key$)

LOOP UNTIL ans$ = "Ok" OR ky = ret
WriteWindow x, y, w, d, windw()
END SUB

FUNCTION BitClear% (Number%, bit%)
				BitClear% = Number% AND (32767 - 2 ^ bit%)
END FUNCTION

FUNCTION BitSet% (Number%, bit%)
				BitSet% = Number% OR 2 ^ bit%
END FUNCTION

FUNCTION BitTest% (Number%, bit%)
				BitTest% = -SGN(Number% AND 2 ^ bit%)
END FUNCTION

FUNCTION ButtonRelease (b$)
Regs.ax = &H6
	IF LEFT$(UCASE$(b$), 1) = "L" THEN Regs.bx = 0 ELSE Regs.bx = 1
Interrupt &H33, Regs

ButtonRelease = Regs.bx  '' Count of releases, reset to 0 each call.

END FUNCTION

FUNCTION ButtonStatus (b$)
''  b$ should be either "l" or "r". When called once, will return the
''  number of times the specified button has been pressed since the last
''  call. When used in a loop, as in this demo prog, it works like INKEY$
''  Could be split into ButtonDown() and ButtonCount()  <dg>

		Regs.ax = &H5
		IF LEFT$(UCASE$(b$), 1) = "L" THEN Regs.bx = 0 ELSE Regs.bx = 1
		Interrupt &H33, Regs
	
		ButtonStatus = Regs.bx  '' Count of presses, reset to 0 each call.
	
		IF Regs.ax > 0 THEN ButtonStatus = Regs.ax  '' Is a button down?
																																														''if so, return which button
END FUNCTION

SUB ClearWindow (x, y, w, d)

ty = y
COLOR 7, 0
FOR k = 1 TO d - 1
			LOCATE y + k, x
			PRINT STRING$(w, 32)
NEXT k

END SUB

SUB CloseDropDown (x, w, d)
y = 2
w = w + 2
d = d + 2
WriteWindow x, y, w, d, windw()
END SUB

FUNCTION Dir$ (dt AS DirectoryRecord, attribute) STATIC

DIM dtarec AS DataTransferArea
Null$ = CHR$(0)

			'-----  Set up our own DTA so we don't destroy COMMAND$
Regs.ax = &H1A00                    'Set DTA function
Regs.dx = VARPTR(dtarec)               'DS:DX points to our DTA
Regs.ds = -1                        'Use current value for DS
CALL Interrupt(&H21, Regs)            'Do the interrupt

IF ASC(dt.filename) > 32 THEN
	FileSpecZ$ = dt.filename + Null$
	Regs.ax = &H4E00
	Regs.cx = attribute
	Regs.dx = SADD(FileSpecZ$)
	Regs.ds = -1
ELSE
	Regs.ax = &H4F00
END IF
dtarec.filename = ""
CALL Interrupt(&H21, Regs)

IF Regs.flags AND 1 THEN
	Dir$ = ""
ELSE
	Day = dtarec.filedate AND &H1F
	Month = (dtarec.filedate AND &H1E0) \ 32
	Year = (dtarec.filedate AND &HFE00) \ 512 + 1980
	dt.filedate = Rstr$(Month, 2) + "-" + Rstr$(Day, 2) + "-" + Rstr$(Year, 4)
	
	Seconds = (dtarec.FileTime AND &H1F) * 2
	Minutes = (dtarec.FileTime AND &H7E0) \ 32
	Hours = (dtarec.FileTime < 0) * (-16) + ((dtarec.FileTime AND &H7FFF) \ 2048)
	Abbr$ = " am"
	IF Hours = 12 THEN Abbr$ = " pm"
	IF Hours = 0 THEN Hours = 12
	IF Hours > 12 THEN   'Reset to 12 hour clock
		Hours = Hours MOD 12
		Abbr$ = " pm"
	END IF
	
	dt.FileTime = Rstr$(Hours, 2) + ":" + Rstr$(Minutes, 2) + ":" + Rstr$(Seconds, 2) + Abbr$
	dt.filename = dtarec.filename
	dt.filesize = dtarec.filesize
	dt.fileattb = STR$(ASC(dtarec.attribute))
'PRINT dt.fileattb
	Dir$ = dt.filename
END IF

END FUNCTION

SUB DoCommand (cm$)

IF cm$ = "About" THEN
	OpenAboutWindow
	EXIT SUB
END IF

IF cm$ = "Help" THEN
	OpenHelpWindow
	EXIT SUB
END IF

IF cm$ = "Exit" THEN
 END
END IF

IF cm$ = "Format" THEN
 AlertWindow ("Write your own code for this!")
 EXIT SUB
END IF

IF cm$ = "Shell" THEN
	HideMouse
	CLS
	PRINT "Type EXIT to resume"
	SHELL ("")
	d = InitMouse
	DrawScreen
	ShowFiles 0, count
	ShowMouse
	EXIT SUB
END IF

' handle actions on the selected file

IF cm$ <> "" AND selection$ = "" THEN AlertWindow ("No file selected!"): EXIT SUB

IF cm$ = "Info" THEN
 ShowFileDetails (selection$)
END IF

IF cm$ = "Edit" THEN
 HideMouse
 SHELL ("edit " + selection$)
 d = InitMouse
 ShowMouse
END IF

IF cm$ = "View" THEN
 ShowBitMap selection$
 DrawScreen
 ShowFiles 0, count
 ShowMouse
END IF

IF cm$ = "List" THEN
 HideMouse
 CLS
 SHELL ("type " + selection$ + " | more ")
 Pause "Press a key to continue"
 DrawScreen
 ShowFiles 0, count
 ShowMouse
END IF

END SUB

SUB DrawBorder (x, y, w, d, b)

		IF b = 1 THEN
				tlc% = 201: trc% = 187: blc% = 200: brc% = 188: vb% = 186: hb% = 205
						ELSEIF b > 1 THEN
				tlc% = 218: trc% = 191: blc% = 192: brc% = 217: vb% = 179: hb% = 196
				END IF

IF b = 3 THEN tlc% = 194: trc% = 194

		IF b <> 0 THEN
				LOCATE y, x: PRINT CHR$(tlc%);
				PRINT STRING$(w - 2, hb%); : PRINT CHR$(trc%)
						FOR k% = 1 TO d - 2
								LOCATE y + k%, x: PRINT CHR$(vb%)
								LOCATE y + k%, x + w - 1: PRINT CHR$(vb%)
						NEXT
				LOCATE y + d - 1, x: PRINT CHR$(blc%);
				PRINT STRING$(w - 2, hb%); : PRINT CHR$(brc%)
		END IF

END SUB

SUB DrawScreen
CLS
PRINT "Disk     File                      ";
PRINT "                                        Help "
PRINT STRING$(80, 196);
LOCATE 22, 1
PRINT STRING$(80, 196);
LOCATE 23, 1: PRINT "Last booted from "; GetBootDrive$;
LOCATE 23, 22: PRINT "Default drive "; GetDefaultDrive$;
LOCATE 23, 40: PRINT "DOS version "; GetDosVer$;

LOCATE 23, 58: PRINT "Free space "; GetFreeSpace%(GetDefaultDrive$); " K";
LOCATE 24, 1: PRINT "Current directory "; GetCurrentDir$;
LOCATE 25, 1: PRINT STRING$(26, 32);
LOCATE 25, 1: PRINT "Selection : "; selection$;

END SUB

FUNCTION DropDownMenu$ (menu)
RESTORE menuitems

FOR k = 0 TO menu - 1
	READ xpos, wide, numofitems
	FOR j = 1 TO numofitems
		READ item$
	NEXT
NEXT

READ xpos, wide, numofitems
CALL OpenDropDown((xpos), (wide), (numofitems))

FOR k = 1 TO numofitems
	READ item$
	LOCATE k + 2, xpos + 1
	PRINT item$;
NEXT

DO
GetMousePos x, y
x = x + 1

but = ButtonRelease("l")
a$ = INKEY$
LOOP UNTIL LEN(a$) OR but

IF x > xpos AND x < xpos + wide AND y > 1 AND y < y + numofitems THEN
	com$ = ScanWord$(x - 1, y, d)   'Get the command as text
	comm = y - 2                    'Get the command as an numeric offset
END IF

'LOCATE 25, 1: PRINT com$, comm;

CloseDropDown xpos, wide, numofitems

DropDownMenu$ = com$

END FUNCTION

SUB FileInfoWindow (k)

x = 25: y = 10
w = 30: d = 6

ReadWindow x, y, w, d, windw()
ClearWindow x, y, w, d
DrawBorder x, y, w, d, 2

LOCATE y + 1, x + 2
PRINT "File name ; "; FileDetails(k).filename
LOCATE y + 2, x + 2
PRINT "File size ;"; FileDetails(k).filesize; " Bytes"
LOCATE y + 3, x + 2
PRINT "File date ; "; FileDetails(k).filedate

LOCATE y + 4, x + 14
PRINT "Ok";

DO
		IF ButtonRelease("l") THEN
				GetMousePos tx, ty
				IF ty = y + 3 THEN
						ans$ = ScanWord$(tx, (ty), dum)
						IF ans$ = "Ok" THEN
								'flash tx, ty + 1, ans$

						END IF
				END IF
		END IF

key$ = INKEY$
IF key$ <> "" THEN ky = ASC(key$)

LOOP UNTIL ans$ = "Ok" OR ky = ret
WriteWindow x, y, w, d, windw()

END SUB

SUB flash (x, y, a$)
HideMouse
LOCATE y, x
COLOR 0, 7
PRINT a$;
FOR k = 1 TO 20000: NEXT
LOCATE y, x
COLOR 7, 0
PRINT a$;
FOR k = 1 TO 20000: NEXT
ShowMouse
END SUB

FUNCTION GetBootDrive$

'Returns the drive the system was last re-booted from as a letter plus
'a colon, eg, C: or A:

Regs.ax = &H3305
CALL Interrupt(&H21, Regs)
GetBootDrive$ = CHR$((Regs.dx MOD 256) + 64) + ":"
END FUNCTION

FUNCTION GetCurrentDir$

'Returns the current working directory, this may or may NOT be the directory
'the program was started from

DIM buf AS STRING * 80
Null$ = CHR$(0)

Regs.ax = &H4700
Regs.dx = 0             'The default drive, 1=A, 2=B, 3=C, 4=D etc
																								'A null string ("") is returned if the root
																								'directory is found (ie, C:\ or A:\ )

Regs.ds = -1            'Use current DS
Regs.si = VARPTR(buf)
CALL Interrupt(&H21, Regs)            'Do the interrupt
	
IF Regs.flags AND 1 THEN
	PRINT "An error has occured in Function GetCurrentDir$. Error no. is ";
	PRINT Regs.flags
	PRINT "This program is terminating."
	END
ELSE
	Null = INSTR(buf, Null$)
	GetCurrentDir$ = MID$(buf, 1, Null - 1)
END IF

END FUNCTION

FUNCTION GetDefaultDrive$

Regs.ax = &H1900
CALL Interrupt(&H21, Regs)
GetDefaultDrive$ = CHR$((Regs.ax MOD 256) + 65) + ":"
END FUNCTION

FUNCTION GetDosVer$
'Returns major and minor version as a string of the format "6.20)

Regs.ax = &H3306
CALL Interrupt(&H21, Regs)            'Do the interrupt
GetDosVer$ = Rstr$(Regs.bx AND &HFF, 1) + "." + Rstr$(Regs.bx \ &HFF, 2)
END FUNCTION

FUNCTION GetFreeSpace% (d$)

'd$ can be either upper or lower case
'Returns disk free space rounded to the nearest kilobyte
'If the drive doesn't exist, GetFreeSpace% returns 0
'If there is no disk in the (floppy) drive, the system will lock up,
'requiring a soft reset (Ctrl+Alt+Del)

Regs.ax = &H3600
Regs.dx = (ASC(d$) AND &HDF) - 64  'Turn drive letter into (1 - No. of drives)
CALL Interrupt(&H21, Regs)
GetFreeSpace% = Regs.bx * ((Regs.ax * Regs.cx) / 1024)
END FUNCTION

SUB GetMousePos (xp, yp)
		Regs.ax = &H3
		Interrupt &H33, Regs
		xp = Regs.cx / 8   '' These values may need changing depending on
		yp = Regs.dx / 8   '' your screen mode <dg>
END SUB

FUNCTION GetWhichCommand% (menu$)
RESTORE menubar
READ numofitems
FOR comm = 0 TO numofitems - 1
	READ menuitem$
	IF menuitem$ = menu$ THEN
		EXIT FOR
	END IF
NEXT
GetWhichCommand% = comm

END FUNCTION

SUB HideMouse
		Regs.ax = &H2
		Interrupt &H33, Regs
END SUB

FUNCTION InitMouse
		Regs.ax = &H0
		Interrupt &H33, Regs
		IF Regs.ax <> 0 THEN InitMouse = Regs.bx ELSE InitMouse = 0
END FUNCTION

SUB Interrupt (IntNum, Regs AS RegTypeX) STATIC
		STATIC filenum, IntOffset, Loaded
		
		' use fixed-length string to fix its position in memory
		' and so we don't mess up string pool before routine
		' gets its pointers from caller
		DIM IntCode AS STRING * 200
		IF NOT Loaded THEN                     ' loaded will be 0 first time
			
			FOR k = 1 TO 145
						READ h%
						MID$(IntCode, k, 1) = CHR$(h%)
			NEXT

														''  determine address of interrupt no. offset in IntCode
			IntOffset = INSTR(IntCode$, CHR$(&HCD) + CHR$(&H21)) + 1
			Loaded = -1
		END IF
SELECT CASE IntNum
				CASE &H25, &H26, IS > 255               ' ignore these interrupts
				CASE ELSE
						DEF SEG = VARSEG(IntCode)             ' poke interrupt number into
						POKE VARPTR(IntCode) * 1& + IntOffset - 1, IntNum     ' code block
						CALL Absolute(Regs, VARPTR(IntCode$))               ' call routine
		END SELECT
END SUB

SUB Inverse (x, y, w$)
HideMouse
att = SCREEN(y + 1, x, 1)
LOCATE y + 1, x
IF att = 112 THEN COLOR 7, 0 ELSE COLOR 0, 7
PRINT w$;
COLOR 7, 0
ShowMouse
END SUB

FUNCTION IsDirectory% (entry$)

FOR k = 1 TO count
	IF entry$ = LEFT$(FileDetails(k).filename, LEN(entry$)) AND FileDetails(k).fileattb = " 1" THEN
		IsDirectory% = k
		EXIT FOR
	END IF
NEXT

END FUNCTION

FUNCTION KeyBoardStatus%
Regs.ax = &H200
CALL Interrupt(&H16, Regs)
KeyBoardStatus% = Regs.ax
END FUNCTION

SUB nbeep
SOUND 2500, 2
END SUB

SUB OpenAboutWindow

RESTORE about
READ numofitems

x = 20: y = 10
w = 40: d = numofitems + 2

ReadWindow x, y, w, d, windw()
ClearWindow x, y, w, d
DrawBorder x, y, w, d, 2

FOR k = 1 TO numofitems
	LOCATE y + k, x + 2
	READ item$
	PRINT item$
NEXT

DO
LOOP UNTIL LEN(INKEY$) OR ButtonRelease("l")

WriteWindow x, y, w, d, windw()
END SUB

SUB OpenDropDown (x, w, d)
y = 2
w = w + 2
d = d + 2
ReadWindow x, y, w, d, windw()
ClearWindow x, y, w, d
DrawBorder x, y, w, d, 3

END SUB

SUB OpenHelpWindow

RESTORE help
READ numofitems

x = 20: y = 10
w = 45: d = numofitems + 2

ReadWindow x, y, w, d, windw()
ClearWindow x, y, w, d
DrawBorder x, y, w, d, 1

FOR k = 1 TO numofitems
	LOCATE y + k, x + 2
	READ item$
	PRINT item$
NEXT

DO
but = ButtonRelease("l")
a$ = INKEY$
LOOP UNTIL LEN(a$) OR but

WriteWindow x, y, w, d, windw()

END SUB

SUB PageDown

page = page + 1
fst = page * maxfiles
IF fst > count + 1 THEN
		BEEP
		page = page - 1
		EXIT SUB
END IF
lst = fst + maxfiles
'scrllbarps = scrllbarps + scrllinterval
ShowFiles fst, lst
END SUB

SUB PageUp
page = page - 1
IF page < 0 THEN
		BEEP
		page = page + 1
		EXIT SUB
END IF
fst = page * maxfiles
lst = fst + maxfiles
ShowFiles fst, lst

END SUB

SUB Pause (m$)
IF m$ <> "" THEN PRINT m$;
WHILE a$ = ""
a$ = INKEY$
WEND
END SUB

FUNCTION QueryWindow (m$)

IF LEN(m$) < 10 THEN
		fill = (10 - LEN(m$)) / 2
		fill$ = STRING$(fill, 32)
		m$ = fill$ + m$ + fill$
END IF

x = 40 - ((LEN(m$) + 2) / 2)
y = 10: w = LEN(m$) + 2: d = 5

ReadWindow x, y, w, d, windw()
ClearWindow x, y, w, d
DrawBorder x, y, w, d, 2

LOCATE y + 1, x + 1
PRINT m$
tx = x + ((w - 1) / 2) - 4

LOCATE y + 3, tx
PRINT "Yes  No"
ty = y
b = -1
DO
		IF ButtonRelease("l") THEN
				GetMousePos tx, ty
				IF ty = y + 3 THEN
						ans$ = ScanWord$(tx, (ty), dum)
						'flash tx, ty, ans$
						b = INSTR("NY", LEFT$(ans$, 1)) - 1
						' querywindow = b
				END IF
				IF ty <> y + 3 THEN
						'nbeep
						WriteWindow x, y, w, d, windw()
						EXIT FUNCTION
				END IF
		END IF

		c$ = ""
		c$ = INKEY$
		IF c$ <> "" THEN
				c$ = UCASE$(c$)
				b = INSTR("NY", c$) - 1
		END IF

LOOP UNTIL ans$ <> "" OR b <> -1
WriteWindow x, y, w, d, windw()
QueryWindow = b

END FUNCTION

FUNCTION ReadThisDir%

FOR k = 1 TO count
	TempFileDetails.filename = ""
	FileDetails(k).filename = ""
NEXT

TempFileDetails.filename = "*.*"   'adjust this as appropriate
attr = 16

found$ = Dir$(TempFileDetails, attr)     'check for the first file
count = 1

DO WHILE LEN(found$)
	 
		IF TempFileDetails.fileattb = " 1" THEN
			TempFileDetails.filename = "<" + TempFileDetails.filename
			MID$(TempFileDetails.filename, INSTR(TempFileDetails.filename, CHR$(0))) = ">"
		END IF

		FileDetails(count) = TempFileDetails
		count = count + 1
		TempFileDetails.filename = ""
		found$ = Dir$(TempFileDetails, attr) '' Notice the null filespec.
LOOP
ReadThisDir% = count

END FUNCTION

SUB ReadWindow (x, y, w, d, windw() AS windowdetails)
l = 0
ty = y + d
tx = x + w
HideMouse
FOR k = y TO ty
			FOR j = x TO tx
						LOCATE k, j
						windw(l).character = CHR$(SCREEN(k, j))
						windw(l).attribute = CHR$(SCREEN(k, j, 1) - 7)
						l = l + 1
			NEXT j
NEXT k
ShowMouse
END SUB

FUNCTION Rstr$ (x%, LX%)
x$ = STR$(x%)
Rstr$ = RIGHT$("00000" + RIGHT$(x$, LEN(x$) - 1), LX%)
END FUNCTION

FUNCTION ScanWord$ (x, y, att)
y = y + 1: x = x + 1 '' need to adjust because the mouse routines return
																					
HideMouse

c = SCREEN(y, x)             ''Get the character under the mouse cursor
att = SCREEN(y, x, 1)        ''and it's atribute                                           
IF c > 39 AND c < 123 THEN   ''We're over a word so...
LOCATE y, x

DO                       ''Find the start of the word
c = SCREEN(y, x)
x = x - 1
LOOP UNTIL c < 39 OR c > 123 OR x = 0
			
IF x > 0 THEN x = x + 2  ''We end up at the x position *before* the word
IF x = 0 THEN x = 1      ''SCREEN and LOCATE need this, just in case.
			
DO                       ''Read the word
c = SCREEN(y, x)
w$ = w$ + CHR$(c)
x = x + 1
LOOP UNTIL c < 39 OR c > 123 OR x = 0

w$ = LEFT$(w$, LEN(w$) - 1)  ''We end up past the word, so trim it.
x = x - LEN(w$) - 1
END IF

ScanWord$ = w$
ShowMouse
END FUNCTION

SUB SetMousePos (xmpos, ympos)
		Regs.ax = &H4
		Regs.cx = xmpos * 8 '' These values may need changing depending on
		Regs.dx = ympos * 8 '' your screen mode <dg>
		Interrupt &H33, Regs

END SUB

' 2) --------------------------begin SHOWBMP2.BAS---------------------
''This is at least twice as fast as the previous routine.
'By Kim Christensen
'This routine will read in a Windows Bitmap file and display it.
'Only 16 color Bitmaps are supported. Even with SCREEN 13: I am
'only using that mode to "blow up" the picture a bit.
'Comments? Questions? Suggestions? : uv317@freenet.victoria.bc.ca
'No flames please! :)
SUB ShowBitMap (data$)

'INPUT "Filename"; data$
IF LTRIM$(RTRIM$(data$)) = "" THEN END
OPEN data$ FOR BINARY AS #1
IF LOF(1) = 0 THEN AlertWindow ("File not found!"): CLOSE : KILL data$: END

table$ = INPUT$(54, #1)  'Get the file header (54 bytes)
DIM table&(30)           'Create numerical array for header
DEF SEG = VARSEG(table&(1))
pointer% = VARPTR(table&(1))

'Poke the data from string "table$" into numerical array "table&"
FOR x% = 0 TO 51
 POKE pointer% + x%, ASC(MID$(table$, x% + 3, 1))
NEXT
DEF SEG

'Check for valid file type
IF MID$(table$, 1, 2) <> "BM" OR table&(4) <> 40 THEN
	 AlertWindow ("Not a valid *.BMP file!"): CLOSE : EXIT SUB
END IF
IF table&(8) <> 0 THEN
		AlertWindow ("This program will not diplay RLE encoded files"): CLOSE : EXIT SUB
END IF
IF ASC(MID$(table$, 29, 1)) <> 4 THEN
	 AlertWindow ("Only 16 color bitmaps are supported!"): CLOSE : EXIT SUB
END IF

'Set the video mode for best picture fit
IF (table&(5) < 321) AND (table&(6) < 201) THEN
	 SCREEN 13
ELSE
	 SCREEN 12
END IF
LOCATE 2, 1
PRINT " Image is "; table&(5); " by "; table&(6)

thecolors$ = INPUT$(table&(3) - 54, #1) 'Read in pallette info
DEF SEG = VARSEG(pal&)
pointer% = VARPTR(pal&)
'Poke the pallette info from the string "thecolors$"
'into pal& and reduce to 6 bits per byte.
FOR x% = 0 TO 63 STEP 4
 POKE pointer%, (ASC(MID$(thecolors$, x% + 3, 1))) \ 4
 POKE pointer% + 1, (ASC(MID$(thecolors$, x% + 2, 1))) \ 4
 POKE pointer% + 2, (ASC(MID$(thecolors$, x% + 1, 1))) \ 4
 POKE pointer% + 3, 0
PALETTE x% \ 4, pal&
NEXT
DEF SEG

'Read in Bitmap data and set pixels accordingly
y% = table&(6) 'Put number of vertical pixels into y%
DO
	data$ = INPUT$((((table&(5) - 1) OR 7) + 1) \ 2, #1)
		IF (table&(5) \ 2) < LEN(data$) THEN
			 linelength% = table&(5) \ 2
		ELSE
			 linelength% = LEN(data$)
		END IF
		FOR x% = 1 TO linelength%
			pixel% = ASC(MID$(data$, x%, 1))
			PSET (x% * 2 + 1, y%), pixel% AND 15
			PSET (x% * 2, y%), pixel% \ 16
		NEXT
		y% = y% - 1
LOOP UNTIL EOF(1) OR INKEY$ <> ""

Pause ""
SCREEN 0
END SUB

SUB ShowFileDetails (filename$)
'first check it's in the list we made

FOR k = 1 TO count
	IF filename$ = LEFT$(FileDetails(k).filename, LEN(filename$)) THEN
		FileInfoWindow (k)
		EXIT FOR
	END IF
NEXT

END SUB

SUB ShowFiles (first, last)
k = 3: l = first
HideMouse
DO
		l = l + 1
		y = k MOD 22: x = ((k \ 22)) * 16
		IF y < 3 THEN y = 3:  k = k + 3
		IF x = 0 THEN x = 1
		LOCATE y, x: PRINT FileDetails(l).filename;
		k = k + 1:
LOOP UNTIL l = last
ShowMouse
END SUB

SUB ShowKeyboardStatus
k% = KeyBoardStatus%
LOCATE 25, 40
IF BitTest%(k%, Insert) THEN PRINT "Ins ";  ELSE PRINT "Over";
IF BitTest%(k%, Lshift) THEN PRINT "Lshift";  ELSE PRINT "      ";
IF BitTest%(k%, Rshift) THEN PRINT "Rshift";  ELSE PRINT "      ";
IF BitTest%(k%, Alt) THEN PRINT "Alt";  ELSE PRINT "   ";
IF BitTest%(k%, Ctrl) THEN PRINT "Ctrl";  ELSE PRINT "    ";
IF BitTest%(k%, NumLock) THEN PRINT "Num";  ELSE PRINT "   ";
IF BitTest%(k%, CapsLock) THEN PRINT "Caps";  ELSE PRINT "    ";
IF BitTest%(k%, Scrollock) THEN PRINT "Scroll";  ELSE PRINT "      ";

END SUB

SUB ShowMouse
		Regs.ax = &H1
		Interrupt &H33, Regs
END SUB

SUB WriteWindow (x, y, w, d, windw() AS windowdetails)
l = 0
ty = y + d
tx = x + w
HideMouse
FOR k = y TO ty
			FOR j = x TO tx
						LOCATE k, j
						COLOR 7, 0
						IF ASC(windw(l).attribute) THEN COLOR 0, 7
						PRINT windw(l).character;
						l = l + 1
			NEXT j
NEXT k
ShowMouse
END SUB