Not sure what I really can do as a report printer to file. Does QB64 have any functions that deal with formatting text to file? I poked around the board and the wiki and haven't really found anything. Any thoughts or leads? Ideally, I would like to center lines on a page (without having to manually space things), maybe some font or styles. Do we have any support for RTF (or PDF, if I may be bold ) in QB64 itself or a library that we can use?
Any help would be appreciative, other than report output. The student database is up and running. It is time to start thinking about the gradebook side as well!
Making my way through this game, thought I'd share what I have done so far.
For those not familiar, it's an old arcade game from 1981. The idea is to fill in 75% of the screen to complete a level. (So far no scores yet, and unlimited lives)
Still some things missing (like those sparks) and there are some bugs to sort out. No sound either - not sure how I'll do that because the original game had bad sound effects.
One thing I'd like to do eventually is learn a flood fill algorithm. I struggled with that and decided to just use paint for now. Flood fill in this case was more complicated than I was expecting it to be. But it'd be nice to do it like the original game does.
Code: (Select All)
'QB64 Qix
'james2464 - November 2022
'controls : arrow keys to move
' : left CTRL for fast draw (blue)
' : left ALT for slow draw (red)
Dim Shared xx, yy, t, olddir, x, y, h, hd, fl, fl2, ct
Dim Shared sdinprocess, fdinprocess As Integer
Dim Shared qpath, flag, n, movepermit, flagrestart As Integer
Dim Shared qixtot, qxv, qyv, f, pmove, pfast, pslow, oldpx, oldpy, ps, drawoldx, drawoldy
Dim Shared j, k, checkx1, checkx2, checky1, checky2, totpct, btot, rtot
Dim Shared bluetot, redtot As _Integer64
'origin
xx = 320: yy = 240
Dim Shared c(50) As Long
c(0) = _RGB(0, 0, 0)
c(1) = _RGB(200, 200, 210) 'outside border
c(2) = _RGB(255, 255, 255) 'cursor white dot
c(3) = _RGB(200, 100, 100)
c(4) = _RGB(50, 120, 150) 'fast zone (fill)
c(5) = _RGB(180, 60, 30) 'slow zone (fill)
c(6) = _RGB(0, 255, 0)
c(7) = _RGB(255, 0, 0) 'cursor red
c(44) = _RGB(50, 120, 155) 'fast zone (drawing lines)
c(45) = _RGB(185, 60, 30) 'slow zone (drawing lines)
Type player
x As Single
y As Single
End Type
Dim Shared pl As player
Type qix
dir As Single
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
xx As Single
yy As Single
len1 As Single
c1 As Integer
c2 As Integer
c3 As Integer
End Type
Dim Shared q(7) As qix
Dim Shared qd(7) As qix
qixtot = 7: qpath = 0: f = 1
ps = 5
Do
'start
pl.x = 320: pl.y = 440
flagrestart = 0
For t = 1 To qixtot
q(t).xx = xx: q(t).yy = yy: q(t).len1 = 40
Next t
'_MouseHide
Cls
'screen setup
Line (120, 40)-(520, 440), c(1), B 'outer border
If pfast + pslow = 0 Then normalmove
If pfast > pslow Then fastdrawmove
If pfast < pslow Then slowdrawmove
'ok so about that qix thing....=======================================================================================
'heading and direction -----------------------------------------------------
If qpath < 1 Then
If qpath = 0 Then
'_Delay 1.
qpath = Int(Rnd * 11) + 1: qxv = Rnd * 30 - 15: qyv = Rnd * 30 - 15
olddir = q(1).dir: q(1).dir = olddir + Rnd * PI - PI / 2
End If
If qpath = -1 Then
'_Delay .5
qpath = (Rnd * 22) + 1: qxv = Rnd * 30 - 15: qyv = Rnd * 30 - 15
olddir = q(1).dir
If olddir > PI Then
q(1).dir = olddir - PI
Else
q(1).dir = olddir + PI
End If
End If
End If
q(1).dir = q(1).dir + Rnd * .9 - .45
q(1).len1 = q(1).len1 + Rnd * 10 - 4.4
If q(1).len1 > 40 Then q(1).len1 = 40
If q(1).len1 < 5 Then q(1).len1 = 5
x = Cos(q(1).dir) * q(1).len1
y = Sin(q(1).dir) * q(1).len1
q(1).x1 = q(1).xx + x: q(1).x2 = q(1).xx - x
q(1).y1 = q(1).yy - y: q(1).y2 = q(1).yy + y
'scan background colour along line
For j = 0 To q(1).len1
x = Cos(q(1).dir) * j: y = Sin(q(1).dir) * j
checkx1 = q(1).xx + x: checkx2 = q(1).xx - x
checky1 = q(1).yy - y: checky2 = q(1).yy + y
c(19) = Point(checkx1, checky1)
c(20) = Point(checkx2, checky2)
If c(19) <> c(0) Then
Select Case c(19)
Case c(1)
flag = 1
Case q(2).c1, q(3).c1, q(4).c1, q(5).c1, q(6).c1, q(7).c1
flag = 1
Case c(44), c(7)
If fdinprocess = 1 Then
flag = 2
End If
Case c(45), c(7)
If sdinprocess = 1 Then
flag = 2
End If
End Select
End If
If c(20) <> c(0) Then
Select Case c(20)
Case c(1)
flag = 1
Case q(2).c1, q(3).c1, q(4).c1, q(5).c1, q(6).c1, q(7).c1
flag = 1
Case c(44), c(7)
If fdinprocess = 1 Then
flag = 2
End If
Case c(45), c(7)
If sdinprocess = 1 Then
flag = 2
End If
End Select
End If
Next j
'check for skipped/crossed line
h = _Hypot(qyv, qxv)
hd = _Atan2(-qxv, -qyv)
For j = 0 To Int(h) Step .5
x = Sin(-hd) * j: y = Cos(hd) * j
checkx2 = q(1).xx - x
checky2 = q(1).yy + y
c(20) = Point(checkx2, checky2)
If c(20) <> c(0) Then
Select Case c(20)
Case c(1)
flag = 1
Case q(2).c1, q(3).c1, q(4).c1, q(5).c1, q(6).c1, q(7).c1
flag = 1
Case c(4), c(7)
If fdinprocess = 1 Then
flag = 2
End If
Case c(5), c(7)
If sdinprocess = 1 Then
flag = 2
End If
End Select
End If
Next j
'changing colour
q(1).c1 = q(1).c1 + Rnd * 60 - 30
If q(1).c1 < 80 Then q(1).c1 = 80
If q(1).c1 > 255 Then q(1).c1 = 255
q(1).c2 = q(1).c2 + Rnd * 60 - 30
If q(1).c2 < 80 Then q(1).c2 = 80
If q(1).c2 > 255 Then q(1).c2 = 255
q(1).c3 = q(1).c3 + Rnd * 60 - 30
If q(1).c3 < 80 Then q(1).c3 = 80
If q(1).c3 > 255 Then q(1).c3 = 255
'if collision detected...
If flag = 1 Then
qpath = -1 'new path needed - reverse direction
q(1).xx = q(3).xx: q(1).yy = q(3).yy
q(1).x1 = q(3).x1: q(1).x2 = q(3).x2
q(1).y1 = q(3).y1: q(1).y2 = q(3).y2
q(1).len1 = q(3).len1 - 3 'shorter line
End If
If flag = 2 Then
youdead
_PutImage (1, 1)-(scx, scy), dbg&, bg&, (1, 1)-(scx, scy)
End If
If sdinprocess < 0 Then
_Delay .8
sdinprocess = 0
End If
If fdinprocess < 0 Then
_Delay .8
fdinprocess = 0
End If
If totpct > 75 Then
endlevel
flagrestart = 1
End If
If _KeyDown(15104) Then
endlevel
flagrestart = 1
End If
Loop Until flagrestart = 1
Loop
Function arrowkey
arrowkey = 0
If _KeyDown(18432) Then ' IF up arrow key was pressed
arrowkey = 1 '
End If
If _KeyDown(20480) Then ' IF down arrow key was pressed
arrowkey = 2 '
End If
If _KeyDown(19200) Then ' IF left arrow key was pressed
arrowkey = 3 '
End If
If _KeyDown(19712) Then ' IF right arrow key was pressed
arrowkey = 4 '
End If
End Function
Function fastdraw
fastdraw = 0
If _KeyDown(100306) Then ' IF L-CTRL key was pressed
fastdraw = 1 '
End If
End Function
Function slowdraw
slowdraw = 0
If _KeyDown(100308) Then ' IF L-ALT key was pressed
slowdraw = 1 '
End If
End Function
movepermit = 0
While movepermit = 0
If c(19) = c(1) And fl2 > 0 Then
movepermit = 1
Else
pl.x = pl.x + 2
c(19) = Point(pl.x, pl.y)
c(20) = Point(pl.x + 1, pl.y)
c(21) = Point(pl.x - 1, pl.y)
c(22) = Point(pl.x, pl.y + 1)
c(23) = Point(pl.x, pl.y - 1)
c(24) = Point(pl.x + 1, pl.y + 1)
c(25) = Point(pl.x - 1, pl.y - 1)
c(26) = Point(pl.x - 1, pl.y + 1)
c(27) = Point(pl.x + 1, pl.y - 1)
fl2 = 0
For fl = 20 To 27 Step 1
If c(fl) = c(0) Then fl2 = 1
Next fl
If c(19) = c(1) And fl2 > 0 Then
movepermit = 1
Else
pl.x = pl.x + 2
movepermit = -1
End If
End If
Wend
Case 4
pl.x = pl.x + 4
c(19) = Point(pl.x, pl.y)
c(20) = Point(pl.x + 1, pl.y)
c(21) = Point(pl.x - 1, pl.y)
c(22) = Point(pl.x, pl.y + 1)
c(23) = Point(pl.x, pl.y - 1)
c(24) = Point(pl.x + 1, pl.y + 1)
c(25) = Point(pl.x - 1, pl.y - 1)
c(26) = Point(pl.x - 1, pl.y + 1)
c(27) = Point(pl.x + 1, pl.y - 1)
fl2 = 0
For fl = 20 To 27 Step 1
If c(fl) = c(0) Then fl2 = 1
Next fl
movepermit = 0
While movepermit = 0
If c(19) = c(1) And fl2 > 0 Then
movepermit = 1
Else
pl.x = pl.x - 2
c(19) = Point(pl.x, pl.y)
c(20) = Point(pl.x + 1, pl.y)
c(21) = Point(pl.x - 1, pl.y)
c(22) = Point(pl.x, pl.y + 1)
c(23) = Point(pl.x, pl.y - 1)
c(24) = Point(pl.x + 1, pl.y + 1)
c(25) = Point(pl.x - 1, pl.y - 1)
c(26) = Point(pl.x - 1, pl.y + 1)
c(27) = Point(pl.x + 1, pl.y - 1)
fl2 = 0
For fl = 20 To 27 Step 1
If c(fl) = c(0) Then fl2 = 1
Next fl
If c(19) = c(1) And fl2 > 0 Then
movepermit = 1
Else
pl.x = pl.x - 2
movepermit = -1
End If
End If
Wend
End Select
End Sub
Sub fastdrawmove
Select Case pmove
Case 1
pl.y = pl.y - 4
If pl.y < 40 Then pl.y = 40
c(19) = Point(pl.x, pl.y)
c(18) = Point(pl.x, pl.y + 2)
movepermit = 0
While movepermit = 0
If c(18) = c(0) Then
movepermit = 1
Else
pl.y = pl.y + 2
If c(18) = c(1) Then
movepermit = 1
Else
pl.y = pl.y + 2
movepermit = -1
End If
End If
Wend
Case 2
pl.y = pl.y + 4
If pl.y > 440 Then pl.y = 440
c(19) = Point(pl.x, pl.y)
c(18) = Point(pl.x, pl.y - 2)
movepermit = 0
While movepermit = 0
If c(18) = c(0) Then
movepermit = 1
Else
pl.y = pl.y - 2
If c(18) = c(1) Then
movepermit = 1
Else
pl.y = pl.y - 2
movepermit = -1
End If
End If
Wend
Case 3
pl.x = pl.x - 4
If pl.x < 120 Then pl.x = 120
c(19) = Point(pl.x, pl.y)
c(18) = Point(pl.x + 2, pl.y)
movepermit = 0
While movepermit = 0
If c(18) = c(0) Then
movepermit = 1
Else
pl.x = pl.x + 2
If c(18) = c(1) Then
movepermit = 1
Else
pl.x = pl.x + 2
movepermit = -1
End If
End If
Wend
Case 4
pl.x = pl.x + 4
If pl.x > 520 Then pl.x = 520
c(19) = Point(pl.x, pl.y)
c(18) = Point(pl.x - 2, pl.y)
movepermit = 0
While movepermit = 0
If c(18) = c(0) Then
movepermit = 1
Else
pl.x = pl.x - 2
If c(18) = c(1) Then
movepermit = 1
Else
pl.x = pl.x - 2
movepermit = -1
End If
End If
Wend
End Select
c(19) = Point(pl.x, pl.y)
If c(19) = c(0) Then
Cls
_PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
If fdinprocess = 0 Then
drawoldx = oldpx: drawoldy = oldpy
_PutImage (1, 1)-(scx - 1, scy - 1), 0, dbg&, (1, 1)-(scx, scy) 'take snapshot of screen - in case of death
End If
Line (oldpx, oldpy)-(pl.x, pl.y), c(44)
If fdinprocess = 0 Then
PSet (oldpx, oldpy), c(1)
End If
fdinprocess = 1
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
End If
If fdinprocess = 1 Then
c(19) = Point(pl.x, pl.y)
If c(19) = c(1) Then 'fast draw completed
Cls
_PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
Line (oldpx, oldpy)-(pl.x, pl.y), c(44)
PSet (pl.x, pl.y), c(1)
fdinprocess = -1
claimlinefast
claimfillfast
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
End If
End If
End Sub
Sub slowdrawmove
Select Case pmove
Case 1
pl.y = pl.y - 2
If pl.y < 40 Then pl.y = 40
c(19) = Point(pl.x, pl.y)
movepermit = 0
While movepermit = 0
If c(19) = c(0) Then
movepermit = 1
Else
If c(19) = c(1) Then
movepermit = 1
Else
pl.y = pl.y + 2
movepermit = -1
End If
End If
Wend
Case 2
pl.y = pl.y + 2
If pl.y > 440 Then pl.y = 440
c(19) = Point(pl.x, pl.y)
movepermit = 0
While movepermit = 0
If c(19) = c(0) Then
movepermit = 1
Else
If c(19) = c(1) Then
movepermit = 1
Else
pl.y = pl.y - 2
movepermit = -1
End If
End If
Wend
Case 3
pl.x = pl.x - 2
If pl.x < 120 Then pl.x = 120
c(19) = Point(pl.x, pl.y)
movepermit = 0
While movepermit = 0
If c(19) = c(0) Then
movepermit = 1
Else
If c(19) = c(1) Then
movepermit = 1
Else
pl.x = pl.x + 2
movepermit = -1
End If
End If
Wend
Case 4
pl.x = pl.x + 2
If pl.x > 520 Then pl.x = 520
c(19) = Point(pl.x, pl.y)
movepermit = 0
While movepermit = 0
If c(19) = c(0) Then
movepermit = 1
Else
If c(19) = c(1) Then
movepermit = 1
Else
pl.x = pl.x - 2
movepermit = -1
End If
End If
Wend
End Select
c(19) = Point(pl.x, pl.y)
If c(19) = c(0) Then
Cls
_PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
If sdinprocess = 0 Then
drawoldx = oldpx: drawoldy = oldpy
_PutImage (1, 1)-(scx - 1, scy - 1), 0, dbg&, (1, 1)-(scx, scy) 'take snapshot of screen - in case of death
End If
Line (oldpx, oldpy)-(pl.x, pl.y), c(45)
If sdinprocess = 0 Then
PSet (oldpx, oldpy), c(1)
End If
sdinprocess = 1
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
End If
If sdinprocess = 1 Then
c(19) = Point(pl.x, pl.y)
If c(19) = c(1) Then 'slow draw completed
Cls
_PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
Line (oldpx, oldpy)-(pl.x, pl.y), c(45)
PSet (pl.x, pl.y), c(1)
sdinprocess = -1
claimlineslow
claimfillslow
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
End If
End If
End Sub
Sub claimlinefast
'scan board for blue line
For j = 41 To 439
For k = 121 To 519
c(19) = Point(k, j)
n = 0
If c(19) = c(44) Then 'blue pixel found
c(20) = Point(k - 1, j)
c(21) = Point(k + 1, j)
c(22) = Point(k, j - 1)
c(23) = Point(k, j + 1)
c(24) = Point(k, j + 2)
c(25) = Point(k, j - 2)
c(26) = Point(k + 2, j)
'horizontal line
If c(22) = c(0) Then 'look above
If c(23) = c(0) Then n = Int(2) 'look below
End If
'upper left corner
If n = 0 Then
'look below 2 pixels
If c(23) = c(44) Then
If c(24) = c(44) Then
If c(20) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'upper right corner
If n = 0 Then
'look below 2 pixels
If c(23) = c(44) Then
If c(24) = c(44) Then
If c(21) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'lower left corner
If n = 0 Then
'look to the right 2 pixels
If c(21) = c(44) Then
If c(26) = c(44) Then
If c(23) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'lower right corner
If n = 0 Then
'look above 2 pixels
If c(22) = c(1) Then
If c(25) = c(1) Then
If c(23) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'if part of vertical line
If c(20) = c(0) Then
If c(21) = c(0) Then n = Int(2)
End If
If n = 2 Then
PSet (k, j), c(1) 'change blue pixel to white
End If
End If
Next k
Next j
End Sub
Sub claimlineslow
'scan board for red line
For j = 41 To 439
For k = 121 To 519
c(19) = Point(k, j)
n = 0
If c(19) = c(45) Then 'red pixel found
c(20) = Point(k - 1, j)
c(21) = Point(k + 1, j)
c(22) = Point(k, j - 1)
c(23) = Point(k, j + 1)
c(24) = Point(k, j + 2)
c(25) = Point(k, j - 2)
c(26) = Point(k + 2, j)
'horizontal line
If c(22) = c(0) Then 'look above
If c(23) = c(0) Then n = Int(2) 'look below
End If
'upper left corner
If n = 0 Then
'look below 2 pixels
If c(23) = c(45) Then
If c(24) = c(45) Then
If c(20) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'upper right corner
If n = 0 Then
'look below 2 pixels
If c(23) = c(45) Then
If c(24) = c(45) Then
If c(21) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'if lower left corner
If n = 0 Then
'look to the right 2 pixels
If c(21) = c(45) Then
If c(26) = c(45) Then
If c(23) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'if lower right corner
If n = 0 Then
'look above 2 pixels
If c(22) = c(1) Then
If c(25) = c(1) Then
If c(23) = c(0) Then
n = Int(2)
End If
End If
End If
End If
'if part of vertical line
If c(20) = c(0) Then
If c(21) = c(0) Then n = Int(2)
End If
If n = 2 Then
PSet (k, j), c(1) 'change red pixel to white
End If
End If
Next k
Next j
End Sub
Sub claimfillfast 'using paint for flood fills
'start at qix
c(14) = _RGB(30, 30, 30)
k = q(1).xx: j = q(1).yy
Paint (k, j), c(14), c(1)
'fill black with blue
For j = 41 To 439
For k = 121 To 519
c(16) = Point(k, j)
If c(16) = c(0) Then
PSet (k, j), c(4)
bluetot = bluetot + 1
End If
Next k
Next j
'fill gray with black
k = q(1).xx: j = q(1).yy
Paint (k, j), c(0), c(1)
End Sub
Sub claimfillslow 'using paint for flood fills
'start at qix
c(14) = _RGB(30, 30, 30)
k = q(1).xx: j = q(1).yy
Paint (k, j), c(14), c(1)
'fill black with red
For j = 41 To 439
For k = 121 To 519
c(16) = Point(k, j)
If c(16) = c(0) Then
PSet (k, j), c(5)
redtot = redtot + 1
End If
Next k
Next j
'fill gray with black
k = q(1).xx: j = q(1).yy
Paint (k, j), c(0), c(1)
End Sub
Sub endlevel
'fill black
For j = 121 To 519
For k = 439 To 41 Step -1
PSet (j, k), c(0)
Next k
_Display
_Delay .005
Next j
End Sub
Sub youdead
Dim ct2, ct3, ct4, basedir, tx, ty, dist, d2, rp
I have a window I need to use WS_THICKBORDER to put just enough border around to make it resizable. The trouble is black windows leave a small black row when you use palette 7, 63: color 0, 7: CLS to white out the window. See a screen capture here: https://staging.qb64phoenix.com/showthre...2#pid10802
So is there something made up to paint a window background with Win32 API and would doing so get rid of that ugly black row near the top?
StepScaleY = DisplayHeight / TotalLines 'How much of the screen we can see at once
Do
Cls , SkyBlue
Color Black, 0
k = _KeyHit
Select Case k
Case 18432: Ypos = Ypos - 1: If Ypos < 0 Then Ypos = 0
Case 20480: Ypos = Ypos + 1: If Ypos > TotalLines - NumOfLines Then Ypos = TotalLines - NumOfLines
Case 1 To 255: _Dest 0: _FreeImage OptionDisplay: Exit Function
End Select
_Dest OptionDisplay 'draw the scrollbar on the visible display for the user
ScrollPositionY = Ypos * StepScaleY
'If ScrollPosition >= ProgramLength Then ScrollPosition = ProgramLength
Line (x1, 0)-(x2, _Height(OptionDisplay)), LightGray, BF
Line (x1, ScrollPositionY)-(x2, ScrollPositionY + NumOfLines * StepScaleY), Red, BF
_Dest OptionScreen
For i = 1 To TotalLines
Locate i, 1: Print i, NumOfLines, TotalLines; StepScaleY;
Next
Locate 1, 1
What we're doing here is making a 600x2000 graphic screen... then we're taking a portion of that screen and scaling it so we can display it as a pop-up centered over 80% of our SCREEN 0 screen.
We have arrow keys! We have scalable sliders!
And... umm.... we resize? umm...
We don't really do anything right now, as this is just a work-in-progress, but what we CAN do now, is draw graphics, text, input boxes, or other things inside that popup box, and have them center and display all nice and pretty on our screen 0 text screen. Just place what you'd like to see on the screen where you currently see the code for:
Code: (Select All)
_Dest OptionScreen
For i = 1 To TotalLines
Locate i, 1: Print i, NumOfLines, TotalLines; StepScaleY;
Next
Locate 1, 1
DIM AS INTEGER i, j
DO
CLS
INPUT "Input any integer: "; i: PRINT
INPUT "Input a modulo as a non-zero integer: "; j
IF j = 0 THEN _CONTINUE
i$ = LTRIM$(STR$(i))
LOCATE 5, 2: PRINT LTRIM$(STR$(i)); " modx"; j; "="; modx(i, j)
SLEEP
IF INKEY$ = CHR$(27) THEN SYSTEM
LOOP
FUNCTION modx (i, j)
modx = (ABS(i) - ABS(j) * (ABS(i \ j) + (1 - SGN(i)) \ 2)) * SGN(i MOD j)
END FUNCTION
So modx is a way we can modify our QB64 MOD operator so we can work with patterns. It conforms with online modulo calculators.
For comparison, see the first result for modx and compare it to the second result of MOD. Note they are the same until the numbers turn negative.
Code: (Select All)
$CONSOLE:ONLY
' Testing modx 5
FOR i = 20 TO -20 STEP -1
i$ = LTRIM$(STR$(i))
LOCATE , 4 - LEN(i$): PRINT LTRIM$(STR$(i));: LOCATE , 5: PRINT "modx j ="; modx(i, 5), "QB64 MOD: "; i MOD 5
NEXT
FUNCTION modx (i, j)
modx = (ABS(i) - ABS(j) * (ABS(i \ j) + (1 - SGN(i)) \ 2)) * SGN(i MOD j)
END FUNCTION
Note that modx also works with negative modulo integers. I'll leave it to the more math proficient if this utility could be extended to floating point operations.
The function can be modified again to change the zero output to the modulo number. See the two modx, modx_p1 and modx_p2 compared below:
Code: (Select All)
' Two pattern formulas with MOD.
$CONSOLE:ONLY
' Testing modx_p1 5
FOR i = 20 TO -20 STEP -1
i$ = LTRIM$(STR$(i))
LOCATE , 4 - LEN(i$): PRINT LTRIM$(STR$(i));: LOCATE , 5: PRINT "modx j ="; modx_p1(i, 5), "QB64 MOD: "; i MOD 5
NEXT
PRINT: PRINT "Press a key for next pattern...": SLEEP
' Testing modx_p2 5
FOR i = 20 TO -20 STEP -1
i$ = LTRIM$(STR$(i))
LOCATE , 4 - LEN(i$): PRINT LTRIM$(STR$(i));: LOCATE , 5: PRINT "modx j ="; modx_p2(i, 5), "QB64 MOD: "; i MOD 5
NEXT
FUNCTION modx_p1 (i, j)
modx_p1 = (ABS(i) - ABS(j) * (ABS(i \ j) + (1 - SGN(i)) \ 2)) * SGN(i MOD j)
END FUNCTION
FUNCTION modx_p2 (i, j)
modx_p2 = (ABS(i) - ABS(j) * (ABS(i \ j) + (1 - SGN(i)) \ 2)) * SGN(i MOD j) + ABS(j) - ABS(j * SGN(i MOD j))
END FUNCTION
So what the second example is useful for is things like file record look up and calendar apps, etc. Here is a quick example of how it could be used for a calendar.
Code: (Select All)
WIDTH 80, 42
_SCREENMOVE 0, 0
FOR i = 1 TO 31
PRINT "Day"; i, modx(i, 7)
NEXT
FUNCTION modx (i, j)
modx = (ABS(i) - ABS(j) * (ABS(i \ j) + (1 - SGN(i)) \ 2)) * SGN(i MOD j) + ABS(j) - ABS(j * SGN(i MOD j))
END FUNCTION
Now I put the second pattern function together after I made the first, which makes me wonder if instead of adding the last part of the equation, if I could optimize it by changing the prior existing equation. I won't be looking into it now, as I got side tracked from another project for this, but optimization changes are always welcomed. Just be sure any changes will work for all possible possible negative and positive number and modulo situations.
Also, if you find any holes in the function, please feel free to post your findings. I'm not certifying this as 100%. Steve and Bplus also have working models posted in another thread. Mine is just a one-liner, which totally suits my personality to a tee... Eeew ya carnsarn idiom!
(As you guys might have noticed, Keyword of the Day has slowed down and hasn't been being updated on a daily basis for the last few days. The reason for this is rather simple -- If you check the QB64-PE repo, you'll see that we've been pushing all sorts of different little batches of work into it -- and if you follow our chat on Discord, you'll see that we BROKE QB64-PE. Matt broke his IDE with some changes... I broke my IDE with some different changes... and sorting out what went wrong where, has been rather <SIGH> to deal with and sort out all the mess. There just hasn't been time to sit down and write up a nice Keyword of the Day article, with all the time and effort spent in undoing the glitches that we oh-so-awesomely did. If anyone else wants to volunteer to do a couple of KotD for us, feel free to speak up and volunteer, and then run with it tomorrow and whenever you get the urge!)
And with that explanation out of the way, let's talk about MOD.
What is it? It's a very common math function that return the remainder from division.
How does one make use of it? It's rather simple to implement, just like addition or multiplication. X = 13 MOD 4..... compare that to.... X = 13 * 4.... Exact same syntax/usage.
Chris, the original poster of the topic link above, insists that MOD is broken and giving the wrong answer.
Quote:There is only one correct result.
Now, one would think when dealing with math, the above assumption has to be correct. There can only be one right answer to any mathematical result! Right?
Then what's the SQR(4)??
QB64 will quickly and happily tell us that the answer is 2! My math teacher would count that answer as being half wrong, as the answer is BOTH +2 and -2. (2 * 2 = 4. -2 * -2 = 4) Both are valid square roots for SQR(4). Unfortunately, QB64 only gives us one answer to this function -- the positive value.
By the same token, MOD is one of those operators which can also return different answers. In fact, various programming languages will each handle the result that it gives you, differently. 13 MOD 4 will *always* be 1, but -7 MOD 5 might be either -2 or 3.
Now, how in the heck does one get those various results??
One language might follow the ruleset (our remainder has to be a value from 0 to our number). For the language with this ruleset for mod, the answer for -7 MOD 5 would *have to be* 3. After all, -2 isn't even in the list of possibilities! It only considers 0 to 4 to be valid remainders for any number divided by 5. Basically the way they work is:
1) Find the largest multiple of your denominator that is less than the base number, subtract it, and use it to get the remainder. For 13 MOD 5, it'd find 10 to be the closest multiple of 5 smaller than 13, and then it'd subtract it. 13 - 10 = 3... 3 is the remainder for 13 MOD 5.
Now, in the case of -7 MOD 5, this type of ruleset would choose -10 as the closest multiple of 5, smaller than our number -7, and then it'd subtract it. -7 - -10 = 3. (negative seven minus negative ten = 3, just in case those signs don't show up readable for anyone.)
That's a perfectly valid interpretation of the answer, and it's not wrong at all. Unfortunately, it's also not how QB64 (or C, which we translate to by the way) deals with the math, so that's all the explaination I'm going to go into for the other result.
2) For QB64 (and for C itself), the rule that is in place for finding the remainder with MOD is basically: Find the closest multiple to your denominator, subtract it, and the result is your remainder.
Now, in the case of 13 MOD 5, the answer is exactly the same. 10 is the closest multiple to 5. 13- 10 = 3. 3 is, of course, the remainder.
But, in the case of -7 MOD 5, we see something different. -5 is the closest multiple to 5. -7 - -5 = -2. -2 is now the answer for us. <-- This is basically how QB64 and C find their answer.
To help you guys visualize this result, and to showcase that it IS, indeed, a valid answer, let me channel my old math teacher's spirit:
"OK, guys, the first thing you need to realize is that there is no such thing as a negative numbers!" (I swear, I remember this lecture almost word for word from him, even though I haven't been in his class for over 30 years now.)
"You guys are all broke. Right?" (And of course, we'd all nod affirmative.) "Then let's say I give you guys all $5 each, and you go out and spend it. How much money do you have after that?" (He'd give us a moment to think about that, and then continue.) "You sure as hell don't have NEGATIVE $5 in your pocket. If you do, pull it out and show it to me! What you do have, however, is now $5 in debt! It's a positive number -- just a positive number in a negative direction!!"
"Draw a line from negative 10 to 10 here on the blackboard."
Code: (Select All)
|.........0.........|
-10 10
"Now, count the dots from 5 to -7. How many of them are there?"
(12, one of us would answer with glee! Finally a math problem we could know the answer to!)
"And if you make a mark on that graph at every 5 points, how many points are left over between the -5 and the -7?"
(Two! Two! Two! Several of us would now shout the answer to his question.)
"But in what direction is that -7, in relation to your minus 5?" He'd really make a point to stress this part...
(It's to the left of it! We'd answer.)
"And left is what, on this line?" He'd ask, once again giving us a moment to soak in his words. "It's negative," he'd answer for us. "That means the answer has to be negative as well -- which makes it negative two. Remember... Negative is just the direction that you're traveling in -- in this case, it's to the left."
-7 MOD 5 = -2.
Which made perfect sense to me, after he explained it in such a simple manner. The distance between -7 and 5 is 12. 12 MOD 5 is 2... But it's going in a negative direction, so the answer has to be -2.
^ And that's basically the logic behind how QB64 and C both come up with their values for MOD.
If one needs positive values as a result from MOD, simply write a small function to get the answer in a format which you can work with:
Code: (Select All)
FUNCTION ModPositive&& (number as _INTEGER64, number2 AS LONG)
temp&& = number MOD number2
IF temp&& < 0 THEN temp&& = temp&& + number
ModPositive = temp&&
END FUNCTION
All credit for this explaination goes out to the spirit of D.J. Keith -- best math teacher ever! Any lack of understanding, or failure to pass across his teachings is completely the fault of Pete. Everyone feel free to blame him.
Hello
How to replace MOD to get correct results.
I have been using the MOD for a long time without problems. The problems started with negative values.
(-1 MOD 5) => (-1)
(-1.4 MOD 5) => (-1)
(1.4 MOD 5) => (1)
(-7. MOD 5) => (-2)
(-7.1 MOD 5) => (-2)
So, deciding to abandon the GUI ideas, I went back to making a different style. Spent the last two days drawing and programming in some of my ideas (and recycling a little of my old code). I hope to finish up the student side before building the gradebook side. Next time, I hope to print the database to .txt files for easing organizing and printing info (pdf would be better but not sure I am ready for that) for those various teacher clipboards. In the end, I hope to print weekly, monthly, and term grade reports by students to make it easier keeping parents informed what homework is missing or completed poorly. A long way to go but it would be nice to share with the community
Enjoy!
I'll post the code here but I do use pictures for the sake of my programming simplicity so feel free to download the attached .zip for the full thing (contents .bas, .ttf. .png files only)
Code: (Select All)
'===========================================
'| Grade Keeper Version 3 Release V:.1 |
'| Updated: November 2022 |
'| Rebuild of V1, code cleanup |
'| Contact: NasaCow @ |
'===========================================
'$DEBUG
'$DYNAMIC
$NOPREFIX
OPTION EXPLICIT
OPTION BASE 1
CONST FALSE = 0, TRUE = NOT FALSE
TYPE NameListType
PinYinName AS STRING * 20
FirstName AS STRING * 20
MiddleName AS STRING * 20
LastName AS STRING * 20
Year AS INTEGER
Month AS INTEGER
Day AS INTEGER
HouseColor AS STRING * 10
MomName AS STRING * 40
MomPhone AS STRING * 20 'Saved as string to support symbols and international prefixes
MomEmail AS STRING * 80
DadName AS STRING * 40
DadPhone AS STRING * 20
DadEmail AS STRING * 80
END TYPE
DIM SHARED AS NameListType NameList(10) 'Student list
DIM SHARED AS LONG ScreenPointer(5), Arial8, Arial12, Arial16 'Screen & font handles
DIM SHARED AS LONG Arial24, Arial32, Arial48, Arial60 'Font handles
DIM SHARED AS LONG Intro, AboutPic, Current, CheckSelect, Report 'Picture handles
DIM SHARED AS LONG NewNameEntry, DisplayData, CurrentLayout, Generic 'Picture handles
DIM SHARED AS INTEGER Counter 'Throw-away counter
DIM SHARED AS INTEGER NumberOfStudents
DIM SHARED AS INTEGER Pointer 'Used for menu selections
DIM SHARED AS BIT SelectFlag 'Used to prevent graphic glitches and/or escape loops
'Loading needed screen space
TITLE "Grade Keeper Alpha Version 0.1"
DISPLAY 'Turn off Auto Display
SCREEN NEWIMAGE(1280, 720, 32)
SCREENMOVE 0, 0
ScreenPointer(1) = DEST 'Main screen
FOR Counter = 2 TO 5 'Screen 5 is exclusive use of CENTERNEWSCREEN text printing
ScreenPointer(Counter) = NEWIMAGE(1280, 720, 32)
NEXT Counter
'Font sizes
Arial8 = LOADFONT("data/assets/arial.ttf", 8) 'For grades and later use
Arial12 = LOADFONT("data/assets/arial.ttf", 12) 'For grades and later use
Arial16 = LOADFONT("data/assets/arial.ttf", 16) 'For grades and later use
Arial24 = LOADFONT("data/assets/arial.ttf", 24)
Arial32 = LOADFONT("data/assets/arial.ttf", 32)
Arial48 = LOADFONT("data/assets/arial.ttf", 48)
Arial60 = LOADFONT("data/assets/arial.ttf", 60)
DO: MAINMENU: LOOP 'Main program loop
SYSTEM
errorhandle: 'Error handling
DIM AS STRING ErrorCode
ErrorCode = "Error" + STR$(ERR) + " on program file line" + STR$(ERRORLINE) + ". Program will end."
PRINTCENTERNEWSCREEN ErrorCode, 48, 1
SYSTEM
SUB MAINMENU
Pointer = 0: SelectFlag = FALSE
PAUSE (.15)
SCREEN ScreenPointer(1)
DO
CLS
PUTIMAGE (0, 0), Intro
SELECT CASE Pointer
CASE 0: PUTIMAGE (375, 221), CheckSelect
CASE 1: PUTIMAGE (375, 292), CheckSelect
CASE 2: PUTIMAGE (375, 365), CheckSelect
CASE 3: PUTIMAGE (375, 437), CheckSelect
CASE 4: PUTIMAGE (375, 510), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.15) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 4 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 4 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return/Spacebar to select
SELECT CASE Pointer
CASE 0: CURRENTCLASS
CASE 1: 'ARCHIVEDCLASS
CASE 2: 'OPTIONS
CASE 3: ABOUT
CASE 4: SYSTEM
END SELECT
END SUB
SUB CURRENTCLASS
PAUSE (.15)
Pointer = 0
DO
DO
CLS 'Prepare and draw the menu
PUTIMAGE (0, 0), Current
SELECT CASE Pointer
CASE 0: PUTIMAGE (260, 190), CheckSelect
CASE 1: PUTIMAGE (260, 280), CheckSelect
CASE 2: PUTIMAGE (260, 380), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.125) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 2 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 2 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return or Space bar to select
'Execute choice
SELECT CASE Pointer
CASE 0: 'LOADGRADES
CASE 1: LOADNAMES
END SELECT
LOOP UNTIL Pointer = 2
END SUB
SUB LOADGRADES 'Future release
END SUB
SUB LOADNAMES
DIM AS INTEGER Rows, Columns, RowStep, ColumnStep, StartX, StartY
DIM AS STRING FirstName, LastName
DIM AS INTEGER Highlight(500000)
DIM AS BIT Selected, Back
IF FILEEXISTS("data/current/namelist.gkn") THEN 'Display current list if it exists
LOADSTUDENTDATA
FONT Arial32
Counter = 1: Rows = 3: Columns = 15: RowStep = FONTHEIGHT(Arial32): ColumnStep = 615
Back = FALSE
CLS
PUTIMAGE (0, 0), CurrentLayout 'Simple box layout
WHILE Counter <= NumberOfStudents 'Prints student names to screen
FirstName = TRIM$(NameList(Counter).FirstName)
LastName = TRIM$(NameList(Counter).LastName)
LOCATE Rows, Columns: PRINT FirstName + " " + LastName
Counter = Counter + 1
Rows = Rows + 1
WEND
LOCATE Rows, Columns: PRINT "Add student to class"
LOCATE Rows + 1, Columns: PRINT "Whole class data reports"
LOCATE Rows + 2, Columns: PRINT "Go back to the prior screen"
DO 'Keep looping until explicitly told to return to prior menu
Rows = 3: StartX = 4: StartY = (Rows - 1) * FONTHEIGHT(Arial32)
Counter = 1: Selected = FALSE
PAUSE (.15)
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
DO 'GUI student interface selection
DISPLAY
IF KEYDOWN(18432) THEN 'up case
IF Counter = 1 THEN 'Top of table check
'Do nothing, ignore key press
ELSE 'Process the change
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
StartY = StartY - RowStep
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter - 1
PAUSE (.15)
END IF
END IF
IF KEYDOWN(20480) THEN 'down case
IF NumberOfStudents + 3 = Counter THEN 'Bottom of table check
'Do nothing, ignore key press
ELSE 'Process the change
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
StartY = StartY + RowStep
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter + 1
PAUSE (.15)
END IF
END IF
IF KEYDOWN(13) OR KEYDOWN(32) THEN 'Select a choice and exit the loop
Selected = TRUE
PAUSE (.15)
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
END IF
LOOP WHILE NOT Selected
SELECT CASE Counter 'Process selected choice
CASE 1 TO NumberOfStudents:
CASE NumberOfStudents + 1:
CASE NumberOfStudents + 2: STUDENTREPORTS
CASE NumberOfStudents + 3: Back = TRUE 'Return to prior meny
END SELECT
LOOP UNTIL Back
PAUSE (.15)
ELSE
CREATESTUDENTLIST
END IF
END SUB
SUB STUDENTREPORTS
DIM Back AS BIT
SCREEN ScreenPointer(2)
Counter = 0
SelectFlag = FALSE: Back = FALSE
PAUSE (.15)
DO
DO
CLS
PUTIMAGE (0, 0), Report
SELECT CASE Counter
CASE 0: PUTIMAGE (285, 170), CheckSelect
CASE 1: PUTIMAGE (285, 240), CheckSelect
CASE 2: PUTIMAGE (285, 310), CheckSelect
CASE 3: PUTIMAGE (285, 380), CheckSelect
CASE 4: PUTIMAGE (285, 455), CheckSelect
CASE 5: PUTIMAGE (285, 525), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.15) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(18432) THEN ' up case
IF Counter = 0 THEN Counter = 5 ELSE Counter = Counter - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(20480) THEN 'down case
IF Counter = 5 THEN Counter = 0 ELSE Counter = Counter + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return of Spacebar to select
SELECT CASE Counter
CASE 0:
CASE 1:
CASE 2:
CASE 3:
CASE 4:
CASE 5: Back = TRUE
END SELECT
PAUSE (.15)
LOOP UNTIL Back
SCREEN ScreenPointer(1)
END SUB
SUB ARCHIVEDCLASS 'Prior year record keeping - Future release
SUB ABOUT
CLS
PUTIMAGE (0, 0), Generic
FONT Arial60: LOCATE 2, 1280 / 2 - PRINTWIDTH("Grade Keeper") / 2: PRINT "Grade Keeper"
FONT Arial32: LOCATE 5, 1280 / 2 - PRINTWIDTH("Alpha Version 0.1") / 2: PRINT "Alpha Version 0.1"
FONT Arial24: LOCATE 15, 50: PRINT "Public alpha release #1. Built November 27th, 2022. Released as non-commercial and share alike as defined"
LOCATE 16, 50: PRINT "by the creative commons 4.0. May not apply any additional legal terms nor technological measures that"
LOCATE 17, 50: PRINT "legally restrict others from doing anything that the license permits. Please contact NasaCow at"
LOCATE 18, 50: PRINT "NasaCowPro@gmail.com with any questions or feedback. No warranty or guarantee explicitly or implicitly"
LOCATE 19, 50: PRINT "made with the use of this software."
LOCATE 28, 50: PRINT "Press any key to go back..."
DISPLAY
SLEEP
END SUB
'===========Support Subs/Functions===========
'Used for initial database building of student data
SUB CREATESTUDENTLIST
DIM AS STRING * 1 AddAnother, Correct
DIM AS NameListType NewData
PAUSE (.15)
FONT Arial24
OPEN "data/current/namelist.gkn" FOR OUTPUT AS #1 'For writing the master name list data
Counter = 1
AUTODISPLAY
DO 'Gathering data about students
CLS
PUTIMAGE (0, 0), NewNameEntry
LOCATE 7, 140: PRINT Counter 'Built with Arial24
LOCATE 7, 280: INPUT "", NewData.PinYinName
DO
LOCATE 7, 710: PRINT " "
LOCATE 7, 710: INPUT "", NewData.Month
LOOP UNTIL NewData.Month > 0 AND NewData.Month < 13
DO
LOCATE 7, 780: PRINT " "
LOCATE 7, 780: INPUT "", NewData.Day
LOOP UNTIL NewData.Day > 0 AND NewData.Day < 32
DO
LOCATE 7, 840: PRINT " "
LOCATE 7, 840: INPUT "", NewData.Year
LOOP UNTIL NewData.Year > 1990 AND NewData.Year < 2100
LOCATE 7, 970: INPUT "", NewData.HouseColor
LOCATE 12, 55: INPUT "", NewData.FirstName
LOCATE 12, 400: INPUT "", NewData.MiddleName
LOCATE 12, 780: INPUT "", NewData.LastName
LOCATE 17, 55: INPUT "", NewData.MomName
LOCATE 17, 400: INPUT "", NewData.MomPhone
LOCATE 17, 780: INPUT "", NewData.MomEmail
LOCATE 22, 55: INPUT "", NewData.DadName
LOCATE 22, 400: INPUT "", NewData.DadPhone
LOCATE 22, 780: INPUT "", NewData.DadEmail
DO
LOCATE 27, 430: PRINT " "
LOCATE 27, 430: INPUT "", Correct
Correct = UCASE$(Correct)
LOOP UNTIL Correct = "Y" OR Correct = "N"
DO
LOCATE 27, 690: PRINT " "
LOCATE 27, 690: INPUT "", AddAnother
AddAnother = UCASE$(AddAnother)
LOOP UNTIL AddAnother = "Y" OR AddAnother = "N"
IF Correct = "Y" THEN
WRITE #1, NewData.PinYinName
WRITE #1, NewData.Month
WRITE #1, NewData.Day
WRITE #1, NewData.Year
WRITE #1, NewData.HouseColor
WRITE #1, NewData.FirstName
WRITE #1, NewData.MiddleName
WRITE #1, NewData.LastName
WRITE #1, NewData.MomName
WRITE #1, NewData.MomPhone
WRITE #1, NewData.MomEmail
WRITE #1, NewData.DadName
WRITE #1, NewData.DadPhone
WRITE #1, NewData.DadEmail
Counter = Counter + 1
ELSE
PRINTCENTERNEWSCREEN "Data not written. Please re-enter data.", 32, 1
AUTODISPLAY
FONT Arial24
AddAnother = "Y"
END IF
LOOP UNTIL AddAnother = "N"
DISPLAY
CLOSE #1
PRINTCENTERNEWSCREEN "Data written successfully!", 32, 1
END SUB
'Loads the student data into memory. Ensure file exists before calling
SUB LOADSTUDENTDATA
NumberOfStudents = 0
OPEN "data/current/namelist.gkn" FOR INPUT AS #1
WHILE NOT EOF(1)
NumberOfStudents = NumberOfStudents + 1
IF UBOUND(namelist) = NumberOfStudents THEN REDIM PRESERVE NameList(NumberOfStudents + 1) AS NameListType
INPUT #1, NameList(NumberOfStudents).PinYinName
INPUT #1, NameList(NumberOfStudents).Month
INPUT #1, NameList(NumberOfStudents).Day
INPUT #1, NameList(NumberOfStudents).Year
INPUT #1, NameList(NumberOfStudents).HouseColor
INPUT #1, NameList(NumberOfStudents).FirstName
INPUT #1, NameList(NumberOfStudents).MiddleName
INPUT #1, NameList(NumberOfStudents).LastName
INPUT #1, NameList(NumberOfStudents).MomName
INPUT #1, NameList(NumberOfStudents).MomPhone
INPUT #1, NameList(NumberOfStudents).MomEmail
INPUT #1, NameList(NumberOfStudents).DadName
INPUT #1, NameList(NumberOfStudents).DadPhone
INPUT #1, NameList(NumberOfStudents).DadEmail
WEND
CLOSE #1
END SUB
'Prints a short pop-up message to the user
SUB PRINTCENTERNEWSCREEN (ToPrint AS STRING, FontHandle AS INTEGER, CurrentScreen AS INTEGER)
DIM AS INTEGER Rows, Columns
SCREEN ScreenPointer(5) 'Save prior screen
SELECT CASE FontHandle
CASE 8: FONT Arial8
CASE 12: FONT Arial12
CASE 16: FONT Arial16
CASE 24: FONT Arial24
CASE 32: FONT Arial32
CASE 48: FONT Arial48
CASE 60: FONT Arial60
CASE ELSE: BEEP
EXIT SUB
END SELECT
CLS
PUTIMAGE (0, 0), Generic
Rows = (HEIGHT / FONTHEIGHT) / 2
Columns = 1280 / 2 - PRINTWIDTH(ToPrint) / 2
LOCATE Rows, Columns: PRINT ToPrint
Columns = 1280 / 2 - PRINTWIDTH("Press any key.") / 2
LOCATE Rows + 2, Columns: PRINT "Press any key."
BEEP
DISPLAY
SLEEP
PAUSE .15
SCREEN ScreenPointer(CurrentScreen) 'Restore prior screen before call
END SUB
'Simple timer delay with keyboard flush - Used to avoid double key presses
SUB PAUSE (Dlay)
DIM Start AS DOUBLE
Start = TIMER
IF Start > TIMER THEN Start = Start - 86400 'Midnight issue
DO WHILE Start + Dlay >= TIMER: LOOP
KEYCLEAR 'Clear any key press
END SUB
) in QB64 itself or a library that we can use?
![[Image: image.png]](https://i.ibb.co/0ZRfFq2/image.png)
