'Down case
IF KEYDOWN(20480) OR KEYDOWN(13) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y < CurrentPageCount THEN LoopY = LoopY + FONTHEIGHT + 8: Sel.Y = Sel.Y + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Up case
IF KEYDOWN(18432) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y > 1 THEN LoopY = LoopY - FONTHEIGHT - 8: Sel.Y = Sel.Y - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Right case
IF KEYDOWN(19712) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X < GridCount THEN LoopX = LoopX + 50: Sel.X = Sel.X + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Left case
IF KEYDOWN(19200) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X > 1 THEN LoopX = LoopX - 50: Sel.X = Sel.X - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
IF PauseFlag THEN PAUSE TIME: PauseFlag = FALSE
DISPLAY
LOOP UNTIL KEYDOWN(34304)
PAUSE TIME
LOOP UNTIL KEYDOWN(34304) 'F12 key to close the gradebook
You can see I am currently using F12 to exit both loops.
This is what I am trying to do: I want to exit the first loop when any number, period, or any other vaild F## key is pressed. Given an F## key, I can use selectcase to call various subroutines to do the commands, that seems straight forward. The next part I am not sure how to process is if it is a number or a decimal point, I want to capture and print it to screen, similar to an input statement. Any thoughts....
I know the beginning of my first loop will need to be recoded to work properly. I am just realizing as I am chugging along that the input is quickly gonna become a problem I believe.
Quick Edit: What I am trying to avoid is a double enter for input: enter -> input -> enter -> accepted and save. What I am trying to do is vaild input-> enter -> accepted and save.
This program might be confusing but it illustrates what could be done:
Code: (Select All)
dim as integer i, maxi
dim kount as long, breakoff as _byte
dim keystocheck(1 to 20) as long
for i = 1 to 20
read keystocheck(i)
if keystocheck(i) = 34304 then maxi = i: exit for
next
print "Press number keys, or period, or F12. Otherwise you can't quit!"
do
_limit 10
print kount
kount = kount + 1
for i = 1 to maxi
if _keydown(keystocheck(i)) then breakoff = 1 : exit for
next
loop until breakoff
print "OUCH!"
end
WARNING: Don't set the _LIMIT higher than 10 because it might not do any checking of keys! Or that's what it appears. I tested this on EndeavourOS MATE (based on Arch Linux).
Almost forgot to add. If by any chance you want to involve the [SHIFT] key then even more codes will have to be employed such as 34 for dollar sign and 62 for greater-than sign (in an U.S. keyboard). The same with [CTRL], [ALT], the Windows key and any other key that exists that could be used with a different key. Some people might have keyboards which replicates a typewriter in which period always typed period regardless of SHIFT state. That's why I mentioned the > which ASCII code is 62, while that for period/decimal-point is 46.
(04-20-2023, 03:02 PM)mnrvovrfc Wrote: IDK with _KEYDOWN() check also for ASCII codes 48 through 57, and for 46 for decimal point? Will have to test in both loops besides [F12].
This program might be confusing but it illustrates what could be done:
Code: (Select All)
dim as integer i, maxi
dim kount as long, breakoff as _byte
dim keystocheck(1 to 20) as long
for i = 1 to 20
read keystocheck(i)
if keystocheck(i) = 34304 then maxi = i: exit for
next
print "Press number keys, or period, or F12. Otherwise you can't quit!"
do
_limit 10
print kount
kount = kount + 1
for i = 1 to maxi
if _keydown(keystocheck(i)) then breakoff = 1 : exit for
next
loop until breakoff
print "OUCH!"
end
WARNING: Don't set the _LIMIT higher than 10 because it might not do any checking of keys! Or that's what it appears. I tested this on EndeavourOS MATE (based on Arch Linux).
Almost forgot to add. If by any chance you want to involve the [SHIFT] key then even more codes will have to be employed such as 34 for dollar sign and 62 for greater-than sign (in an U.S. keyboard). The same with [CTRL], [ALT], the Windows key and any other key that exists that could be used with a different key. Some people might have keyboards which replicates a typewriter in which period always typed period regardless of SHIFT state. That's why I mentioned the > which ASCII code is 62, while that for period/decimal-point is 46.
I had a similar thought, this happens to be the easier part before processing in the outer loop. I will have to get creative converting a number for keydown as input (and using print to actually show the user with the ability to backspace?) I will have to play with it but so far so good!
04-21-2023, 02:37 AM (This post was last modified: 04-21-2023, 02:38 AM by TerryRitchie.)
Ok, this is really rough but it does work.
Back in 2012 I wrote a Graphics Line Input library and was wondering if I could make it work for your situation, and it does. Please excuse the crudeness of the code but I bit-banged it together over a 4 hour period.
- You can move the cursor around the cells using the arrow keys.
- F12 saves the cells and exits the program
To modify a cell: (This acts very much like an Excel spreadsheet)
- Just start typing numbers (or a period) wherever the cursor is.
- While entering a value the normal modifier keys work as expected (right/left arrow, back space, INSERT, DELETE, etc..)
- When finished entering a value either press ENTER or the UP or DOWN ARROW keys
- To change a value simply move the cursor over a value and start typing
Again, the code is rough and very little error checking is done. I didn't write any UP/DOWN or side scrolling in to the fields. The cursor simply stops when the top/bottom/right/left is reached. Just a quick demo of what's possible.
You are more than welcome to either use the library as is or tear out pieces of the code you want to add to your project. This little demo should help you with some ideas on how to enter data into your cells.
Included in the ZIP file attached is the library files, library documentation, font files I used, some library demo code, and the code shown in the code box below (Gradebook_Example.BAS).
TYPE TYPE_ASSIGNMENT
Aname AS STRING * 9 ' assignment name
Image AS LONG ' rotated header image
END TYPE
TYPE TYPE_CELL
Value AS SINGLE ' numeric value of cell
x AS INTEGER ' x location of cell on screen
y AS INTEGER ' y location of cell on screen
END TYPE
REDIM Student(0) AS STRING * 15
REDIM Assignment(0) AS TYPE_ASSIGNMENT
DIM Cell(23, 20) AS TYPE_CELL
DIM Background AS LONG
DIM DataName AS STRING
DIM Counter AS INTEGER
DIM MonoFont28 AS LONG
DIM TNRFont20 AS LONG
DIM TNRFont26 AS LONG
DIM TempImage AS LONG
DIM x AS INTEGER
DIM y AS INTEGER
DIM Toggle AS INTEGER
DIM EnterCell AS INTEGER
DIM Leave AS INTEGER
DIM DownArrowHeld AS INTEGER
DIM UpArrowHeld AS INTEGER
DIM LeftArrowheld AS INTEGER
DIM rightArrowHeld AS INTEGER
DIM yy AS INTEGER
DIM xx AS INTEGER
DIM i AS INTEGER
DIM CellInput AS INTEGER
'+-----------------------+
'| Read in student names |
'+-----------------------+
DO ' begin name loop
READ DataName ' read a name from data statement
IF DataName <> "**" THEN ' end of names?
REDIM _PRESERVE Student(UBOUND(Student) + 1) AS STRING * 15 ' no, increase array size
Student(UBOUND(Student)) = DataName ' save student name
END IF
LOOP UNTIL DataName = "**" ' leave at end of names
'+--------------------------+
'| Read in assignment names |
'+--------------------------+
DO ' begin assignment loop
READ DataName ' read a name from data statement
IF DataName <> "**" THEN ' end of assignments?
REDIM _PRESERVE Assignment(UBOUND(Assignment) + 1) AS TYPE_ASSIGNMENT ' no, increase array size
Assignment(UBOUND(Assignment)).Aname = DataName ' save assignment name
Assignment(UBOUND(Assignment)).Image = _NEWIMAGE(60, 175, 32) ' create vertical image holder
TempImage = _NEWIMAGE(175, 60, 32) ' create temp image to hold assignment name
_DEST TempImage ' switch to temp image
_FONT MonoFont28, TempImage ' give temp image a font
CLS , GRAY ' clear the temp image in gray
COLOR BLACK, GRAY ' black text on gray background
_PRINTSTRING (10, 18), DataName ' print assignment
_DEST Assignment(UBOUND(Assignment)).Image ' switch to assignment image
_SOURCE TempImage ' get image info from temp image
FOR x = 0 TO 174 ' cycle the width of temp image
FOR y = 0 TO 59 ' cycle the height of temp image
PSET (y, 174 - x), POINT(x, y) ' set pixel on vertical image that matches temp image
NEXT y
NEXT x
_DEST 0 ' back to default destination
_SOURCE 0 ' back to default source
_FREEIMAGE TempImage ' temp image no longer needed
END IF
LOOP UNTIL DataName = "**" ' leave at end of assignments
'+------------------------------------+
'| Create mock-up of background image |
'+------------------------------------+
Background = _NEWIMAGE(1580, 870, 32) ' create background image holder
_DEST Background ' switch to background image
CLS , GRAY ' clear the background imgae in gray
y = 175 ' set y start
Toggle = 1 ' set line color toggle
FOR x = 1 TO 21 ' draw 21 lines
LINE (0, y)-(1579, y), BLACK ' draw line border
IF Toggle = 1 THEN ' draw cyan bar?
LINE (1, y + 1)-(1578, y + 30), CYAN, BF ' yes, create cyan bar
ELSE ' no, blue bar
LINE (1, y + 1)-(1578, y + 30), BLUE, BF ' create blue bar
END IF
Toggle = -Toggle ' toggle bar color
IF x < 21 THEN ' only 20 actual bars wanted
COLOR BLACK, GRAY ' black text on gray background
_FONT TNRFont20 ' set font
_PRINTMODE _KEEPBACKGROUND ' keep background color
_PRINTSTRING (5, y + 5), _TRIM$(Student(x)) ' print student name
END IF
y = y + 31 ' set y to next line
NEXT x
x = 175 ' set x start
FOR y = 1 TO 23 ' draw 23 columns
_PUTIMAGE (x, 0), Assignment(y).Image ' draw assignment image
LINE (x, 0)-(x, 795), BLACK ' draw vertical line border
x = x + 61 ' set x to next column
NEXT y
LINE (0, 0)-(1579, 795), BLACK, B ' border everything
LINE (0, 796)-(1579, 869), DARKBLUE, BF ' create blue help areas
_FONT TNRFont26 ' set font
COLOR YELLOW, GRAY ' yellow text on gray background
_PRINTMODE _KEEPBACKGROUND ' keep background color
_PRINTSTRING (10, 805), "F1 Help F2 Add Assignment F3 Copy Assignment F4 Modify Assignment F5 Copy Grades F6 Clear Grades"
_PRINTSTRING (10, 835), "PgUp/PgDn Quick Student Scroll +/- Quick Assignment Scroll F7 Add Comments F8 Remove Assignment F9 Add/Remove Flags"
COLOR GREEN, GRAY ' green text on gray background
_PRINTSTRING (1465, 805), "F12 Save" '
_PRINTSTRING (1465, 835), "and Close"
_DEST 0 ' back to default destination
FOR y = 1 TO 20
FOR x = 1 TO 23
Cell(x, y).Value = 0
Cell(x, y).x = 176 + (x - 1) * 61 ' x location of cell on screen
Cell(x, y).y = 176 + (y - 1) * 31 ' y location of cell on screen
NEXT x
NEXT y
'+-----------------------+
'| MAIN CODE STARTS HERE | <<<-----------------------
'+-----------------------+
SCREEN _NEWIMAGE(1580, 870, 32) ' main screen
x = _DEVICES ' activate controller commands
x = 1 ' set cell coordinate
y = 1
DO ' begin main loop
EnterCell = FALSE ' reset enter cell flag
Leave = FALSE ' reset leave via F12 flag
DO ' begin cursor movement loop
'+--------------------------------+
'| Move solid cursor block around |
'+--------------------------------+
_LIMIT 30 ' don't hog the CPU
_PUTIMAGE , Background ' refresh mockup image
WHILE _DEVICEINPUT(1): WEND ' get latest keyboard button status
IF _BUTTON(BUTTONDOWN) AND DownArrowHeld = FALSE THEN ' down arrow and not being held?
y = y + 1 ' yes, move cursor down
IF y > 20 THEN y = 20 ' keep cursor at bottom
DownArrowHeld = TRUE ' remember down arrow is pressed
ELSEIF _BUTTON(BUTTONUP) AND UpArrowHeld = FALSE THEN
y = y - 1 ' cursor up
IF y < 1 THEN y = 1
UpArrowHeld = TRUE
ELSEIF _BUTTON(BUTTONLEFT) AND LeftArrowheld = FALSE THEN
x = x - 1 ' cursor left
IF x < 1 THEN x = 1
LeftArrowheld = TRUE
ELSEIF _BUTTON(BUTTONRIGHT) AND rightArrowHeld = FALSE THEN
x = x + 1 ' cursor right
IF x > 23 THEN x = 23
rightArrowHeld = TRUE
END IF
IF NOT _BUTTON(BUTTONDOWN) THEN DownArrowHeld = FALSE ' set release flags when keys released
IF NOT _BUTTON(BUTTONUP) THEN UpArrowHeld = FALSE
IF NOT _BUTTON(BUTTONLEFT) THEN LeftArrowheld = FALSE
IF NOT _BUTTON(BUTTONRIGHT) THEN rightArrowHeld = FALSE
LINE (Cell(x, y).x, Cell(x, y).y)-(Cell(x, y).x + 59, Cell(x, y).y + 29), BROWN, BF ' draw cursor
FOR yy = 1 TO 20 ' display saved values
FOR xx = 1 TO 23
_PRINTMODE _KEEPBACKGROUND
IF Cell(xx, yy).Value <> 0 THEN _PRINTSTRING (Cell(xx, yy).x + 2, Cell(xx, yy).y + 6), _TRIM$(STR$(Cell(xx, yy).Value))
NEXT xx
NEXT yy
'+----------------------------------------+
'| Scan for numeric, period, and F12 keys |
'+----------------------------------------+
FOR i = 3 TO 12 ' key 1 through 0 being pressed?
IF _BUTTON(i) THEN EnterCell = TRUE ' yes, enter cell to modify
NEXT i
IF _BUTTON(53) THEN EnterCell = TRUE ' enter cell if period key being pressed as well
IF _BUTTON(89) THEN Leave = TRUE ' set flag if F12 pressed
_DISPLAY
LOOP UNTIL Leave OR EnterCell ' leave cursor movement if entering cell or exiting program
LINE (Cell(x, y).x, Cell(x, y).y)-(Cell(x, y).x + 59, Cell(x, y).y + 29), BLACK, BF ' change cursor to black
IF EnterCell THEN ' entering cell?
'+-------------------------------+
'| Modifying the value in a cell |
'+-------------------------------+
CellInput = GLIINPUT(Cell(x, y).x + 2, Cell(x, y).y + 6, GLINUMERIC, "", TRUE) ' yes, set up a graphics line input in this cell
DO ' begin cell mod loop
GLICLEAR ' restore background image
WHILE _DEVICEINPUT(1): WEND ' get latest keyboard update
IF _BUTTON(BUTTONDOWN) OR _BUTTON(BUTTONUP) THEN EnterCell = FALSE ' leave cell if UP or DOWN arrow key pressed
GLIUPDATE ' display graphics line input on screen
_DISPLAY ' update screen with changes
LOOP UNTIL GLIENTERED(CellInput) OR (EnterCell = FALSE) ' leave when ENTER, UP ARROW, or DOWN ARROW pressed
Cell(x, y).Value = VAL(GLIOUTPUT$(CellInput)) ' save the value of this cell
GLICLOSE CellInput, TRUE ' close the graphics line input
END IF
LOOP UNTIL Leave ' leave when F12 pressed
CLS ' print a quick chart showing all values were saved
PRINT
PRINT " Values have been saved"
PRINT
FOR yy = 1 TO 20
FOR xx = 1 TO 23
_PRINTMODE _KEEPBACKGROUND
PRINT Cell(xx, yy).Value;
NEXT xx
PRINT
NEXT yy
'+--------------------+
'| Student Names (40) |
'+--------------------+
DATA "Yury Gagarin","Alan Shepard","Gherman Titov","John Glenn","Pavel Popovich","Valentina Tereshkova","Boris Yegorov","Aleksey Leonov"
DATA "Roger Chaffee","Virgil Grisson","Edward White","Vladmir Komarov","William Anders","Frank Borman","James Lovell","Neil Armstrong"
DATA "Edwin Aldrin","Fred Haise","Jack Swigart","Viktor Patsayev","Eugene Cernan","Harrison Schmitt","Vance Brand","Donald Slayton"
DATA "Thomas Stafford","Valery Kubasov","Sigmund Jahn","Jean-Loup Chretien","Sally Ride","Guion Bluford","Ulf Merbold","Rakesh Sharma"
DATA "Marc Garneau","Franklin Chang-Diaz","Christa McAuliffe","Akiyama Tohiro","Helen Sharman","Mae Jemison","Ellen Ochoa","Valery Polyakov"
DATA "**"
(04-21-2023, 02:37 AM)TerryRitchie Wrote: Ok, this is really rough but it does work.
Back in 2012 I wrote a Graphics Line Input library and was wondering if I could make it work for your situation, and it does. Please excuse the crudeness of the code but I bit-banged it together over a 4 hour period.
- You can move the cursor around the cells using the arrow keys.
- F12 saves the cells and exits the program
To modify a cell: (This acts very much like an Excel spreadsheet)
- Just start typing numbers (or a period) wherever the cursor is.
- While entering a value the normal modifier keys work as expected (right/left arrow, back space, INSERT, DELETE, etc..)
- When finished entering a value either press ENTER or the UP or DOWN ARROW keys
- To change a value simply move the cursor over a value and start typing
Again, the code is rough and very little error checking is done. I didn't write any UP/DOWN or side scrolling in to the fields. The cursor simply stops when the top/bottom/right/left is reached. Just a quick demo of what's possible.
You are more than welcome to either use the library as is or tear out pieces of the code you want to add to your project. This little demo should help you with some ideas on how to enter data into your cells.
Included in the ZIP file attached is the library files, library documentation, font files I used, some library demo code, and the code shown in the code box below (Gradebook_Example.BAS).
TYPE TYPE_ASSIGNMENT
Aname AS STRING * 9 ' assignment name
Image AS LONG ' rotated header image
END TYPE
TYPE TYPE_CELL
Value AS SINGLE ' numeric value of cell
x AS INTEGER ' x location of cell on screen
y AS INTEGER ' y location of cell on screen
END TYPE
REDIM Student(0) AS STRING * 15
REDIM Assignment(0) AS TYPE_ASSIGNMENT
DIM Cell(23, 20) AS TYPE_CELL
DIM Background AS LONG
DIM DataName AS STRING
DIM Counter AS INTEGER
DIM MonoFont28 AS LONG
DIM TNRFont20 AS LONG
DIM TNRFont26 AS LONG
DIM TempImage AS LONG
DIM x AS INTEGER
DIM y AS INTEGER
DIM Toggle AS INTEGER
DIM EnterCell AS INTEGER
DIM Leave AS INTEGER
DIM DownArrowHeld AS INTEGER
DIM UpArrowHeld AS INTEGER
DIM LeftArrowheld AS INTEGER
DIM rightArrowHeld AS INTEGER
DIM yy AS INTEGER
DIM xx AS INTEGER
DIM i AS INTEGER
DIM CellInput AS INTEGER
'+-----------------------+
'| Read in student names |
'+-----------------------+
DO ' begin name loop
READ DataName ' read a name from data statement
IF DataName <> "**" THEN ' end of names?
REDIM _PRESERVE Student(UBOUND(Student) + 1) AS STRING * 15 ' no, increase array size
Student(UBOUND(Student)) = DataName ' save student name
END IF
LOOP UNTIL DataName = "**" ' leave at end of names
'+--------------------------+
'| Read in assignment names |
'+--------------------------+
DO ' begin assignment loop
READ DataName ' read a name from data statement
IF DataName <> "**" THEN ' end of assignments?
REDIM _PRESERVE Assignment(UBOUND(Assignment) + 1) AS TYPE_ASSIGNMENT ' no, increase array size
Assignment(UBOUND(Assignment)).Aname = DataName ' save assignment name
Assignment(UBOUND(Assignment)).Image = _NEWIMAGE(60, 175, 32) ' create vertical image holder
TempImage = _NEWIMAGE(175, 60, 32) ' create temp image to hold assignment name
_DEST TempImage ' switch to temp image
_FONT MonoFont28, TempImage ' give temp image a font
CLS , GRAY ' clear the temp image in gray
COLOR BLACK, GRAY ' black text on gray background
_PRINTSTRING (10, 18), DataName ' print assignment
_DEST Assignment(UBOUND(Assignment)).Image ' switch to assignment image
_SOURCE TempImage ' get image info from temp image
FOR x = 0 TO 174 ' cycle the width of temp image
FOR y = 0 TO 59 ' cycle the height of temp image
PSET (y, 174 - x), POINT(x, y) ' set pixel on vertical image that matches temp image
NEXT y
NEXT x
_DEST 0 ' back to default destination
_SOURCE 0 ' back to default source
_FREEIMAGE TempImage ' temp image no longer needed
END IF
LOOP UNTIL DataName = "**" ' leave at end of assignments
'+------------------------------------+
'| Create mock-up of background image |
'+------------------------------------+
Background = _NEWIMAGE(1580, 870, 32) ' create background image holder
_DEST Background ' switch to background image
CLS , GRAY ' clear the background imgae in gray
y = 175 ' set y start
Toggle = 1 ' set line color toggle
FOR x = 1 TO 21 ' draw 21 lines
LINE (0, y)-(1579, y), BLACK ' draw line border
IF Toggle = 1 THEN ' draw cyan bar?
LINE (1, y + 1)-(1578, y + 30), CYAN, BF ' yes, create cyan bar
ELSE ' no, blue bar
LINE (1, y + 1)-(1578, y + 30), BLUE, BF ' create blue bar
END IF
Toggle = -Toggle ' toggle bar color
IF x < 21 THEN ' only 20 actual bars wanted
COLOR BLACK, GRAY ' black text on gray background
_FONT TNRFont20 ' set font
_PRINTMODE _KEEPBACKGROUND ' keep background color
_PRINTSTRING (5, y + 5), _TRIM$(Student(x)) ' print student name
END IF
y = y + 31 ' set y to next line
NEXT x
x = 175 ' set x start
FOR y = 1 TO 23 ' draw 23 columns
_PUTIMAGE (x, 0), Assignment(y).Image ' draw assignment image
LINE (x, 0)-(x, 795), BLACK ' draw vertical line border
x = x + 61 ' set x to next column
NEXT y
LINE (0, 0)-(1579, 795), BLACK, B ' border everything
LINE (0, 796)-(1579, 869), DARKBLUE, BF ' create blue help areas
_FONT TNRFont26 ' set font
COLOR YELLOW, GRAY ' yellow text on gray background
_PRINTMODE _KEEPBACKGROUND ' keep background color
_PRINTSTRING (10, 805), "F1 Help F2 Add Assignment F3 Copy Assignment F4 Modify Assignment F5 Copy Grades F6 Clear Grades"
_PRINTSTRING (10, 835), "PgUp/PgDn Quick Student Scroll +/- Quick Assignment Scroll F7 Add Comments F8 Remove Assignment F9 Add/Remove Flags"
COLOR GREEN, GRAY ' green text on gray background
_PRINTSTRING (1465, 805), "F12 Save" '
_PRINTSTRING (1465, 835), "and Close"
_DEST 0 ' back to default destination
FOR y = 1 TO 20
FOR x = 1 TO 23
Cell(x, y).Value = 0
Cell(x, y).x = 176 + (x - 1) * 61 ' x location of cell on screen
Cell(x, y).y = 176 + (y - 1) * 31 ' y location of cell on screen
NEXT x
NEXT y
'+-----------------------+
'| MAIN CODE STARTS HERE | <<<-----------------------
'+-----------------------+
SCREEN _NEWIMAGE(1580, 870, 32) ' main screen
x = _DEVICES ' activate controller commands
x = 1 ' set cell coordinate
y = 1
DO ' begin main loop
EnterCell = FALSE ' reset enter cell flag
Leave = FALSE ' reset leave via F12 flag
DO ' begin cursor movement loop
'+--------------------------------+
'| Move solid cursor block around |
'+--------------------------------+
_LIMIT 30 ' don't hog the CPU
_PUTIMAGE , Background ' refresh mockup image
WHILE _DEVICEINPUT(1): WEND ' get latest keyboard button status
IF _BUTTON(BUTTONDOWN) AND DownArrowHeld = FALSE THEN ' down arrow and not being held?
y = y + 1 ' yes, move cursor down
IF y > 20 THEN y = 20 ' keep cursor at bottom
DownArrowHeld = TRUE ' remember down arrow is pressed
ELSEIF _BUTTON(BUTTONUP) AND UpArrowHeld = FALSE THEN
y = y - 1 ' cursor up
IF y < 1 THEN y = 1
UpArrowHeld = TRUE
ELSEIF _BUTTON(BUTTONLEFT) AND LeftArrowheld = FALSE THEN
x = x - 1 ' cursor left
IF x < 1 THEN x = 1
LeftArrowheld = TRUE
ELSEIF _BUTTON(BUTTONRIGHT) AND rightArrowHeld = FALSE THEN
x = x + 1 ' cursor right
IF x > 23 THEN x = 23
rightArrowHeld = TRUE
END IF
IF NOT _BUTTON(BUTTONDOWN) THEN DownArrowHeld = FALSE ' set release flags when keys released
IF NOT _BUTTON(BUTTONUP) THEN UpArrowHeld = FALSE
IF NOT _BUTTON(BUTTONLEFT) THEN LeftArrowheld = FALSE
IF NOT _BUTTON(BUTTONRIGHT) THEN rightArrowHeld = FALSE
LINE (Cell(x, y).x, Cell(x, y).y)-(Cell(x, y).x + 59, Cell(x, y).y + 29), BROWN, BF ' draw cursor
FOR yy = 1 TO 20 ' display saved values
FOR xx = 1 TO 23
_PRINTMODE _KEEPBACKGROUND
IF Cell(xx, yy).Value <> 0 THEN _PRINTSTRING (Cell(xx, yy).x + 2, Cell(xx, yy).y + 6), _TRIM$(STR$(Cell(xx, yy).Value))
NEXT xx
NEXT yy
'+----------------------------------------+
'| Scan for numeric, period, and F12 keys |
'+----------------------------------------+
FOR i = 3 TO 12 ' key 1 through 0 being pressed?
IF _BUTTON(i) THEN EnterCell = TRUE ' yes, enter cell to modify
NEXT i
IF _BUTTON(53) THEN EnterCell = TRUE ' enter cell if period key being pressed as well
IF _BUTTON(89) THEN Leave = TRUE ' set flag if F12 pressed
_DISPLAY
LOOP UNTIL Leave OR EnterCell ' leave cursor movement if entering cell or exiting program
LINE (Cell(x, y).x, Cell(x, y).y)-(Cell(x, y).x + 59, Cell(x, y).y + 29), BLACK, BF ' change cursor to black
IF EnterCell THEN ' entering cell?
'+-------------------------------+
'| Modifying the value in a cell |
'+-------------------------------+
CellInput = GLIINPUT(Cell(x, y).x + 2, Cell(x, y).y + 6, GLINUMERIC, "", TRUE) ' yes, set up a graphics line input in this cell
DO ' begin cell mod loop
GLICLEAR ' restore background image
WHILE _DEVICEINPUT(1): WEND ' get latest keyboard update
IF _BUTTON(BUTTONDOWN) OR _BUTTON(BUTTONUP) THEN EnterCell = FALSE ' leave cell if UP or DOWN arrow key pressed
GLIUPDATE ' display graphics line input on screen
_DISPLAY ' update screen with changes
LOOP UNTIL GLIENTERED(CellInput) OR (EnterCell = FALSE) ' leave when ENTER, UP ARROW, or DOWN ARROW pressed
Cell(x, y).Value = VAL(GLIOUTPUT$(CellInput)) ' save the value of this cell
GLICLOSE CellInput, TRUE ' close the graphics line input
END IF
LOOP UNTIL Leave ' leave when F12 pressed
CLS ' print a quick chart showing all values were saved
PRINT
PRINT " Values have been saved"
PRINT
FOR yy = 1 TO 20
FOR xx = 1 TO 23
_PRINTMODE _KEEPBACKGROUND
PRINT Cell(xx, yy).Value;
NEXT xx
PRINT
NEXT yy
'+--------------------+
'| Student Names (40) |
'+--------------------+
DATA "Yury Gagarin","Alan Shepard","Gherman Titov","John Glenn","Pavel Popovich","Valentina Tereshkova","Boris Yegorov","Aleksey Leonov"
DATA "Roger Chaffee","Virgil Grisson","Edward White","Vladmir Komarov","William Anders","Frank Borman","James Lovell","Neil Armstrong"
DATA "Edwin Aldrin","Fred Haise","Jack Swigart","Viktor Patsayev","Eugene Cernan","Harrison Schmitt","Vance Brand","Donald Slayton"
DATA "Thomas Stafford","Valery Kubasov","Sigmund Jahn","Jean-Loup Chretien","Sally Ride","Guion Bluford","Ulf Merbold","Rakesh Sharma"
DATA "Marc Garneau","Franklin Chang-Diaz","Christa McAuliffe","Akiyama Tohiro","Helen Sharman","Mae Jemison","Ellen Ochoa","Valery Polyakov"
DATA "**"
Awesome! I will take a look at this today. I have add mouse capability since I asked. I am assuming that the mouse won't conflict here but I will see. I will take a read through the code and post any questions I may have along the way! This is way more than I expected I will let you know how it goes
The plan is to click and relase for moving the cursor but I want to make sure all my highlights worked before I do that. Here is the current loop as of now.
'Down case
IF KEYDOWN(20480) OR KEYDOWN(13) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y < CurrentPageCount THEN LoopY = LoopY + FONTHEIGHT + 8: Sel.Y = Sel.Y + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Up case
IF KEYDOWN(18432) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.Y > 1 THEN LoopY = LoopY - FONTHEIGHT - 8: Sel.Y = Sel.Y - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Right case
IF KEYDOWN(19712) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X < GridCount THEN LoopX = LoopX + 50: Sel.X = Sel.X + 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Left case
IF KEYDOWN(19200) THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
IF Sel.X > 1 THEN LoopX = LoopX - 50: Sel.X = Sel.X - 1
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
PauseFlag = TRUE
END IF
'Checking for mouse input
MOUSE "Poll"
MOUSE "Release"
IF M.X <> M.OldX AND M.Y <> M.OldY OR MLButAct THEN 'Check if our mouse is moving or a button is being held
FOR CounterX = 1 TO GridCount
FOR CounterY = 1 TO CurrentPageCount
IF M.X > GBMouse(CounterX, CounterY).X1 AND M.X < GBMouse(CounterX, CounterY).X2 AND M.Y > GBMouse(CounterX, CounterY).Y1 AND M.Y < GBMouse(CounterX, CounterY).Y2 THEN
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
Sel.X = CounterX
Sel.Y = CounterY
LoopX = GBMouse(CounterX, CounterY).X1
LoopY = GBMouse(CounterX, CounterY).Y1
This is exactly what I need. I love it! And I always like your documentation files, already printed and sitting next to my machine, studying up on everything. I also updated your file to work with EXPLICIT and NOPREFIX. Not much needed changing but just in case you want to add it to your library....
Thanks again for sharing! I might have to go back through and update some other parts of my code with this awesome library!
This is exactly what I need. I love it! And I always like your documentation files, already printed and sitting next to my machine, studying up on everything. I also updated your file to work with EXPLICIT and NOPREFIX. Not much needed changing but just in case you want to add it to your library....
Thanks again for sharing! I might have to go back through and update some other parts of my code with this awesome library!
You are most welcome. Thank you for sharing the changes you made to the code. I need to revisit it as well since I wrote it so long ago. I've gotten much better at coding with QB64 since then.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
This is exactly what I need. I love it! And I always like your documentation files, already printed and sitting next to my machine, studying up on everything. I also updated your file to work with EXPLICIT and NOPREFIX. Not much needed changing but just in case you want to add it to your library....
Thanks again for sharing! I might have to go back through and update some other parts of my code with this awesome library!
You are most welcome. Thank you for sharing the changes you made to the code. I need to revisit it as well since I wrote it so long ago. I've gotten much better at coding with QB64 since then.
Hi Terry! I have been using your library for a few days and if you do revisit it, I do have a few thoughts. It would be awesome to add some kind of text wrapping to it. That would make it great for larger input, perhaps add an X-Y for the area like a LINE ,,B style (like for a comment box!) Also, it seems to race the CPU. I added three _LIMIT 60 commands, one in each DO LOOP I saw and that seems to really settle it down. Finally, hopefully an easy question, assuming you can remember the good old days when you coded it. How can I customize the allowed input for a flag. I want to make some a little bit more restrictive...
And here is a preview of what I am building right now, the add assignment screen. Hoping to show a working prototype soon.
Here is the code (still working on it, still want to do a lot on this screen alone...) I know it isn't polished yet but I couldn't make it happen without this gem of a library so thanks again! Don't forget the include files in a subdirectory of ./include
Code: (Select All)
$DEBUG
$NOPREFIX
'$DYNAMIC
OPTION EXPLICIT
OPTION BASE 1
'Assignments for all students, populates the top of the gradebook
TYPE MasterAssignmentType
ARName AS STRING * 20 'Assignment report name
ADName AS STRING * 10 'Assignment display name (short name)
AType AS UNSIGNED BYTE 'Assignment Type (Completeion, formative, summative, etc.)
ACat AS STRING * 20 'Assignment Category (subject, unit, etc)
AColor AS UNSIGNED BYTE 'Color coding assignment headers and for grouping for reports
ACode AS UNSIGNED BYTE 'Reserved
APts AS UNSIGNED INTEGER 'Total points allowed
AWght AS UNSIGNED INTEGER 'For weighted assignments/100 = 100%
Month AS UNSIGNED INTEGER
Day AS UNSIGNED INTEGER
Year AS UNSIGNED INTEGER
AID AS INTEGER64 'Unique assignment ID
ADetails AS STRING * 4096 'Space to write instructions for an assignment sheet to print.
END TYPE
'====================Flag codes====================
'1 - Extra credit allowed/Ignore pts allowed |
'2 - Include in final grade |
'4 - Excuse All/Ignore/Shown on reports flagged |
'8 - Hidden/Future dated/Exclude from reports |
'16 - Weighted |
'32 - Reserved |
'64 - Reserved |
'128 - Reserved |
'==================================================
'Sub Start
TYPE InputInfoType
Response AS STRING
Allowed AS INTEGER
Required AS INTEGER
END TYPE
DIM AS STRING Titlee, Qu
DIM AS INTEGER X, Y, Counter, Al
DIM AS LONG GLInput(1 TO 14), AddImage, MainScreen
DIM AS INTEGER Re
REDIM AS InputInfoType InputInfo(0)
'Connect the quads
LINE (58, 34)-(1220, 30), , BF 'Top
LINE (58, 685)-(1220, 689), , BF 'Bottom
LINE (34, 54)-(38, 665), , BF 'Left
LINE (1240, 54)-(1244, 665), , BF 'Right
'-------End Large Title Box------
FONT LOADFONT("arial.ttf", 32)
'Building the text on screen
X = 45: Y = 65
'Box for instructions
LINE (75, 600)-(1000, 684), Black, BF
LINE (45, Y + QFontHeight * 9.75)-(1235, 683), White, B
'Set the flags for the data field
RESTORE AAss
FOR Counter = 1 TO 5
READ Qu, Al, Re
IF Re THEN
COLOR White
ELSE
COLOR RGB32(212, 212, 0)
END IF
GLInput(Counter) = GLIINPUT(X, Y + FONTHEIGHT * 1.2 * Counter, Al, Qu, TRUE)
IF GLInput(Counter) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(Counter)) AS InputInfoType
InputInfo(Counter).Required = Re
InputInfo(Counter).Allowed = Al
InputInfo(Counter).Response = ""
NEXT Counter
'Score type selection
QPrintString X + 220, Y + FONTHEIGHT * 1.2 * (Counter - 2), "Points"
CIRCLES X + 205, Y + FONTHEIGHT * .5 + FONTHEIGHT * 1.2 * (Counter - 2), 10, White, 0, 2 * PI, 1
CIRCLES X + 205, Y + FONTHEIGHT * .5 + FONTHEIGHT * 1.2 * (Counter - 2), 9, White, 0, 2 * PI, 1
'Extra points allowed
READ Qu, Al, Re
COLOR White
GLInput(6) = GLIINPUT(X + 600, Y + FONTHEIGHT * 1.2 * (Counter - 1), Al, Qu, TRUE)
IF GLInput(6) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(6)) AS InputInfoType
InputInfo(6).Required = Re
InputInfo(6).Allowed = Al
InputInfo(6).Response = ""
'Weight
READ Qu, Al, Re
COLOR White
GLInput(7) = GLIINPUT(X, Y + FONTHEIGHT * 1.2 * (Counter), Al, Qu, TRUE)
IF GLInput(7) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(7)) AS InputInfoType
InputInfo(7).Required = Re
InputInfo(7).Allowed = Al
InputInfo(7).Response = ""
'Due date mont
READ Qu, Al, Re
COLOR White
GLInput(8) = GLIINPUT(X, Y + FONTHEIGHT * 1.2 * (Counter + 1), Al, Qu, TRUE)
IF GLInput(8) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(8)) AS InputInfoType
InputInfo(8).Required = Re
InputInfo(8).Allowed = Al
InputInfo(8).Response = ""
'Dayh
READ Qu, Al, Re
COLOR White
GLInput(9) = GLIINPUT(X + 407, Y + FONTHEIGHT * 1.2 * (Counter + 1), Al, Qu, TRUE)
IF GLInput(9) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(9)) AS InputInfoType
InputInfo(9).Required = Re
InputInfo(9).Allowed = Al
InputInfo(9).Response = ""
'Year
READ Qu, Al, Re
COLOR White
GLInput(10) = GLIINPUT(X + 472, Y + FONTHEIGHT * 1.2 * (Counter + 1), Al, Qu, TRUE)
IF GLInput(10) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(10)) AS InputInfoType
InputInfo(10).Required = Re
InputInfo(10).Allowed = Al
InputInfo(10).Response = ""
'Assigned date month
READ Qu, Al, Re
COLOR White
GLInput(11) = GLIINPUT(X + 550, Y + FONTHEIGHT * 1.2 * (Counter + 1), Al, Qu, TRUE)
IF GLInput(11) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(11)) AS InputInfoType
InputInfo(11).Required = Re
InputInfo(11).Allowed = Al
InputInfo(11).Response = ""
'Day
READ Qu, Al, Re
COLOR White
GLInput(12) = GLIINPUT(X + 950, Y + FONTHEIGHT * 1.2 * (Counter + 1), Al, Qu, TRUE)
IF GLInput(12) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(12)) AS InputInfoType
InputInfo(12).Required = Re
InputInfo(12).Allowed = Al
InputInfo(12).Response = ""
'Year
READ Qu, Al, Re
COLOR White
GLInput(13) = GLIINPUT(X + 1015, Y + FONTHEIGHT * 1.2 * (Counter + 1), Al, Qu, TRUE)
IF GLInput(13) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(13)) AS InputInfoType
InputInfo(13).Required = Re
InputInfo(13).Allowed = Al
InputInfo(13).Response = ""
'Comments/Instruction
READ Qu, Al, Re
COLOR RGB32(212, 212, 0)
QPrintString X, Y + FONTHEIGHT * 1.18 * (Counter + 2), "Instruction/Description"
GLInput(14) = GLIINPUT(X, Y + FONTHEIGHT * 1.2 * (Counter + 3), Al, Qu, TRUE)
IF GLInput(14) > UBOUND(InputInfo) THEN REDIM PRESERVE InputInfo(GLInput(14)) AS InputInfoType
InputInfo(14).Required = Re
InputInfo(14).Allowed = Al
InputInfo(14).Response = ""
DO
LIMIT 60
GLICLEAR
PUTIMAGE , AddImage
GLIUPDATE
DISPLAY
LOOP
'-----------End Sub----------------
SLEEP
SYSTEM
AAss:
DATA "Assignment Name: ",31,-1
DATA "Assignmnet Short Name: ",31,-1
DATA "Maximum Points Allowed: ",2,-1
DATA "Score Type",33,-1
DATA "Include in Final Grade",33,-1
DATA "Extra Points Allowed",33,-1
DATA "Weight (100 = 100%): ",2,-1
DATA "Due Date MM/DD/YY: ",2,-1
DATA " / ",2,-1
DATA " / ",2,-1
DATA "Assigned Date MM/DD/YY: ",2,-1
DATA " / ",2,-1
DATA " / ",2,-1
DATA "",29,0
'File holding data lines for embedded pictures.
'$include:'./include/PicData.bas'
'---------------End data entry---------------
SUB CIRCLES (cx%, cy%, r!, c~&, s!, e!, a!)
DIM s%, e%, nx%, ny%, xr!, yr!, st!, en!, asp! ' local variables used
DIM stepp!, C!
st! = s! ' copy start radian to local variable
en! = e! ' copy end radian to local variable
asp! = a! ' copy aspect ratio to local variable
IF asp! <= 0 THEN asp! = 1 ' keep aspect ratio between 0 and 4
IF asp! > 4 THEN asp! = 4
IF asp! < 1 THEN xr! = r! * asp! * 4 ELSE xr! = r! ' calculate x/y radius based on aspect ratio
IF asp! > 1 THEN yr! = r! * asp! ELSE yr! = r!
IF st! < 0 THEN s% = -1: st! = -st! ' remember if line needs drawn from center to start radian
IF en! < 0 THEN e% = -1: en! = -en! ' remember if line needs drawn from center to end radian
IF s% THEN ' draw line from center to start radian?
nx% = cx% + xr! * COS(st!) ' yes, compute starting point on circle's circumference
ny% = cy% + yr! * -SIN(st!)
LINE (cx%, cy%)-(nx%, ny%), c~& ' draw line from center to radian
END IF
IF en! <= st! THEN en! = en! + 6.2831852 ' come back around to proper location (draw counterclockwise)
stepp! = 0.159154945806 / r!
C! = st! ' cycle from start radian to end radian
DO
nx% = cx% + xr! * COS(C!) ' compute next point on circle's circumfrerence
ny% = cy% + yr! * -SIN(C!)
PSET (nx%, ny%), c~& ' draw the point
C! = C! + stepp!
LOOP UNTIL C! >= en!
IF e% THEN LINE -(cx%, cy%), c~& ' draw line from center to end radian if needed
END SUB
Yes, I agree, there are issues in the library that need resolved. I'm just about finished with the project I'm working on now. After that I'll revisit this library and fix it up. Good suggestions too that I'll implement.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
![[Image: image.png]](https://i.ibb.co/J7pW5Dk/image.png)
I will let you know how it goes 
![[Image: ff92f1bfaa8fe09b2e60f2e12a5e634.jpg]](https://i.ibb.co/gPb7q9d/ff92f1bfaa8fe09b2e60f2e12a5e634.jpg)
![[Image: image.png]](https://i.ibb.co/Bw7m0cY/image.png)