_TITLE "getArrayItem v3 font tests"
' Main testing and demo of the FUNCTION getArrayItemNumber%
'started 2018-08-31 B+ developing a general purpose display and select app of a string array
' in this version want
' 1 to be able to select item from larger arrays that take several pages to screen
' 2 highlite mouse over ?
' 3 colorize print? Eh! bloats parameters in call, if really want, modify function for app.
' Using dark blue on sky blue and reverse for highlite, pretty easy on eyes and sets off
' selection area.
' 4 keep modifiable for possibly adding fonts, I think that means use only locate and print,
' as _printstring works in pixels, no good for different fonts. (Neither is LOCATE)
' 2018-09-01 yea, finally got everything working and playing together
' oh yeah, to mouse click an escape along with expected escape button press.
' I might to build a frame around the list box control? (No, just a bar above and below)
'2018-09-03 OK everything working great! But I have added two lines to maxHeight.
' Do I adjust maxHeight to reflect actual height of box on screen, I think better do it.
' Oh heck that was easy! Just calc maxHeight off boxHeight!
' Clean up instructions for using the function.
' NEXT project is message box that doesn't need Windows OS calls,
' so I could offer help here with h keypress!
' Just tested a font with locate and print and locate does not work.
' So this is done until I get messageBox working.
'2018-09-04 post v2 bak 9-3_9PM
'2018-09-04 getArrayItem v3.bas start tests with font subs, hurrah! it worked!
CONST nArr
= 92 'ubound of array = actual amount of items if LBound = 1 CONST LB
= 1 'try different lower bounds not just 0, 1 CONST WW
= 1200 'Window Width CONST WH
= 600 'Window Height
'font stuff CC = currnet column, CR = current row, CW = cell width, CH = cell height, MAXCOL = max columns/rows allowed for screen
SF
= _FONT 'normal screen font
'FH is font handle for Arial Round Bold, set up font SHARED variables for font subs
FH
= _LOADFONT("ARLRDBD.ttf", 14, "MONOSPACE") 'this is nice!!! low 10 and still legible 12+ excellent(72x50 on 800, 600 screen)CH
= _FONTHEIGHT(FH
): CW
= CH
- 1 'this make printing char by char the same as printing a string for ARLRDBD.ttfMAXCOL
= INT(WW
/ CW
): MAXROW
= INT(WH
/ CH
): CC
= 1: CR
= 1
'test string array, use indexes in lines for alignment to code for function
arr
(i
) = "This is arr item:" + STR$(i
)
cp "*** Mouse and Key Instructions ***"
cp "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
cp "Press spacebar to select a highlighted item or just click it."
cp "Use number(s) + enter to select an array item by it's index number,"
cp "backspace will remove last number pressed, c will clear a number started."
cp "Numbers started are shown in bottom right PgDn bar."
cp "Enter will also select the highlighted item, if no number has been started."
cp "Home starts you at lowest array index, End highlights then highest index."
cp "Use PgUp and PgDn keys or bars to flip through pages of array items."
cp "Escape returns -1719 to allow a Cancel function and signal no slection."
locRow = 20: locCol = (WW / CW - 25) / 2: boxWidth = 25: boxHeight = 17 '< displays 15 lines of array items
'boxHeight is actual screen space in character units, the display uses 2 of the lines for control bars.
'boxWidth will include item numbers displayed to left of array string item
choice = getArrayItemNumber(locRow, locCol, boxWidth, boxHeight, arr())
IF choice
= -1719 THEN cp
"You canceled selection process." ELSE cp
"You chose index (" + LTRIM$(STR$(choice
)) + ") = " + arr
(choice
)
'see this file
lnCnt = fLines("getArrayItem v3.bas", fArr()) '<<<<<<<<<<<<<<<<<<< or whatever name you gave this file AND SAVED!
choice = getArrayItemNumber(5, 2, 90, 27, fArr())
' Future Help Message Box for the function.
' "*** Mouse and Key Instructions ***"
'
' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
' "Press spacebar to select a highlighted item or just click it."
' "Use number(s) + enter to select an array item by it's index number,"
' "backspace will remove last number pressed, c will clear a number started."
' "Numbers started are shown in bottom right PgDn bar."
' "Enter will also select the highlighted item, if no number has been started."
' "Home starts you at lowest array index, End highlights then highest index."
' "Use PgUp and PgDn keys to flip through pages of array items."
'
' "Escape returns -1719 to allow a Cancel function and signal no slection."
FUNCTION getArrayItemNumber&
(locateRow
, locateColumn
, boxWidth
, boxHeight
, arr
() AS STRING) 'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
'boxWidth and boxHeight are in character units, again for locate and print at correct places.
'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
'
maxWidth = boxWidth ' number of characters in box
maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
page = 0
hlite = 0 ' line in display ready for selection by spacebar or if no number is started, enter
clrStr$
= SPACE$(maxWidth
) 'clearing a display line CC = 1: CR = 1
GOSUB update
' show the beginning of the array items for selection
'signal cancel selection process, exit sub with this unlikely index to signal canel
choice = -1719 'primes 7 and 8, not likely to be a select index of an array
DO 'until get a selection or demand exit
'handle the key stuff
IF kh&
= 13 THEN 'enter pressed check if number is being entered? ELSE 'clear b$ to show some response to enter b$
= "":
GOSUB update
'clear the value that doesn't work choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
IF kh&
= 27 THEN EXIT DO 'escape clause offered to Cancel selection process IF kh&
= 32 THEN choice
= hlite
+ page
* maxHeight
+ lba
'best way to choose highlighted selection IF kh&
= 8 THEN 'backspace to edit number SELECT CASE kh&
'choosing sections of array to display and highlighted item IF (page
+ 1) * maxHeight
+ lba
<= uba
THEN page
= page
+ 1:
GOSUB update
IF (page
- 1) * maxHeight
+ lba
>= lba
THEN page
= page
- 1:
GOSUB update
page
= page
- 1: hlite
= maxHeight
- 1:
GOSUB update
hlite
= hlite
- 1:
GOSUB update
IF (hlite
+ 1) + page
* maxHeight
+ lba
<= uba
THEN 'ok to move up IF hlite
+ 1 > maxHeight
- 1 THEN page
= page
+ 1: hlite
= 0:
GOSUB update
hlite
= hlite
+ 1:
GOSUB update
page
= 0: hlite
= 0:
GOSUB update
page
= INT((uba
- lba
) / maxHeight
): hlite
= maxHeight
- 1:
GOSUB update
'handle the mouse stuff
page
= page
- 1: hlite
= maxHeight
- 1:
GOSUB update
hlite
= hlite
- 1:
GOSUB update
IF (hlite
+ 1) + page
* maxHeight
+ lba
<= uba
THEN 'ok to move up IF hlite
+ 1 > maxHeight
- 1 THEN page
= page
+ 1: hlite
= 0:
GOSUB update
hlite
= hlite
+ 1:
GOSUB update
choice = my + page * maxHeight + lba - 1 'select item clicked
IF my
= 0 AND (mx
<= maxWidth
AND mx
>= maxWidth
- 2) THEN 'exit sign EXIT DO 'escape plan for mouse click top right corner of display box IF (page
- 1) * maxHeight
+ lba
>= lba
THEN page
= page
- 1:
GOSUB update
ELSEIF mx
>= 1 AND mx
<= maxWidth
AND my
= maxHeight
+ 1 THEN 'page down bar clicked IF (page
+ 1) * maxHeight
+ lba
<= uba
THEN page
= page
+ 1:
GOSUB update
ELSE ' mouse over highlighting, only if mouse has moved! IF my
- 1 <> hlite
AND (my
- 1 + page
* maxHeight
+ lba
<= uba
) THEN hlite = my - 1
lastmx = mx: lastmy = my
getArrayItemNumber& = choice
'display of array sections and controls on screen
update:
'fix hlite if it has dropped below last array item
WHILE hlite
+ page
* maxHeight
+ lba
> uba
hlite = hlite - 1
'main display of array items at page * maxHeight (lines high)
FOR row
= 0 TO maxHeight
- 1 IF hlite
= row
THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255) fLOCATE locateRow + row, locateColumn: fPRINT clrStr$
index = row + page * maxHeight + lba
fLOCATE locateRow + row, locateColumn
'make page up and down bars to click, print PgUp / PgDn if available
fLOCATE locateRow
- 1, locateColumn: fPRINT
SPACE$(maxWidth
) IF page
<> 0 THEN fLOCATE locateRow
- 1, locateColumn: fPRINT
LEFT$(" Pg Up" + SPACE$(maxWidth
), maxWidth
) fLOCATE locateRow
+ maxHeight
, locateColumn: fPRINT
SPACE$(maxWidth
) fLOCATE locateRow
+ maxHeight
, locateColumn: fPRINT
LEFT$(" Pg Dn" + SPACE$(maxWidth
), maxWidth
) 'make exit sign for mouse click
fLOCATE locateRow - 1, locateColumn + maxWidth - 3
fPRINT " X "
'if a number selection has been started show it's build = b$
fLOCATE locateRow
+ maxHeight
, locateColumn
+ maxWidth
- LEN(b$
) - 1 fPRINT b$ + ";"
'font subs
SUB fLOCATE
(row
, col
) 'locate xColumnCell, yRowCell for printing CC = col: CR = row
SUB fPRINT
(s$
) 'print line (feed) CC = 1
CR = CR + 1
IF CR
> MAXROW
THEN CR
= MAXROW
'yuck!
SUB fLP
(row
, col
, mess$
) 'locate x, y : print mess$ lp = locate and print assume LF 'if locate = x col and y row then and top left corner locates as 1, 1
CC = 1
CR = CR + 1
IF CR
> MAXROW
THEN CR
= MAXROW
'yuck!
SUB fCP
(s$
) 'cp Center Print on line y the cpText$ col
= (MAXCOL
- LEN(s$
)) / 2 fLP CR, col, s$
SUB fINPUT
(prompt$
, var$
) 'input 'save current location
pRow = CR: pCol = CC 'save these for redrawing var
fLOCATE pRow, pCol
fPRINT prompt$ + " {} ;"
OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
OK$
= OK$
+ CHR$(8) + CHR$(27) + CHR$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/" t$ = t$ + k$
fLOCATE pRow, pCol
fPRINT prompt$ + " {" + t$ + "} ;"
k$ = ""
CC = 1: CR = pRow + 1 'update the next print location
var$ = t$ 'return the sub's var$ with desired entered or escape string.
' These are needed only for the demo and testing of the function:
' It should be noted I had trouble using INPUT and INKEY$ after using the function being tested, ie inquiring about another test.
' Something about clearing keypresses (and enter specially).
PRINT: cp
"Go again? press y for yes, any other for no." k$ = ""
IF k$
= "y" THEN goAgain%
= -1
filecount% = 0
'PRINT filecount%, arr(filecount%)
filecount% = filecount% + 1
fLines = filecount% 'this file returns the number of lines loaded, 0 means file did not exist
