04-22-2023, 09:46 AM
(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).
Code: (Select All)'$INCLUDE:'GLINPUTTOP.BI'
CONST FALSE = 0, TRUE = NOT FALSE
CONST BLACK = _RGB32(0, 0, 0)
CONST GRAY = _RGB32(211, 211, 211)
CONST DARKBLUE = _RGB32(0, 0, 139)
CONST YELLOW = _RGB32(255, 255, 0)
CONST GREEN = _RGB32(0, 255, 0)
CONST CYAN = _RGB32(173, 216, 230)
CONST BLUE = _RGB32(0, 0, 255)
CONST BROWN = _RGB32(82, 39, 25)
'CONST UPARROW = 18432
'CONST DOWNARROW = 20480
'CONST LEFTARROW = 19200
'CONST RIGHTARROW = 19712
CONST BUTTONUP = 329
CONST BUTTONLEFT = 332
CONST BUTTONDOWN = 337
CONST BUTTONRIGHT = 334
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
MonoFont28 = _LOADFONT("lucon.ttf", 28, "MONOSPACE")
TNRFont20 = _LOADFONT("times.ttf", 20)
TNRFont26 = _LOADFONT("times.ttf", 26)
'+-----------------------+
'| 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
'+--------------------+
'| Create input cells |
'+--------------------+
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
'+----------------+
'| Display values |
'+----------------+
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 " Values have been saved"
FOR yy = 1 TO 20
FOR xx = 1 TO 23
_PRINTMODE _KEEPBACKGROUND
PRINT Cell(xx, yy).Value;
NEXT xx
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 "**"
'+-----------------------+
'| Assignment Names (32) |
'+-----------------------+
DATA "MATH U310","MATH U320","MATH U330","MATH U340","MATH U350","ENGL A100","ENGL A101","ENGL A102","ENGL A103","ENGL A104","ENGL A105"
DATA "PHYS B220","PHYS B230","PHYS B240","PHYS B250","PHYS B260","BIOL C100","CIOL C101","BIOL C102","BIOL C103","BIOL C104","BIOL C105"
DATA "SCIE D210","SCIE D220","SCIE D230","SCIE D240","SCIE D250","CISS B100","CISS B200","CISS B300","CISS B400","CISS B500","**"
'$INCLUDE:'GLINPUT.BI'
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.
Code: (Select All)
'Main Gradebook loop
PAUSE TIME
DO
'Inital highlight and execute command loop
MOUSE "Inital"
Sel.X = 1: Sel.Y = 1
LoopX = LongName + 11: LoopY = StartY - 4
PauseFlag = FALSE
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
'Selection loop
DO
LIMIT LIMITRATE
'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
'Debugging code
LOCATE 1, 1: PRINT (LoopX - LongName - 11) / 50 + 1, INT((LoopY - StartY + 6) / (FONTHEIGHT + 8)) + 1
LOCATE 2, 1: PRINT LoopX, LoopY
LOCATE 3, 1: PRINT CounterX, CounterY
'End debugging code
GET (LoopX, LoopY)-(LoopX + 48, LoopY + FONTHEIGHT + 7), HL()
PUT (LoopX, LoopY), HL(), PRESET
END IF
NEXT CounterY
NEXT CounterX
'MLButAct = Mouse Left Button Action
IF MLButAct THEN
END IF
END IF
MOUSE "Loop"
IF PauseFlag THEN PAUSE TIME: PauseFlag = FALSE
DISPLAY
LOOP UNTIL KEYDOWN(34304)
PAUSE TIME
LOOP UNTIL KEYDOWN(34304) 'F12 key to close the gradebook