Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Processing key input on a do loop
#5
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
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 "**"

'+-----------------------+
'| 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'


Attached Files
.zip   GradeBookExample.zip (Size: 683.37 KB / Downloads: 34)
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Reply


Messages In This Thread
Processing key input on a do loop - by NasaCow - 04-20-2023, 11:39 AM
RE: Processing key input on a do loop - by TerryRitchie - 04-21-2023, 02:37 AM



Users browsing this thread: 2 Guest(s)