Not sure where a good place to suggest ideas for improving QB64's IDE so I am dropping it here. I'd be happy to do it right next time, if this isn't, if someone kindly points me to the right place.
Anyways, my idea is having a way to mark functions and subs in the SUBs menu (you know the one you get with F2). Be useful to mark complete, in-progress, or place holder and sort by such a flag. Just my two cents.
Is it possible to get private GDI device context in QB64?
When working with OpenGL I need to use
HDC hDC = NULL - due to the subsequent call to the C BuildFont command (it is available in gdi32.dll, I have it declared, it works, and then I need to convert its output using the C SelectObject function to the Windows wglUseFontBitmaps function.
Analogously, it goes like this:
after all #include C calls:
HDC hDC = NULL;
.
.
.
CreateFont (-24, 0, 0, 0, FW_BOLD, FALSE, FALSE, FALSE, ANSI_CHARSET, OUT_IT_PRECIS, CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY, FF_DONTCARE And DEFAULT_PITCH, "Courier New")
I found all the definitions, constants for all three C functions, but i must stop work, because i am not sure - i dont know how get hDC device content. Is it possible under H file, or with next libraries, or this is not possible in QB64?
in another thread a member of our community has the idea to develop (reinventing the wheel) a database program for Gradebook for teacher user.
in this thread,that is readable following this link Gradebook for teacher, you can find the original declaration of UDTs used in this demonstration.
While at #24 post there are some my observations and modifications to original UDT to get one database file with all informations ordered and stored.
Quote:I have loosen the structure of data that you have planned.... I see a StudentType, a MasterAssignment and a SlaveAssignment.
In the first and in the last structure you use an ID to identify and correlate the data. In MasterAssignment there is no ID.
You like to have all the data into one file.
I think that to keep in one file all the data you need to use an ID also for the third structure of data.
In this manner you can access to the searched data using the ID as index:
here an example
this is the file
________________________________________________________________________________________________
|long digit| records of StudentType|long digit|records of MasterAssignment|long digit|records of SlaveAssignment|CRC|
|_______ |___________________|_______ |_______________________ |_______|_______________________|___ |
^ ^ ^ ^ ^ ^ ^
| | | | | | |
number of |_________DATA number of |_________DATA number of |_________DATA |__Security data
Student records Master Assignment Slave Assignment
records records
while in RAM you load the data into 3 array with which you can work.
the final result of these first steps is to get three different array of data to link for getting informations about of students in a class, Assignments done in that class and results of assignment for each student that has done that assignment.
From these basic data we can get other school results' data like Average Grade , Final Grade, Dropped students, Added students
-------------------------------------------------------------------------------------------------------------------------------------------------------------------------
the final goal of NasaCow is this Gradebook showed at these links Gradebook for teacher, Gradebook for teacher: assignment, Gradebook for teacher: student view
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------
So let's to start :
step1 it creates UDTs, it populates the array of the 3 UDTs and it shows in output the data stored. It create one file for storing the data following the above scheme of data storing.
Here the code for step1
Code: (Select All)
_Title "Gradebook step 1"
$NoPrefix
Option Explicit
Option ExplicitArray
'-------------------------------------------------------
Type NameListType 'Used for the student name database
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 * 8
MomName As String * 30
MomPhone As String * 20 'Saved as string to support symbols and international prefixes
MomEmail As String * 38
DadName As String * 30
DadPhone As String * 20
DadEmail As String * 38
UID As Integer
End Type
Type MasterAssignmentType 'Each entry needs to be defined before use with slave
UID As Integer ' UID for distinguish among different assignments made in the same date and class or set of students
ARName As String * 20 'Assignment report name
ADName As String * 10 'Assignment display name (short name)
AType As Unsigned Byte 'Assignment Type (Completeion, formative, summative, etc.)
ACat As String * 20 'Assignment Category (subject, unit, etc)
AColor As Unsigned Byte 'Color coding assignment headers and for grouping for reports
ACode As Unsigned Byte 'Reserved
APts As Unsigned Integer 'Total points allowed
End Type
Type SlaveAssignmentType 'Each student would require one with use with master
UIDm As Integer 'UID shows which MasterAssignment has been used
UIDs As Integer 'UID will match the student name list to match results, negative UID means deleted and we will ignore it on display and reports
MPts As Unsigned Integer 'Points earned for each particular students
Flags As Unsigned Byte 'See below for codes
Flags2 As Unsigned Byte ' Reserved
Notes As String * 512 'Comments for a student's work
End Type
'====================Flag codes====================
'1 - Late (Turned in late) |
'2 - Absent on due date (ignore due date) |
'4 - Incomplete (turned in but not done) |
'8 - Missing (Not turned in) |
'16 - Excused/Exempt |
'32 - Ignore score internally for avg, etc. |
'64 - Remove from reports (ignore externally) |
'128 - Reserved |
'==================================================
Dim Max As Integer, HowMuch As Long, How As Integer
Max = 1
HowMuch = 0
Dim Students(1 To Max) As NameListType, Assignments(1 To Max) As MasterAssignmentType, Results(1 To Max) As SlaveAssignmentType
GoSub initFilerecords
Open "DatabaseDemo.txt" For Binary As #1
Cls , 14
Print "Now reading Students..."
GoSub ReadStudents
Print " press a key to continue..."
Sleep
Cls , 13
Print "Now reading Assignments..."
GoSub ReadAssignment
Print " press a key to continue..."
Sleep
Cls , 12
Print "Now reading Results..."
GoSub ReadResults
Print " press a key to continue..."
Sleep
Print "Quitting"
Close #1
End '<-------- end of program
' Initialization GOSUB creates file of database reading internal data
initFilerecords:
Open "DatabaseDemo.txt" For Binary As #1 ' here database file has been created
' writing Students in the file
HowMuch = 10
Put #1, , HowMuch
Restore StudentsData
Locate 24, 1: Print " Filling file"
For How = 1 To HowMuch Step 1
Read Students(1).PinYinName, Students(1).FirstName, Students(1).MiddleName, Students(1).LastName, Students(1).Year, Students(1).Month, Students(1).Day, Students(1).HouseColor, Students(1).MomName, Students(1).MomPhone, Students(1).MomEmail, Students(1).DadName, Students(1).DadPhone, Students(1).DadEmail, Students(1).UID
GoSub ShowStudentRecord
_Delay 1
Put #1, , Students()
Next How
'write assignments in the file
Cls , 5
HowMuch = 4
Restore AssignmentData
Put #1, , HowMuch
For How = 1 To HowMuch Step 1
Read Assignments(1).UID, Assignments(1).ARName, Assignments(1).ADName, Assignments(1).AType, Assignments(1).ACat, Assignments(1).AColor, Assignments(1).ACode, Assignments(1).APts
GoSub ShowAssignmentsRecord
_Delay 1
Put #1, , Assignments()
Next How
'write results in the file
Cls , 4
HowMuch = 35
Restore ResultsData
Put #1, , HowMuch
For How = 1 To HowMuch Step 1
Read Results(1).UIDm, Results(1).UIDs, Results(1).MPts, Results(1).Flags, Results(1).Flags2, Results(1).Notes
GoSub ShowResultsRecord
_Delay 1
Put #1, , Results()
Next How
Close #1
Cls , 12
Print "File of database done! Ready to start demo."
Print "Please press a key to start..."
Sleep
Return
' END of initialization GOSUB----------------------------------
'----------Loading data from file of database into RAM-------------
ReadStudents:
'reading students from the file
Cls , 3
Print " Reading file for Students"
Get #1, , HowMuch
For How = 1 To HowMuch Step 1
Get #1, , Students()
GoSub ShowStudentRecord
_Delay 1
Next How
Return
ReadAssignment:
' reading assignments from the file
Cls , 1
Print " Reading file for Assignments"
Get #1, , HowMuch
For How = 1 To HowMuch Step 1
Get #1, , Assignments()
GoSub ShowAssignmentsRecord
_Delay 1
Next How
ReadResults:
' reading results from the file
Cls , 2
Print " Reading file for Results"
Get #1, , HowMuch
For How = 1 To HowMuch Step 1
Get #1, , Results()
GoSub ShowResultsRecord
_Delay 1
Next How
Return
'--------------------DATA set for database file-----------------
StudentsData:
Data RDJ,Robert,Downing,Junior,2000,2,22,12345600,Julia Concepts,333222111,JConcepts@Yahoo.com,Peter Downing,111222333,PeterD@aol.com,1
Data PJM,Paulus,June,Marcus,1999,3,23,89765909,Maria Capello,444111222,MariaCapello@microsoft.com,Mickie Costello,333222333,Mi_Costello@amazon.com,2
Data TMA,Terrie,Mike,Anderson,2001,12,25,45398758,Stephany Johnson,888999777,StepJo@BBC.com,Frank Boulevard,888777666,FrankBoulevard@microsoft.com,3
Data AJW,Amy,Johnson,Watson,2000,01,04,87543324,Donna Walker,666555333,DonWalk@cisco.com,Walter Bros Julian,888222111,WaltBro@amazon.com,4
Data ERT,Emily,Rose,Tinder,2003,4,15,19045689,Angie Longman,333000999,AngieL@tabloid.com,Donald Foster,444888999,DonaldFoster@cisco.com,5
Data UAB,Ully,Aktick,Brandson,2002,06,09,65498732,Jane Murdock,444555666,JMurdock23@aol.com,Ted Wineger,333444555,TedWineger@cisco.com,6
Data WAS,Wendy,Allison,Singer,2004,6,12,78488922,Melissa Naom,999333999,MeliNaom@yahoo.it,Albert Stone,444000999,ASt456@microsoft.com,7
Data MCS,Molly,Connor,Smith,2001,7,5,54365476,Emily Sandman,099900111,EmilyS@aol.com,Bob Miller,555222111,BMiller567@microsoft.com,8
Data RDJ,Ronny,Dudson,jansenn,2003,8,15,81264554,Jenny Portman,123123123,Jportman@BBC.com,Al Fisherman,678678678,AlFisherman@aol.com,9
Data NK,Nina,Killer,,2000,6,12,65439876,Pauline Arson,567567567,PArson@life.com,Andy Wiley,890890890,Andywiley@micro.com,10
Data "END"
AssignmentData:
Data 1,Mathematical,Math,2,Subject,16,0,20
Data 2,Scientific test,Science,8,Unit,1,0,20
Data 3,English language,English,4,Unit,2,0,20
Data 4,Psycologist test,Psycotest,16,Subject,32,0,20
Data "END"
ResultsData:
Data 1,4,15,0,0,Good Job
Data 1,10,10,0,0,Medium Job
Data 1,2,1,0,0,the worst Job
Data 1,3,5,0,0,Bad Job
Data 1,8,11,0,0,Good Job
Data 1,6,20,0,0,Excellent Job
Data 2,4,15,0,0,Good Job
Data 2,10,8,0,0,Medium Job
Data 2,2,4,0,0,Bad Job
Data 2,3,5,0,0,Bad Job
Data 2,8,11,0,0,Good Job
Data 2,6,20,0,0,Excellent Job
Data 2,9,15,0,0,Good Job
Data 2,1,10,0,0,Medium Job
Data 2,5,1,0,0,the worst Job
Data 2,7,5,0,0,Bad Job
Data 3,8,11,0,0,Good Job
Data 3,6,20,0,0,Excellent Job
Data 3,4,15,0,0,Good Job
Data 3,10,10,0,0,Medium Job
Data 3,2,1,0,0,the worst Job
Data 3,3,5,0,0,Bad Job
Data 3,7,11,0,0,Good Job
Data 3,5,20,0,0,Excellent Job
Data 3,9,15,0,0,Good Job
Data 3,1,10,0,0,Medium Job
Data 4,2,1,0,0,the worst Job
Data 4,3,5,0,0,Bad Job
Data 4,8,11,0,0,Good Job
Data 4,6,20,0,0,Excellent Job
Data 4,4,15,0,0,Good Job
Data 4,10,10,0,0,Medium Job
Data 4,5,1,0,0,the worst Job
Data 4,7,5,0,0,Bad Job
Data 4,9,11,0,0,Good Job
Data "END"
I've completely re-made my Recall game, and added several new functions. These include: three different sets of tiles (animals, letters and shapes), four levels of difficulty, and saved best-scores for individual games.
Code: (Select All)
' np is number of players, size is selected grid-size (1 to 4)
' numtiles is number of tiles to use (12, 20, 30, 42) for selected size
' numcols is number of columns of tiles, set according to chosen numtiles (3, 5, 5, or 7), numrows is number of rows of tiles (numtiles/numcols)
' face is the pic attached to the tile. Is 50px wide and deep, with 4px clearance on all sides. picnum is the number of the face for tilenum (1 to numtiles/2)
' fleft and ftop are positions for grid frame (ftop is always 75)
' gleft and gright are horiz grid cell limits set by numcols (gleft is centre, minus half of numcols: 1200/2 - (int(numcols+1)/2*56)
' tiles() is array of shuffled numbers of the pic on each tile, tilenum is number of the tile being addressed
' tleft is position derived from gleft for each tile. gtop and gbottom are pixel position limits for grid. top is top of each tile, derived from gtop
SCREEN _NEWIMAGE(1200, 640, 32)
RANDOMIZE TIMER
COMMON SHARED k, face, start, numtries, size, end$, bestscore(), bestname$(), nm$, name$(), score(), np, plr, match, setnum
DIM bestscore(4), bestname$(4), name$(4), score(4)
ok$ = "o3l32ce": bad$ = "o2l32ec": end$ = "o3l32cego4c"
numpics = 21: midpix = 600: ftop = 75: gtop = ftop + 2
setnum = 49
PLAY ok$
Instructions
ReadIt:
setnum = _KEYHIT
_LIMIT 30
IF setnum < 1 THEN GOTO ReadIt
CLS
_KEYCLEAR
GetASet:
PLAY ok$
LOCATE 18, 42: PRINT "Which Image-Set would you like, from 1 to 3 (Animals, Letters or Shapes)?"
GetSetNumber:
setnum = _KEYHIT
_LIMIT 30
IF setnum < 1 THEN GOTO GetSetNumber
IF setnum < 49 OR setnum > 51 THEN setnum = 49
PLAY ok$
CLS
LOCATE 18, 60: PRINT "Tile set number"; setnum - 48; "will be used": _DELAY 1: CLS ' setnum is 48 more than actual set-number"
GetPlayerNames:
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
GetAName:
PLAY ok$
np = np + 1
IF np > 4 THEN np = 4: GOTO lastplr
TryAgain:
_KEYCLEAR
WIPE "18"
LOCATE 18, 56
PRINT "Name of Player"; np; "(or <Enter> for no more)";: INPUT nm$ ' nm$ is name for player 1, np is 1"
IF nm$ = "" THEN np = np - 1: GOTO lastplr ' if no name given (finished), jump to lastplayer line
IF nm$ < "A" THEN WIPE "18": GOTO TryAgain ' if illegal name, leave np as 1 and try again
name$(np) = UCASE$(nm$)
GOTO GetAName ' but if a good name, keep it as name$(1) and go back to GetAName
lastplr:
IF np = 0 THEN np = 1
PLAY ok$
IF np = 1 AND name$(1) = "" THEN name$(1) = "SOLO" ' if only one player, call it solo
WIPE "18"
LOCATE 18, 62
PRINT "Number of players is"; np: _DELAY 1: WIPE "18"
plr = 1
GetGridSize:
_KEYCLEAR
LOCATE 18, 52: PRINT "Choose a grid size, 1 to 4 (4 is the largest)"
Sizes:
k = _KEYHIT
_LIMIT 30
IF k < 1 THEN GOTO Sizes
IF k < 49 OR k > 52 THEN k = 49
PLAY ok$
size = k - 48
SELECT CASE k
CASE IS = 49
numtiles = 12
numcols = 3
CASE IS = 50
numtiles = 20
numcols = 5
CASE IS = 51
numtiles = 30
numcols = 5
CASE IS = 52
numtiles = 42
numcols = 7
END SELECT
CLS
numrows = numtiles / numcols: fleft = midpix + 2 - numcols * 27: fwidth = numcols * 54 + 4: fheight = numrows * 54 + 4
gleft = fleft + 2: gright = gleft + numcols * 54 + 2: gbottom = gtop + numrows * 54 + 2: numfound = 0
DIM tiles(numtiles), found(numtiles) ' found() can have one of three values: 0 (normal), 1 (tile is picked), or 2 (tile has been found)
frame$ = "r" + LTRIM$(STR$(fwidth)) + "d" + LTRIM$(STR$(fheight)) + "l" + LTRIM$(STR$(fwidth)) + "u" + LTRIM$(STR$(fheight))
PSET (fleft, ftop): DRAW frame$
PLAY ok$
LOCATE 31, 66: PRINT "Number of tiles is"; numtiles: _DELAY 1: WIPE "31"
PrepTiles:
b = 1
FOR a = 1 TO numtiles - 1 STEP 2
tiles(a) = b: tiles(a + 1) = b
b = b + 1
NEXT
Shuffle:
LOCATE 31, 68: PRINT "Shuffling tiles..."
FOR a = 1 TO 30
PLAY "o1l64msa"
NEXT
_DELAY 1
WIPE "31"
FOR a = 1 TO numtiles
swop = INT(RND * numtiles) + 1
SWAP tiles(a), tiles(swop)
NEXT
DrawGrid:
top = gtop + 1: tleft = gleft + 2: row = numrows + 1 ' first tile is in 2 pixels, down 2 pixels from edge of grid
FOR a = 0 TO numrows - 1
FOR b = 1 TO numcols
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
tleft = tleft + 54
NEXT
tleft = gleft + 2
top = top + 54
NEXT
top = top + 6
GetAction:
column = INT(numcols + 1) / 2
selectionnumber = 2 ' set selection number as 2, will toggle before each selection is made
LINE (580, top)-(629, top + 49), _RGB32(250, 80, 80), BF
' before first NextMove, top is 60px below top of bottom tile (which is 346)"
NextMove:
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
LOCATE 1, 2: PRINT "Score:"; score(plr); TAB(70); name$(plr); " playing"; TAB(125); "Best for this size:"; bestscore(size)
LOCATE 33, 37: PRINT "Use the four cursor-keys to move to a tile to select and press <Enter> to select it"
LOCATE 31, 72: PRINT "Tries:"; numtries
GetAKey ' tile to be moved to can have Found status 0 (unused), 1 (currently selected) or 2 (already found and removed)
IF k < 1 THEN GOTO NextMove
IF row > numrows THEN
LINE (580, top)-(629, top + 49), _RGB32(0, 0, 0), BF
top = gtop + (numrows - 1) * 54 + 1: tleft = 579
row = numrows
tilenum = numtiles - INT(numcols + 1) / 2 + 1
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF
GOTO NextMove
END IF
SELECT CASE k
CASE IS = 18432 'up
IF row = 1 THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
top = top - 54: row = row - 1
tilenum = tilenum - numcols: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 20480 'down
IF row = numrows THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
top = top + 54: row = row + 1
tilenum = tilenum + numcols: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 19200 'left
IF column = 1 THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
column = column - 1: tleft = tleft - 54
tilenum = tilenum - 1: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 19712 'right
IF column = numcols THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
column = column + 1: tleft = tleft + 54
tilenum = tilenum + 1: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 32
' <Space> selects a tile. It may have Found status 0, 1 or 2; picnum is image number on the tile; selects is first or second select
' tleft and top are locations of the tile; tilenum is number of the tile to be selected
IF found(tilenum) = 1 THEN
COLOR _RGB32(255, 0, 0), _RGB32(0, 0, 0): PLAY bad$
WIPE "34": LOCATE 34, 61: PRINT "You already selected this tile": _DELAY .5: WIPE "34"
COLOR _RGB32(255, 200, 200), _RGB32(0, 0, 0)
GOTO NextMove
END IF
IF found(tilenum) = 2 THEN
COLOR _RGB32(255, 0, 0), _RGB32(0, 0, 0): PLAY bad$
WIPE "34": LOCATE 34, 59: PRINT "This tile has already been paired": _DELAY .5: WIPE "34"
COLOR _RGB32(255, 200, 200), _RGB32(0, 0, 0)
GOTO NextMove
END IF
PLAY ok$
IF selectionnumber = 1 THEN ' continue if this tile has not been selected or found yet
seltile1 = tilenum: seltile1h = tleft: seltile1v = top ' preserve selection 1 details
selectionnumber = 2
ELSE
seltile2 = tilenum: seltile2h = tleft: seltile2v = top ' preserve selection 2 details
selectionnumber = 1
END IF
found(tilenum) = 1
face = _LOADIMAGE("recpics" + LTRIM$(CHR$(setnum)) + "/" + CHR$(64 + tiles(tilenum)) + ".jpg")
_PUTIMAGE (tleft, top), face ' show pic on tile
IF selectionnumber = 1 THEN
_PUTIMAGE (520, 22), face ' show first pic above grid at 520 horiz
ELSE
_PUTIMAGE (631, 22), face ' show second pic above grid at 631 horiz
END IF
_FREEIMAGE face
IF selectionnumber = 2 THEN ' compare pictures
IF tiles(seltile1) = tiles(seltile2) THEN ' if they match,
PLAY ok$: PLAY ok$
COLOR _RGB32(100, 255, 255)
LOCATE 34, 71: PRINT "A match!": _DELAY .5: WIPE "34" ' advise Match,
found(seltile1) = 2: found(seltile2) = 2 ' flag both as Found,
numfound = numfound + 2 ' and inc number of found tiles
score(plr) = score(plr) + 2
IF numfound = numtiles THEN Done: SYSTEM
ELSE ' but if they don't match,
COLOR _RGB32(255, 100, 100)
PLAY bad$: PLAY bad$
LOCATE 34, 70: PRINT "No match!": _DELAY .5: WIPE "34" ' advise No match
found(seltile1) = 0: found(seltile2) = 0 ' set flags of both tiles to not picked and not found
plr = plr + 1
IF plr > np THEN plr = 1
END IF
numtries = numtries + 1 '
LINE (seltile1h, seltile1v)-(seltile1h + 49, seltile1v + 49), _RGB32(250, 80, 80), BF
IF found(seltile1) = 2 THEN
LINE (seltile2h, seltile2v)-(seltile2h + 49, seltile2v + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (seltile2h, seltile2v)-(seltile2h + 49, seltile2v + 49), _RGB32(100, 100, 100), BF
END IF
LINE (520, 22)-(569, 71), _RGB32(0, 0, 0), BF: LINE (631, 22)-(680, 71), _RGB32(0, 0, 0), BF ' erase pics above grid
END IF
LOCATE 35, 64: PRINT "Found:"; numfound, ; "Tries:"; numtries
GOTO NextMove ' go back for next round
CASE IS = 27 ' esc - quit
LOCATE 34, 63: PRINT "Quitting": PLAY end$: _DELAY .5
SYSTEM
CASE ELSE
GOTO NextMove
END SELECT
GOTO NextMove
SUB WIPE (ln$) ' call with string of 2-digit line numbers only eg "0122" for lines 1 and 22
FOR a = 1 TO LEN(ln$) - 1 STEP 2
LOCATE VAL(MID$(ln$, a, 2)): PRINT SPACE$(149);
NEXT
END SUB
SUB GetAKey
k = 0: _KEYCLEAR
WHILE k < 1
_LIMIT 30
k = _KEYHIT
WEND
END SUB
SUB Done
CLS
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PLAY end$
numtries = numtries + 1
'If single player, check against Best for the level and update if necessary, and leave
' if multi player, just list each player's name and score, and leave
IF NOT _FILEEXISTS("recallbest") THEN
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if none found
FOR a = 1 TO 4: WRITE #1, a * 20, "Default": NEXT
CLOSE #1
END IF
IF np = 1 THEN
LOCATE 18, 50: PRINT "Would you like to reset all previous Best scores?"
ResetBest:
y = _KEYHIT
_LIMIT 30
IF y < 1 THEN GOTO ResetBest
IF y <> 89 AND y <> 121 THEN GOTO GoOn
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if requested
FOR a = 1 TO 4: WRITE #1, a * 20, "Default": NEXT
CLOSE #1
GoOn:
CLS
LOCATE 18, 1
OPEN "recallbest" FOR INPUT AS #1
PRINT TAB(68); "Previous Best Scores"
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO 4
INPUT #1, bestscore(a), bestname$(a)
PRINT TAB(65); a, bestscore(a), bestname$(a)
NEXT
CLOSE #1
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT: PRINT TAB(48); "You finished in"; numtries; "tries. The previous best for this level was "; bestscore(size)
IF numtries < bestscore(size) THEN
bestscore(size) = numtries: bestname$(size) = name$(plr)
PRINT: PRINT TAB(71); "New Best Scores"
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if previous best beaten
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO 4: WRITE #1, bestscore(a), bestname$(a)
PRINT TAB(65); a, bestscore(a), bestname$(a)
NEXT
CLOSE #1
END IF
ELSE
CLS
LOCATE 18, 74
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT "Scores"
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO np
PRINT TAB(70); name$(a), score(a)
NEXT
END IF
SLEEP
END SUB
SUB Instructions
start = -34
FOR a = 0 TO 20
face = _LOADIMAGE("recpics" + LTRIM$(CHR$(setnum)) + "/" + CHR$(65 + a) + ".jpg") ' find the picture
_PUTIMAGE (start + 56, 10), face ' show pic on tile
_PUTIMAGE (start + 56, 64), face
start = start + 55
_FREEIMAGE face
NEXT
LOCATE 10, 72
COLOR _RGB32(100, 250, 200): PRINT "Recall"; TAB(40); "A Game by Phil Taylor to test and improve your memory and recall skills"
COLOR _RGB32(255, 255, 255): PRINT
PRINT TAB(10); "A rectangular grid of tiles is displayed, each holding a hidden picture or symbol. There are two of each picture, as shown above."
PRINT
PRINT TAB(10); "Before the game starts, the player/s choose a grid-size from 1 to 4, which will present 18, 20, 30 or 42 tiles respectively, so"
PRINT
PRINT TAB(10); "some of the tiles may not be used, depending on the grid size selected."
PRINT
PRINT TAB(10); "They may also enter the names they wish to play under, and the type of images they prefer, from animals, letters or shapes."
PRINT
PRINT TAB(10); "Players take turns to move within this grid with the four cursor keys and select two tiles with the <SPACE> key for each turn."
PRINT
PRINT TAB(10); "As each tile is selected it is revealed, and when the second one is selected, the two are compared by the computer."
PRINT
PRINT TAB(10); "If they match they are removed, and the player scores two points and plays again. When all tiles have been found, the game ends."
PRINT
PRINT TAB(10); "A Best Score is kept for each grid-size for single players, or all player scores are shown for multiple players."
PRINT
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT TAB(65); "Press a key to start"
END SUB
It makes use of several QB64 functions that I, for one, was not that familiar with, and Remarks are added for other "L-Platers", to try to explain how these have been used.
There are four attached files, three of which contain the sets of images, and the fourth the best-scores records.
I'm hoping this will be useful, and interesting, to other members
' np is number of players, size is selected grid-size (1 to 4)
' numtiles is number of tiles to use (12, 20, 30, 42) for selected size
' numcols is number of columns of tiles, set according to chosen numtiles (3, 5, 5, or 7), numrows is number of rows of tiles (numtiles/numcols)
' face is the pic attached to the tile. Is 50px wide and deep, with 4px clearance on all sides. picnum is the number of the face for tilenum (1 to numtiles/2)
' fleft and ftop are positions for grid frame (ftop is always 75)
' gleft and gright are horiz grid cell limits set by numcols (gleft is centre, minus half of numcols: 1200/2 - (int(numcols+1)/2*56)
' tiles() is array of shuffled numbers of the pic on each tile, tilenum is number of the tile being addressed
' tleft is position derived from gleft for each tile. gtop and gbottom are pixel position limits for grid. top is top of each tile, derived from gtop
SCREEN _NEWIMAGE(1200, 640, 32)
RANDOMIZE TIMER
COMMON SHARED k, face, start, numtries, size, end$, bestscore(), bestname$(), nm$, name$(), score(), np, plr, match, setnum
DIM bestscore(4), bestname$(4), name$(4), score(4)
ok$ = "o3l32ce": bad$ = "o2l32ec": end$ = "o3l32cego4c"
numpics = 21: midpix = 600: ftop = 75: gtop = ftop + 2
setnum = 49
PLAY ok$
Instructions
ReadIt:
setnum = _KEYHIT
_LIMIT 30
IF setnum < 1 THEN GOTO ReadIt
CLS
_KEYCLEAR
GetASet:
PLAY ok$
LOCATE 18, 42: PRINT "Which Image-Set would you like, from 1 to 3 (Animals, Letters or Shapes)?"
GetSetNumber:
setnum = _KEYHIT
_LIMIT 30
IF setnum < 1 THEN GOTO GetSetNumber
IF setnum < 49 OR setnum > 51 THEN setnum = 49
PLAY ok$
CLS
LOCATE 18, 60: PRINT "Tile set number"; setnum - 48; "will be used": _DELAY 1: CLS ' setnum is 48 more than actual set-number"
GetPlayerNames:
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
GetAName:
PLAY ok$
np = np + 1
IF np > 4 THEN np = 4: GOTO lastplr
TryAgain:
_KEYCLEAR
WIPE "18"
LOCATE 18, 56
PRINT "Name of Player"; np; "(or <Enter> for no more)";: INPUT nm$ ' nm$ is name for player 1, np is 1"
IF nm$ = "" THEN np = np - 1: GOTO lastplr ' if no name given (finished), jump to lastplayer line
IF nm$ < "A" THEN WIPE "18": GOTO TryAgain ' if illegal name, leave np as 1 and try again
name$(np) = UCASE$(nm$)
GOTO GetAName ' but if a good name, keep it as name$(1) and go back to GetAName
lastplr:
IF np = 0 THEN np = 1
PLAY ok$
IF np = 1 AND name$(1) = "" THEN name$(1) = "SOLO" ' if only one player, call it solo
WIPE "18"
LOCATE 18, 62
PRINT "Number of players is"; np: _DELAY 1: WIPE "18"
plr = 1
GetGridSize:
_KEYCLEAR
LOCATE 18, 52: PRINT "Choose a grid size, 1 to 4 (4 is the largest)"
Sizes:
k = _KEYHIT
_LIMIT 30
IF k < 1 THEN GOTO Sizes
IF k < 49 OR k > 52 THEN k = 49
PLAY ok$
size = k - 48
SELECT CASE k
CASE IS = 49
numtiles = 12
numcols = 3
CASE IS = 50
numtiles = 20
numcols = 5
CASE IS = 51
numtiles = 30
numcols = 5
CASE IS = 52
numtiles = 42
numcols = 7
END SELECT
CLS
numrows = numtiles / numcols: fleft = midpix + 2 - numcols * 27: fwidth = numcols * 54 + 4: fheight = numrows * 54 + 4
gleft = fleft + 2: gright = gleft + numcols * 54 + 2: gbottom = gtop + numrows * 54 + 2: numfound = 0
DIM tiles(numtiles), found(numtiles) ' found() can have one of three values: 0 (normal), 1 (tile is picked), or 2 (tile has been found)
frame$ = "r" + LTRIM$(STR$(fwidth)) + "d" + LTRIM$(STR$(fheight)) + "l" + LTRIM$(STR$(fwidth)) + "u" + LTRIM$(STR$(fheight))
PSET (fleft, ftop): DRAW frame$
PLAY ok$
LOCATE 31, 66: PRINT "Number of tiles is"; numtiles: _DELAY 1: WIPE "31"
PrepTiles:
b = 1
FOR a = 1 TO numtiles - 1 STEP 2
tiles(a) = b: tiles(a + 1) = b
b = b + 1
NEXT
Shuffle:
LOCATE 31, 68: PRINT "Shuffling tiles..."
FOR a = 1 TO 30
PLAY "o1l64msa"
NEXT
_DELAY 1
WIPE "31"
FOR a = 1 TO numtiles
swop = INT(RND * numtiles) + 1
SWAP tiles(a), tiles(swop)
NEXT
DrawGrid:
top = gtop + 1: tleft = gleft + 2: row = numrows + 1 ' first tile is in 2 pixels, down 2 pixels from edge of grid
FOR a = 0 TO numrows - 1
FOR b = 1 TO numcols
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
tleft = tleft + 54
NEXT
tleft = gleft + 2
top = top + 54
NEXT
top = top + 6
GetAction:
column = INT(numcols + 1) / 2
selectionnumber = 2 ' set selection number as 2, will toggle before each selection is made
LINE (580, top)-(629, top + 49), _RGB32(250, 80, 80), BF
' before first NextMove, top is 60px below top of bottom tile (which is 346)"
NextMove:
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
LOCATE 1, 2: PRINT "Score:"; score(plr); TAB(70); name$(plr); " playing"; TAB(125); "Best for this size:"; bestscore(size)
LOCATE 33, 37: PRINT "Use the four cursor-keys to move to a tile to select and press <Enter> to select it"
LOCATE 31, 72: PRINT "Tries:"; numtries
GetAKey ' tile to be moved to can have Found status 0 (unused), 1 (currently selected) or 2 (already found and removed)
IF k < 1 THEN GOTO NextMove
IF row > numrows THEN
LINE (580, top)-(629, top + 49), _RGB32(0, 0, 0), BF
top = gtop + (numrows - 1) * 54 + 1: tleft = 579
row = numrows
tilenum = numtiles - INT(numcols + 1) / 2 + 1
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF
GOTO NextMove
END IF
SELECT CASE k
CASE IS = 18432 'up
IF row = 1 THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
top = top - 54: row = row - 1
tilenum = tilenum - numcols: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 20480 'down
IF row = numrows THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
top = top + 54: row = row + 1
tilenum = tilenum + numcols: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 19200 'left
IF column = 1 THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
column = column - 1: tleft = tleft - 54
tilenum = tilenum - 1: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 19712 'right
IF column = numcols THEN GOTO NextMove ' limit move to top row
IF found(tilenum) = 2 THEN
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(100, 100, 100), BF
END IF
column = column + 1: tleft = tleft + 54
tilenum = tilenum + 1: picnum = tiles(tilenum)
LINE (tleft, top)-(tleft + 49, top + 49), _RGB32(250, 80, 80), BF ' always color tile moved to as red, whatever Found state is
CASE IS = 32
' <Space> selects a tile. It may have Found status 0, 1 or 2; picnum is image number on the tile; selects is first or second select
' tleft and top are locations of the tile; tilenum is number of the tile to be selected
IF found(tilenum) = 1 THEN
COLOR _RGB32(255, 0, 0), _RGB32(0, 0, 0): PLAY bad$
WIPE "34": LOCATE 34, 61: PRINT "You already selected this tile": _DELAY .5: WIPE "34"
COLOR _RGB32(255, 200, 200), _RGB32(0, 0, 0)
GOTO NextMove
END IF
IF found(tilenum) = 2 THEN
COLOR _RGB32(255, 0, 0), _RGB32(0, 0, 0): PLAY bad$
WIPE "34": LOCATE 34, 59: PRINT "This tile has already been paired": _DELAY .5: WIPE "34"
COLOR _RGB32(255, 200, 200), _RGB32(0, 0, 0)
GOTO NextMove
END IF
PLAY ok$
IF selectionnumber = 1 THEN ' continue if this tile has not been selected or found yet
seltile1 = tilenum: seltile1h = tleft: seltile1v = top ' preserve selection 1 details
selectionnumber = 2
ELSE
seltile2 = tilenum: seltile2h = tleft: seltile2v = top ' preserve selection 2 details
selectionnumber = 1
END IF
found(tilenum) = 1
face = _LOADIMAGE("recpics" + LTRIM$(CHR$(setnum)) + "/" + CHR$(64 + tiles(tilenum)) + ".jpg")
_PUTIMAGE (tleft, top), face ' show pic on tile
IF selectionnumber = 1 THEN
_PUTIMAGE (520, 22), face ' show first pic above grid at 520 horiz
ELSE
_PUTIMAGE (631, 22), face ' show second pic above grid at 631 horiz
END IF
_FREEIMAGE face
IF selectionnumber = 2 THEN ' compare pictures
IF tiles(seltile1) = tiles(seltile2) THEN ' if they match,
PLAY ok$: PLAY ok$
COLOR _RGB32(100, 255, 255)
LOCATE 34, 71: PRINT "A match!": _DELAY .5: WIPE "34" ' advise Match,
found(seltile1) = 2: found(seltile2) = 2 ' flag both as Found,
numfound = numfound + 2 ' and inc number of found tiles
score(plr) = score(plr) + 2
IF numfound = numtiles THEN Done: SYSTEM
ELSE ' but if they don't match,
COLOR _RGB32(255, 100, 100)
PLAY bad$: PLAY bad$
LOCATE 34, 70: PRINT "No match!": _DELAY .5: WIPE "34" ' advise No match
found(seltile1) = 0: found(seltile2) = 0 ' set flags of both tiles to not picked and not found
plr = plr + 1
IF plr > np THEN plr = 1
END IF
numtries = numtries + 1 '
LINE (seltile1h, seltile1v)-(seltile1h + 49, seltile1v + 49), _RGB32(250, 80, 80), BF
IF found(seltile1) = 2 THEN
LINE (seltile2h, seltile2v)-(seltile2h + 49, seltile2v + 49), _RGB32(0, 0, 0), BF
ELSE
LINE (seltile2h, seltile2v)-(seltile2h + 49, seltile2v + 49), _RGB32(100, 100, 100), BF
END IF
LINE (520, 22)-(569, 71), _RGB32(0, 0, 0), BF: LINE (631, 22)-(680, 71), _RGB32(0, 0, 0), BF ' erase pics above grid
END IF
LOCATE 35, 64: PRINT "Found:"; numfound, ; "Tries:"; numtries
GOTO NextMove ' go back for next round
CASE IS = 27 ' esc - quit
LOCATE 34, 63: PRINT "Quitting": PLAY end$: _DELAY .5
SYSTEM
CASE ELSE
GOTO NextMove
END SELECT
GOTO NextMove
SUB WIPE (ln$) ' call with string of 2-digit line numbers only eg "0122" for lines 1 and 22
FOR a = 1 TO LEN(ln$) - 1 STEP 2
LOCATE VAL(MID$(ln$, a, 2)): PRINT SPACE$(149);
NEXT
END SUB
SUB GetAKey
k = 0: _KEYCLEAR
WHILE k < 1
_LIMIT 30
k = _KEYHIT
WEND
END SUB
SUB Done
CLS
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PLAY end$
numtries = numtries + 1
'If single player, check against Best for the level and update if necessary, and leave
' if multi player, just list each player's name and score, and leave
IF NOT _FILEEXISTS("recallbest") THEN
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if none found
FOR a = 1 TO 4: WRITE #1, a * 20, "Default": NEXT
CLOSE #1
END IF
IF np = 1 THEN
LOCATE 18, 50: PRINT "Would you like to reset all previous Best scores?"
ResetBest:
y = _KEYHIT
_LIMIT 30
IF y < 1 THEN GOTO ResetBest
IF y <> 89 AND y <> 121 THEN GOTO GoOn
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if requested
FOR a = 1 TO 4: WRITE #1, a * 20, "Default": NEXT
CLOSE #1
GoOn:
CLS
LOCATE 18, 1
OPEN "recallbest" FOR INPUT AS #1
PRINT TAB(68); "Previous Best Scores"
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO 4
INPUT #1, bestscore(a), bestname$(a)
PRINT TAB(65); a, bestscore(a), bestname$(a)
NEXT
CLOSE #1
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT: PRINT TAB(48); "You finished in"; numtries; "tries. The previous best for this level was "; bestscore(size)
IF numtries < bestscore(size) THEN
bestscore(size) = numtries: bestname$(size) = name$(plr)
PRINT: PRINT TAB(71); "New Best Scores"
OPEN "recallbest" FOR OUTPUT AS #1 ' write new best scores list if previous best beaten
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO 4: WRITE #1, bestscore(a), bestname$(a)
PRINT TAB(65); a, bestscore(a), bestname$(a)
NEXT
CLOSE #1
END IF
ELSE
CLS
LOCATE 18, 74
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT "Scores"
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
FOR a = 1 TO np
PRINT TAB(70); name$(a), score(a)
NEXT
END IF
SLEEP
END SUB
SUB Instructions
start = -34
FOR a = 0 TO 20
face = _LOADIMAGE("recpics" + LTRIM$(CHR$(setnum)) + "/" + CHR$(65 + a) + ".jpg") ' find the picture
_PUTIMAGE (start + 56, 10), face ' show pic on tile
_PUTIMAGE (start + 56, 64), face
start = start + 55
_FREEIMAGE face
NEXT
LOCATE 10, 72
COLOR _RGB32(100, 250, 200): PRINT "Recall"; TAB(40); "A Game by Phil Taylor to test and improve your memory and recall skills"
COLOR _RGB32(255, 255, 255): PRINT
PRINT TAB(10); "A rectangular grid of tiles is displayed, each holding a hidden picture or symbol. There are two of each picture, as shown above."
PRINT
PRINT TAB(10); "Before the game starts, the player/s choose a grid-size from 1 to 4, which will present 18, 20, 30 or 42 tiles respectively, so"
PRINT
PRINT TAB(10); "some of the tiles may not be used, depending on the grid size selected."
PRINT
PRINT TAB(10); "They may also enter the names they wish to play under, and the type of images they prefer, from animals, letters or shapes."
PRINT
PRINT TAB(10); "Players take turns to move within this grid with the four cursor keys and select two tiles with the <SPACE> key for each turn."
PRINT
PRINT TAB(10); "As each tile is selected it is revealed, and when the second one is selected, the two are compared by the computer."
PRINT
PRINT TAB(10); "If they match they are removed, and the player scores two points and plays again. When all tiles have been found, the game ends."
PRINT
PRINT TAB(10); "A Best Score is kept for each grid-size for single players, or all player scores are shown for multiple players."
PRINT
COLOR _RGB32(100, 250, 200), _RGB32(0, 0, 0)
PRINT TAB(65); "Press a key to start"
END SUB
Has anyone else had (or having) this problem?
Windows 10 thinks my QB64 programs are a virus
It will delete the EXE file and/or stop me from running my program
It will even kill the program while it is running
I'm Ted and new to the forum. I've got a question I hope you can help with. I'm working on a game and want to make small, discrete, on-screen labels for a mapping routine. Anyone have any insights on setting up handles for Mac fonts and sizing them. I've seen examples for Windows, but none for Macs. Or is there a way to open a _NEWIMAGE with a higher resolution and print inside that _DEST to reduce font size? Or maybe a way to use _PUTIMAGE to squeeze down text? I tried the latter with little luck.
I understand how it works, I get the numerical value using VAL, but what I don't know is how to set the coordinates at which the inputbox dialog will appear. Imagine a resolution of 1920x1080, you want to enter a value and the inputbox pops up on the top left. Of course, I have the InputBox libraries saved as they came out on the forum a few years ago, but is there any option for this built-in functionality?
