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://qb64phoenix.com/forum/showthread...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
So if anyone ever wants to avoid the Windows title bar and create a custom title bar with functions, here's a little demo I whipped up...
It's all SCREEN 0, but you could just as easily make one with a graphics screen.
To drag the window, simply place the mouse pointer on the title bar and hold the left mouse button down, just as you always do for any windows title bar.
The various buttons are clickable. The menu functions are just for show, except for quit.
Code: (Select All)
DIM SHARED WinMse AS POINTAPI
TYPE POINTAPI
X_Pos AS LONG
Y_Pos AS LONG
END TYPE
DECLARE DYNAMIC LIBRARY "User32"
FUNCTION GetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG)
FUNCTION SetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG)
FUNCTION SetWindowPos& (BYVAL hwnd AS LONG, BYVAL hWndInsertAfter AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL wFlags AS LONG)
FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG)
FUNCTION GetAsyncKeyState% (BYVAL vkey AS LONG)
FUNCTION GetCursorPos (lpPoint AS POINTAPI)
FUNCTION SetCursorPos& (BYVAL x AS INTEGER, BYVAL y AS INTEGER)
END DECLARE
DIM AS INTEGER setxy
WIDTH 50, 25
DO: LOOP UNTIL _SCREENEXISTS
GWL_STYLE = -16
ws_border = &H800000
WS_VISIBLE = &H10000000
_TITLE "No Border"
hwnd& = _WINDOWHANDLE
DO
winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)
LOOP UNTIL winstyle&
DO
a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& AND WS_VISIBLE)
LOOP UNTIL a&
REDIM SHARED p1(8), p2(5)
p1(1) = 0 ' Background reg and snooze.
p1(2) = 1 ' Highlight background.
p1(3) = 3 ' Open menu shadow.
p1(4) = 4 ' Show collapsed entries background.
p1(5) = 5 ' Tabs background.
p1(6) = 6 ' Strip between tabs and title bar.
p1(7) = 7 ' Open menu background.
p1(8) = 14 ' Highlight foreground text.
p2(1) = 0 ' Strip between tabs and title bar.
p2(2) = 8 ' Background all pages.
p2(3) = 56 ' Background snooze.
p2(4) = 62 ' Highlight Background.
p2(5) = 63 ' Tabs background.
rt.mrgn = 2: lt.mrgn = 3: tp.mrgn = 4: bt.mrgn = 2
IF lt.mrgn = 0 THEN lt.mrgn = 1 ' Default.
IF tp.mrgn = 0 THEN tp.mrgn = 1 ' Default.
LOCATE 1, 1
PALETTE 5, 63
PALETTE 6, 8
PALETTE 9, 7
PALETTE 7, 7
CALL sam_titlebar
COLOR 15, 6
VIEW PRINT 2 TO _HEIGHT
CLS 2
VIEW PRINT
fw = _FONTWIDTH
fh = _FONTHEIGHT
x = _SCREENX: y = _SCREENY
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
mx = _MOUSEX
my = _MOUSEY
' Check pseudo-title bar.
IF my = 1 THEN
' ID by screen character.
IF mx <> tmp% THEN
SELECT CASE CHR$(SCREEN(my, mx))
CASE "X", "þ", "Ä"
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
tmp$ = SPACE$(3): MID$(tmp$, 2, 1) = CHR$(SCREEN(my, mx))
IF MID$(tmp$, 2, 1) = "X" THEN: COLOR 15, 12 ELSE COLOR 15, 7
tmp% = mx: LOCATE my, mx - 1: PRINT tmp$;
CASE "ð", "M", "e", "n", "u" ' Menu.
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
' Exception.
tmp$ = SPACE$(3): MID$(tmp$, 2, 1) = "ð"
tmp% = 2: COLOR 15, 7: LOCATE my, 1: PRINT tmp$;
CASE ELSE
IF tmp% THEN COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;
tmp% = 0
END SELECT
END IF
ELSE
IF tmp% THEN CALL sam_titlebar: tmp% = 0
END IF
IF GetAsyncKeyState(1) < 0 THEN
IF lb = 0 THEN lb = 1
ELSE
IF lb THEN lb = 0: dragx = 0: dragy = 0
END IF
z& = GetCursorPos(WinMse)
IF lb THEN
IF tmp% THEN
COLOR 8, 5: LOCATE my, tmp% - 1: PRINT tmp$;: tmp% = 0
DO: LOOP UNTIL GetAsyncKeyState(1) = 0: lb = 0
_DELAY .1
SELECT CASE MID$(tmp$, 2, 1)
CASE "X"
SYSTEM
CASE "þ"
IF _FULLSCREEN THEN
_FULLSCREEN OFF
ELSE
_FULLSCREEN
END IF
CASE "Ä"
x& = ShowWindow&(hwnd&, 2)
DO: _LIMIT 1: LOOP UNTIL _SCREENICON = 0
CALL sam_titlebar
CASE "ð"
CALL sam_menu
END SELECT
tmp$ = ""
ELSEIF dragx THEN
IF WinMse.X_Pos <> oldxpos OR WinMse.Y_Pos <> oldypos THEN
j1 = (WinMse.X_Pos - oldxpos)
j2 = (WinMse.Y_Pos - oldypos)
x = x + j1: y = y + j2
_SCREENMOVE x, y
setxy = SetCursorPos(x + dragx, y + dragy)
END IF
z& = GetCursorPos(WinMse)
ELSEIF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + fh THEN
x = _SCREENX: y = _SCREENY
dragx = (WinMse.X_Pos - x)
dragy = fw \ 2 ' Set to middle of the title bar vertical height.
END IF
END IF
IF LEN(INKEY$) THEN SYSTEM
oldypos = WinMse.Y_Pos: oldxpos = WinMse.X_Pos
oldmx = mx: oldmy = my
LOOP
END
SUB sam_menu ' Self-contained subroutine.
y = CSRLIN: x = POS(0)
LOCATE , , 0 ' Hide cursor
clipinsert.var = 0
DIM atmp AS STRING
noi = 6 ' Number of menu items
REDIM menu$(noi)
menu$(1) = "Open"
menu$(2) = "Settings"
menu$(3) = "Recycled"
menu$(4) = "Help"
menu$(5) = "Close"
menu$(6) = "Quit"
h = 5 ' Variable to determine margin spaces from the right of menu.
FOR i = 1 TO noi
j = LEN(menu$(i))
IF j > k THEN k = j
NEXT
mwidth = k + h
mheight = noi * 2 + 1 ' Add one for the separate border element.
MenuT = 1: MenuL = 1: MenuR = MenuL + mwidth: MenuB = MenuT + mheight
DO
_LIMIT 30
z = GetCursorPos(WinMse)
SELECT CASE menu.var
CASE -1
WHILE _MOUSEINPUT: WEND
my = _MOUSEY
mx = _MOUSEX
IF my > MenuT AND my < MenuB AND mx > MenuL AND mx < MenuR THEN
IF my \ 2 = my / 2 AND my AND my <> oldmy THEN
IF MenuHL THEN
atmp = SPACE$(mwidth - 2)
LOCATE MenuHL, MenuL + 2 - 1
COLOR 0, 7
MID$(atmp, 2, LEN(menu$((MenuHL - MenuT) \ 2 + 1))) = menu$((MenuHL - MenuT) \ 2 + 1)
PRINT atmp;
END IF
atmp = SPACE$(mwidth - 2)
LOCATE my, MenuL + 2 - 1
COLOR 7, 0
MID$(atmp, 2, LEN(menu$((my - MenuT) \ 2 + 1))) = menu$((my - MenuT) \ 2 + 1)
PRINT atmp;
COLOR 0, 7
MenuHL = my
END IF
IF _MOUSEBUTTON(1) THEN
menu.var = (my - MenuT) \ 2 + 1
EXIT DO
END IF
ELSE
' Toggle close menu.
IF GetAsyncKeyState(1) < 0 THEN
IF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + 24 AND WinMse.X_Pos >= _SCREENX + 36 AND WinMse.X_Pos <= _SCREENX + 48 THEN
menu.var = 0: EXIT DO ' Close menu.
ELSE
IF WinMse.Y_Pos >= _SCREENY AND WinMse.Y_Pos <= _SCREENY + _FONTHEIGHT * (_HEIGHT + 1) AND WinMse.X_Pos >= _SCREENX AND WinMse.X_Pos <= _SCREENX + _FONTWIDTH * _WIDTH THEN
ELSE ' Outside of app window.
menu.var = 0: EXIT DO ' Close menu.
END IF
END IF
END IF
IF _MOUSEBUTTON(1) THEN ' Outside of menu closes menu.
menu.var = 0 ' Close.
EXIT DO
END IF
END IF
oldmy = my
CASE 0
menu.var = -1 ' Menu open.
PCOPY 0, 1
PALETTE p1(7), p2(5)
PALETTE p1(3), p2(3)
COLOR 0, 7
LOCATE MenuT, MenuL
PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
FOR i = 1 TO mheight - 2
COLOR 0, 7
PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179);
COLOR 7, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1)): COLOR 1, 7
NEXT
COLOR 0, 7
PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217);: COLOR 7, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
LOCATE , MenuL + 2
FOR i = 1 TO mheight
PRINT CHR$(SCREEN(CSRLIN, POS(0)));
NEXT
COLOR 0, 7
LOCATE MenuT + 2, MenuL + 2
FOR i = 0 TO noi - 1
LOCATE MenuT + 1 + i * 2, 3
PRINT menu$(i + 1)
LOCATE , MenuL
IF i + 1 < noi THEN PRINT "Ã" + STRING$(mwidth - 2, CHR$(196)) + "´";
NEXT
DO: _LIMIT 10: LOOP UNTIL GetAsyncKeyState(1) = 0 ' Wait for button release to avoid continuous toggle event.
END SELECT
LOOP
PCOPY 1, 0
LOCATE y, x
_KEYCLEAR
IF menu.var = 6 THEN SYSTEM
DO: _LIMIT 10: LOOP UNTIL GetAsyncKeyState(1) = 0
PALETTE 7, 7
END SUB
![[Image: image.png]](https://i.ibb.co/0ZRfFq2/image.png)
