| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| IMP - Not this old chestnut again |
|
Posted by: Dimster - 10-16-2024, 02:57 PM - Forum: General Discussion
- Replies (16)
|
 |
I've been having so/so results using the IMP logical operator, mostly falling back on all the other operators or Select Case. Recently, because we now have Co-Pilot and Gemini I have revisited my IMP failures. Gemini is now telling me that QB64PE either has a bug or mishandles string values with the IMP logical operator. It starts back with the following simple code:
Code: (Select All) Input "Which color do you prefer? Pink or Blue: ",C$
If C$ = "Pink" IMP "Girl" then
Print "You're a Girl!"
Elseif C$ = "Blue" IMP "Boy" then
Print "You"re a Boy!"
Else
Print " Invalid color choice"
End If
Gemini feels this code is correct and should generate the correct response however the IDE highlights an error on the ' If C$ = "Pink" IMP "Girl" then' line. The error message reads that I cannot convert a number to a string. It seems the left side of the IMP operator is fine ( ie If C$ = "Pink" but the right side of IMP is looking for a number and does not recognize a string value.
Tried changing the right side to a Boolean comparison ( ie If C$ = "Pink" IMP NOT("Girl" = "") but still can't come up with the correct answer. Trying to get Gemini to keep correcting the code to make IMP work with this set of conditions it became frustrated with me (of course that's how I took it and not real frustration on its part) and gave a very simple Select Case routine to deal with this simple color question.
While Gemini was thinking the above was an issue for IMP dealing with string values it told me QB64PE could have a bug in its application of IMP after the following code using IMP was tested :
Code: (Select All) Input "Enter your age: ", age
isADULT = age >= 18
If isADULT Imp True Then
Print "You are an Adult"
Else
Print "You are a minor"
End If
The above code was Gemini's answer to a previous attempt on the use of IMP and touts that this code gives the correct answer. Gemini's actual defense of this code reads " The issue was that the isADULT variable was being assigned the result of the comparison age >= 18. This means that isADULT would be True only if the age is greater than or equal to 18. However, the IMP operator was being used incorrectly. The IMP operator should be used to check if the condition "age is greater than or equal to 18 implies adult" is True.
But Gemini's "corrected code" still does NOT give the correct answer.
Moral of the story : To And, Or or XOR is devine to IMP is just gossip.
|
|
|
| Compiler and Running Disagree |
|
Posted by: Vespin - 10-15-2024, 12:27 AM - Forum: Help Me!
- Replies (4)
|
|
Hi all! New here, and mostly new to programming. Regarding the following code, the compiler thinks it's fine, but when I run the program it says there's a syntax error on the line that begins with "Read" (line 30). I can't seem to get it to go away. What makes it stranger is that I can use it in an entirely different program and there's no such error.
Claude.AI and ChatGPT have been useless trying to figure out how to fix this. And yes, there's a fair amount more code above and below in the BAS file, but it doesn't seem to affect this. And no, this code isn't part of a for, loop, sub, or function.
Any help would be greatly appreciated.
Using the latest version of QB64P as of a few days ago. Windows.
Code: (Select All)
mapWidth = 26
mapHeight = 15
Dim Shared mapC(0 To mapWidth - 1, 0 To mapHeight - 1) As Integer
' First row, first column counts as "0" in coordinates
' Data map must match width and height above
' M
' 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2
' 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 '0
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '2
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '3
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '4
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '5
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '6
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '7 M
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '8
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '9
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '10
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '11
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '12
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 '13
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 '14
For y = 0 To mapHeight - 1
For x = 0 To mapWidth - 1
Read mapC(x, y)
Next
Next
EDIT: As is typical, it seems that I figured it out after asking for help. It seems the number-comments after each DATA line are what did it.
|
|
|
|
| Weekday and Leap Year Calculator |
|
Posted by: SierraKen - 10-14-2024, 09:38 PM - Forum: SierraKen
- No Replies
|
 |
I made this using code from my Calendar Making program. It is much smaller and would be easier to understand for programmers I think.
Code: (Select All)
'Weekday and Leap Year Calculator by SierraKen
'October 14, 2024
'This app tells you what weekday of the year a date falls on or if you want to see if a certain year has a Leap Year.
'It can use anywhere from 1753 A.D. to 9999 A.D because 1753 is when the Gregorian Calendar started.
'Most of this code is taken from my Calendar Maker on the QB64 Phoenix forum.
'Thank you to the guys on forum for the help!
Dim leap As Single
Dim dd As Single
Dim olddd As Single
Dim mm As Single
Dim oldmm As Single
Dim yy As Single
Dim oldyy As Single
Dim days As Single
Dim weekday As Single
_Title "Weekday and Leap Year Calculator by SierraKen"
start:
leap = 0: dd = 0: mm = 0: yy = 0: days = 0: weekday = 0: oldyy = 0: menu = 0
ag$ = ""
Cls
Print: Print
Print " Weekday and Leap Year Calculator by SierraKen"
Print: Print: Print
Print "(1) Calculate Weekday"
Print "(2) Calculate Leap Year"
Print "(3) Quit"
Print: Print
Print "Press 1, 2, or 3."
themenu:
menu$ = InKey$
If menu$ = "1" Then GoTo month:
If menu$ = "2" Then GoTo leapyear:
If menu$ = "3" Then End
GoTo themenu:
month:
Print
Input "Month (1-12): ", mm
If mm > 12 Or mm < 1 Or Int(mm) <> mm Then Print "Months must be between 1 and 12, try again.": Print: Print: GoTo month:
Print
day:
Input "Day (1-31): ", dd
Print
Input "Year (1753-9999): ", yy
If yy < 1753 Or yy > 9999 Then Print "Year must be between 1753 and 9999. Try again.": Print: Print: GoTo month:
'Calculate to see if it's a Leap Year.
If mm <> 2 Then GoTo nex:
If yy / 400 = Int(yy / 400) Then leap = 1: GoTo more:
If yy / 4 = Int(yy / 4) Then leap = 1
If yy / 100 = Int(yy / 100) Then leap = 0
'Get the number of days for each month.
more:
If leap = 1 Then days = 29
If leap = 0 Then days = 28
GoTo weekday:
nex:
If mm = 1 Then days = 31
If mm = 3 Then days = 31
If mm = 4 Then days = 30
If mm = 5 Then days = 31
If mm = 6 Then days = 30
If mm = 7 Then days = 31
If mm = 8 Then days = 31
If mm = 9 Then days = 30
If mm = 10 Then days = 31
If mm = 11 Then days = 30
If mm = 12 Then days = 31
weekday:
If dd < 1 Or dd <> Int(dd) Or dd > days Then Print "Days must be between 1 and " + Str$(days) + " on that month. Try again.": Print: Print: GoTo day:
If mm = 1 Then month$ = "January"
If mm = 2 Then month$ = "February"
If mm = 3 Then month$ = "March"
If mm = 4 Then month$ = "April"
If mm = 5 Then month$ = "May"
If mm = 6 Then month$ = "June"
If mm = 7 Then month$ = "July"
If mm = 8 Then month$ = "August"
If mm = 9 Then month$ = "September"
If mm = 10 Then month$ = "October"
If mm = 11 Then month$ = "November"
If mm = 12 Then month$ = "December"
oldyy = yy
oldmm = mm
olddd = dd
GetDay mm, dd, yy, weekday
yy = oldyy
mm = oldmm
dd = olddd
If weekday = 1 Then weekday$ = "Sunday"
If weekday = 2 Then weekday$ = "Monday"
If weekday = 3 Then weekday$ = "Tuesday"
If weekday = 4 Then weekday$ = "Wednesday"
If weekday = 5 Then weekday$ = "Thursday"
If weekday = 6 Then weekday$ = "Friday"
If weekday = 0 Then weekday$ = "Saturday"
'--------------------------------------------------------------------------------------------------
Print: Print
Print month$ + " " + Str$(dd) + ", " + Str$(yy) + " falls on a " + weekday$ + "."
'--------------------------------------------------------------------------------------------------
Print: Print: Print
Print "Press M to go to menu or Esc to quit."
againn:
ag$ = InKey$
If ag$ = "m" Or ag$ = "M" Then GoTo start:
If ag$ = Chr$(27) Then End
GoTo againn:
leapyear:
Input "Year (1753-9999): ", yy
If yy < 1753 Or yy > 9999 Then Print "Year must be between 1753 and 9999. Try again.": Print: Print: GoTo leapyear:
'Calculate to see if it's a Leap Year.
If yy / 400 = Int(yy / 400) Then leap = 1: GoTo more2:
If yy / 4 = Int(yy / 4) Then leap = 1
If yy / 100 = Int(yy / 100) Then leap = 0
'Get the number of days for each month.
more2:
Print: Print
If leap = 1 Then Print Str$(yy) + " does have a Leap Year."
If leap = 0 Then Print Str$(yy) + " does not have a Leap Year."
Print: Print: Print
Print "Press M to go menu or Esc to quit."
again:
ag$ = InKey$
If ag$ = "m" Or ag$ = "M" Then GoTo start:
If ag$ = Chr$(27) Then End
GoTo again:
'This section gets the right weekday.
Sub GetDay (mm, dd, yy, weekday) 'use 4 digit year
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If mm < 3 Then yy = yy - 1
If mm < 3 Then mm = mm + 12
century = yy Mod 100
zerocentury = yy \ 100
weekday = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
End Sub
|
|
|
|
| Weekday and Leap Year Calculator |
|
Posted by: SierraKen - 10-14-2024, 09:29 PM - Forum: Programs
- No Replies
|
|
Today I was just goofing around with the calendar making program I made awhile back, and decided to make a much simpler app that tells you what weekday it is for a given date. I also added a leap year calculator on it as well. Then afterward I noticed that Steve and Bplus and others have made similar ones, so oh well.  At least this will be easier for programmers to learn with than my calendar making program.
Code: (Select All)
'Weekday and Leap Year Calculator by SierraKen
'October 14, 2024
'This app tells you what weekday of the year a date falls on or if you want to see if a certain year has a Leap Year.
'It can use anywhere from 1753 A.D. to 9999 A.D because 1753 is when the Gregorian Calendar started.
'Most of this code is taken from my Calendar Maker on the QB64 Phoenix forum.
'Thank you to the guys on forum for the help!
Dim leap As Single
Dim dd As Single
Dim olddd As Single
Dim mm As Single
Dim oldmm As Single
Dim yy As Single
Dim oldyy As Single
Dim days As Single
Dim weekday As Single
_Title "Weekday and Leap Year Calculator by SierraKen"
start:
leap = 0: dd = 0: mm = 0: yy = 0: days = 0: weekday = 0: oldyy = 0: menu = 0
ag$ = ""
Cls
Print: Print
Print " Weekday and Leap Year Calculator by SierraKen"
Print: Print: Print
Print "(1) Calculate Weekday"
Print "(2) Calculate Leap Year"
Print "(3) Quit"
Print: Print
Print "Press 1, 2, or 3."
themenu:
menu$ = InKey$
If menu$ = "1" Then GoTo month:
If menu$ = "2" Then GoTo leapyear:
If menu$ = "3" Then End
GoTo themenu:
month:
Print
Input "Month (1-12): ", mm
If mm > 12 Or mm < 1 Or Int(mm) <> mm Then Print "Months must be between 1 and 12, try again.": Print: Print: GoTo month:
Print
day:
Input "Day (1-31): ", dd
Print
Input "Year (1753-9999): ", yy
If yy < 1753 Or yy > 9999 Then Print "Year must be between 1753 and 9999. Try again.": Print: Print: GoTo month:
'Calculate to see if it's a Leap Year.
If mm <> 2 Then GoTo nex:
If yy / 400 = Int(yy / 400) Then leap = 1: GoTo more:
If yy / 4 = Int(yy / 4) Then leap = 1
If yy / 100 = Int(yy / 100) Then leap = 0
'Get the number of days for each month.
more:
If leap = 1 Then days = 29
If leap = 0 Then days = 28
GoTo weekday:
nex:
If mm = 1 Then days = 31
If mm = 3 Then days = 31
If mm = 4 Then days = 30
If mm = 5 Then days = 31
If mm = 6 Then days = 30
If mm = 7 Then days = 31
If mm = 8 Then days = 31
If mm = 9 Then days = 30
If mm = 10 Then days = 31
If mm = 11 Then days = 30
If mm = 12 Then days = 31
weekday:
If dd < 1 Or dd <> Int(dd) Or dd > days Then Print "Days must be between 1 and " + Str$(days) + " on that month. Try again.": Print: Print: GoTo day:
If mm = 1 Then month$ = "January"
If mm = 2 Then month$ = "February"
If mm = 3 Then month$ = "March"
If mm = 4 Then month$ = "April"
If mm = 5 Then month$ = "May"
If mm = 6 Then month$ = "June"
If mm = 7 Then month$ = "July"
If mm = 8 Then month$ = "August"
If mm = 9 Then month$ = "September"
If mm = 10 Then month$ = "October"
If mm = 11 Then month$ = "November"
If mm = 12 Then month$ = "December"
oldyy = yy
oldmm = mm
olddd = dd
GetDay mm, dd, yy, weekday
yy = oldyy
mm = oldmm
dd = olddd
If weekday = 1 Then weekday$ = "Sunday"
If weekday = 2 Then weekday$ = "Monday"
If weekday = 3 Then weekday$ = "Tuesday"
If weekday = 4 Then weekday$ = "Wednesday"
If weekday = 5 Then weekday$ = "Thursday"
If weekday = 6 Then weekday$ = "Friday"
If weekday = 0 Then weekday$ = "Saturday"
'--------------------------------------------------------------------------------------------------
Print: Print
Print month$ + " " + Str$(dd) + ", " + Str$(yy) + " falls on a " + weekday$ + "."
'--------------------------------------------------------------------------------------------------
Print: Print: Print
Print "Press M to go to menu or Esc to quit."
againn:
ag$ = InKey$
If ag$ = "m" Or ag$ = "M" Then GoTo start:
If ag$ = Chr$(27) Then End
GoTo againn:
leapyear:
Input "Year (1753-9999): ", yy
If yy < 1753 Or yy > 9999 Then Print "Year must be between 1753 and 9999. Try again.": Print: Print: GoTo leapyear:
'Calculate to see if it's a Leap Year.
If yy / 400 = Int(yy / 400) Then leap = 1: GoTo more2:
If yy / 4 = Int(yy / 4) Then leap = 1
If yy / 100 = Int(yy / 100) Then leap = 0
'Get the number of days for each month.
more2:
Print: Print
If leap = 1 Then Print Str$(yy) + " does have a Leap Year."
If leap = 0 Then Print Str$(yy) + " does not have a Leap Year."
Print: Print: Print
Print "Press M to go menu or Esc to quit."
again:
ag$ = InKey$
If ag$ = "m" Or ag$ = "M" Then GoTo start:
If ag$ = Chr$(27) Then End
GoTo again:
'This section gets the right weekday.
Sub GetDay (mm, dd, yy, weekday) 'use 4 digit year
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If mm < 3 Then yy = yy - 1
If mm < 3 Then mm = mm + 12
century = yy Mod 100
zerocentury = yy \ 100
weekday = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
End Sub
|
|
|
|
| QB64 IDE Helper |
|
Posted by: Pete - 10-14-2024, 06:11 PM - Forum: Utilities
- Replies (3)
|
 |
Forget about hotkeys, now thanks to Pete's handy dandy IDE Helper, we can use a HOT MOUSE, instead!
Folks, are you tired of typing in all those DO/LOOP, FOR/NEXT, and SELECT CASE statements? Are you tired of wishing that blankity-blank Steve would sell off some of his blankity-blank farm to provide us ALL with FREE mega-expensive multi-hot-key programmable keyboards? (Sorry, channeling that blankity-blank Clippy again). If so, here is a cheap-ascii solution for you!
Instructions:
1) Run program.
2) Left click a snippet from the list.
3) Right click in the QB64 IDE where you want the snippet placed then click the "Paste" selection in the QB64 IDE popup window.
Viola, you've got code!
Code: (Select All)
' Paste pre-made statements into the QB64 IDE.
' Use </> for page break. Place space(s) after the > symbol for empty lines between statements.
_Title "IDE Helper"
maxheight% = 50
wdth% = 30
Width wdth%, 2
_ScreenMove _DesktopWidth - wdth% * 8, 0
_Font 16
ReDim cbrd$(50), dsp$(50)
cc$ = "</>"
Do
Read a$
If a$ = "eof" Then Exit Do
a1$ = a$: a2$ = a$: dsp$ = Space$(wdth%)
cnt = cnt + 1
q% = InStr(a$, cc$)
Do
q% = InStr(a1$, cc$)
q_end% = InStr(a1$, cc$) + Len(cc$)
If q% Then
a1$ = Mid$(a1$, 1, q% - 1) + ": " + LTrim$(Mid$(a1$, q_end%))
Else
Exit Do
End If
Loop
Mid$(dsp$, 2) = Mid$(a1$, 1, wdth% - 2)
dsp$(cnt) = dsp$
Do
q% = InStr(a2$, cc$)
If q% Then
break$ = "": i% = 0
Do
i% = i% + 1
break$ = break$ + Chr$(13) + Chr$(10)
Loop Until Mid$(a2$, q% + 2 + i%, 1) <> " "
a2$ = Mid$(a2$, 1, q% - 1) + break$ + LTrim$(Mid$(a2$, q% + Len(cc$)))
Else
Exit Do
End If
Loop
cbrd$(cnt) = a2$ + Chr$(13) + Chr$(10)
Loop Until cnt = maxheight%
height% = cnt
Width wdth%, height%
palette_select = 0
Select Case palette_select
Case 0
Palette 3, 7 ' Odd rows.'62
Palette 1, 56 ' Even rows. '20
Palette 7, 63 ' Page background.
Palette 6, 55 ' Odd row mouse click.
Palette 4, 38 ' Even row mouse click
Color 0, 7
Case Else
Palette 3, 62 ' Odd rows.
Palette 1, 20 ' Even rows.
Palette 7, 55 ' Page background.
Palette 6, 38 ' Odd row mouse click.
Palette 4, 36 ' Even row mouse click
Color 0, 7
End Select
_Font 16
Cls
For i% = 1 To cnt
If i% / 2 = i% \ 2 Then Color 15, 1 Else Color 0, 3
Locate i%, 1: Print dsp$(i%);
Next
Do
_Limit 30
While _MouseInput: Wend
x = _MouseX
y = _MouseY
If _MouseButton(1) Then
_Clipboard$ = cbrd$(y)
If y / 2 = y \ 2 Then Color 15, 4 Else Color 0, 6
Locate y, 1: Print dsp$(y);: _Delay .1
Locate y, 1
If y / 2 = y \ 2 Then Color 15, 1 Else Color 0, 3
Print dsp$(y);
End If
Loop Until InKey$ = Chr$(27)
System
Data "_ScreenMove 0, 0"
Data "Width 180, 42"
Data + CHR$(34) + "
Data "If Then</> ELSE</> End IF"
Data "For i% = 1 to</> Next i%"
Data "Do</> Loop"
Data "While</> Wend"
Data "Select Case</> Case</> End Select"
Data "Do</>_Limit 30</>b$ = inkey$</>If Len(b$) Then</>Select Case b$</>Case Chr$(27)</>System</>Case</> Case</> End Select</>End If</>Loop"
Data "Open file$ for Input as #</> Close #"
Data "Open file$ for Output as #</> Close #"
Data "Open file$ for Binary as #</> Close #"
Data "Open dir$+ file$ for Input as #</> Close #"
Data "Open dir$+ file$ for Output as #</> Close #"
Data "Open dir$+ file$ for Binary as #</> Close #"
Data "Get #1, , a$"
Data "Put #1, , a$"
Data "While _MouseInput: Wend"
Data "x = _MouseX"
Data "y = _MouseY"
Data eof
Now if you act now, because we can't do this the whole day, you'll be able to get the one below, which allows you to easily write the code snippets into a database file with Notepad. A sample database is included. (See download below program.)
Code: (Select All)
' Paste pre-made statements into the QB64 IDE.
' Use </> for page break. Place space(s) after the > symbol for empty lines between statements.
_Title "IDE Helper"
maxheight% = 50
wdth% = 30
Width wdth%, 2
_ScreenMove _DesktopWidth - wdth% * 8, 0
_Font 16
ReDim cbrd$(50), dsp$(50)
cc$ = "</>"
file$ = "IDE-Helper.dat"
If Not _FileExists(file$) Then Print "Cannot find data file: "; file$: End
Open file$ For Binary As #1
Do
Line Input #1, a$
a1$ = a$: a2$ = a$: dsp$ = Space$(wdth%)
cnt = cnt + 1
q% = InStr(a$, cc$)
Do
q% = InStr(a1$, cc$)
q_end% = InStr(a1$, cc$) + Len(cc$)
If q% Then
a1$ = Mid$(a1$, 1, q% - 1) + ": " + LTrim$(Mid$(a1$, q_end%))
Else
Exit Do
End If
Loop
Mid$(dsp$, 2) = Mid$(a1$, 1, wdth% - 2)
dsp$(cnt) = dsp$
Do
q% = InStr(a2$, cc$)
If q% Then
break$ = "": i% = 0
Do
i% = i% + 1
break$ = break$ + Chr$(13) + Chr$(10)
Loop Until Mid$(a2$, q% + 2 + i%, 1) <> " "
a2$ = Mid$(a2$, 1, q% - 1) + break$ + LTrim$(Mid$(a2$, q% + Len(cc$)))
Else
Exit Do
End If
Loop
cbrd$(cnt) = a2$ + Chr$(13) + Chr$(10)
Loop Until EOF(1) Or cnt = maxheight%
height% = cnt
Width wdth%, height%
palette_select = 0
Select Case palette_select
Case 0
Palette 3, 7 ' Odd rows.'62
Palette 1, 56 ' Even rows. '20
Palette 7, 63 ' Page background.
Palette 6, 55 ' Odd row mouse click.
Palette 4, 38 ' Even row mouse click
Color 0, 7
Case Else
Palette 3, 62 ' Odd rows.
Palette 1, 20 ' Even rows.
Palette 7, 55 ' Page background.
Palette 6, 38 ' Odd row mouse click.
Palette 4, 36 ' Even row mouse click
Color 0, 7
End Select
_Font 16
Cls
For i% = 1 To cnt
If i% / 2 = i% \ 2 Then Color 15, 1 Else Color 0, 3
Locate i%, 1: Print dsp$(i%);
Next
Do
_Limit 30
While _MouseInput: Wend
x = _MouseX
y = _MouseY
If _MouseButton(1) Then
_Clipboard$ = cbrd$(y)
If y / 2 = y \ 2 Then Color 15, 4 Else Color 0, 6
Locate y, 1: Print dsp$(y);: _Delay .1
Locate y, 1
If y / 2 = y \ 2 Then Color 15, 1 Else Color 0, 3
Print dsp$(y);
End If
Loop Until InKey$ = Chr$(27)
System
IDE-helper.7z (Size: 1.44 KB / Downloads: 32)
Includes program and database IDE-Helper.dat file.
To add your own code snippets just write them out or paste them into the database or data statements (if using the first method posted). Now this is how the formatting works: 1) To add a line-break, use </>. To add multiple line breaks like 3, add spaces after the </> symbols...
Examples:
DO: LOOP - Pastes as
DO: LOOP
DO</>LOOP Pastes as:
DO
LOOP
DO</> LOOP Pastes as:
DO
LOOP
DO</> LOOP Pastes as:
DO
LOOP
---------------------------
When you run the utility, it should open in the right upper corner of your screen.
It only works with the mouse, no keys except Esc the quit.
I run it so my QB64 IDE resides to the left at an adjusted width so the two windows don't overlap. That makes it easy to go to the right, copy a snippet, and get back into the IDE.
Note: It does not indent code. Let the IDE do that for you.
Note: There will by syntax errors because some areas of the code are intentionally left unfinished so you can type in your own variables, etc.
Let me know if you have any questions about use.
Pete
|
|
|
|
| Classic 15 puzzle |
|
Posted by: Dav - 10-14-2024, 12:36 PM - Forum: Games
- Replies (5)
|
 |
Here's the classic 15 puzzle game in QB64. Use arrows to move numbers to the empty place. Put numbers in order 1 to 15 to solve puzzle. Uses the handy Text SUB by @bplus for the big numbers.
- Dav
Code: (Select All)
'============
'15puzzle.bas
'============
'The classic 15 puzzle game in QB64.
'By Dav, OCT/2024
'Use arrows to move numbers to the empty place.
'Put numbers in order 1 to 15 to solve puzzle.
'Text SUB made by bplus (thanks bplus!)
Randomize Timer
dh = Int(_DesktopHeight * .75) 'scale board to 75% of users desktop height
Screen _NewImage(dh, dh, 32)
Dim board(4, 4) '4x4 board
'=== init board
Dim num(15) '15 random numbers
For n = 0 To 14
num(n) = n + 1
Next: num(15) = 0 'this one is empty
For b = 1 To 500 'shuffle
Swap num(Int(Rnd * 15)), num(15)
Next
b = 0 'assign on the board
For row = 0 To 4 - 1
For col = 0 To 4 - 1
board(row, col) = num(b)
If board(row, col) = 0 Then
emptyrow = row: emptycol = col
End If
b = b + 1
Next
Next
GoSub DrawBoard
'=== main loop
Do
'=== get user input
Do
key$ = InKey$: _Limit 30
Loop Until key$ <> ""
Select Case key$
Case Chr$(0) + Chr$(72) 'up
If emptyrow < 4 - 1 Then
board(emptyrow, emptycol) = board(emptyrow + 1, emptycol)
board(emptyrow + 1, emptycol) = 0
emptyrow = emptyrow + 1
End If
Case Chr$(0) + Chr$(80) 'down
If emptyrow > 0 Then
board(emptyrow, emptycol) = board(emptyrow - 1, emptycol)
board(emptyrow - 1, emptycol) = 0
emptyrow = emptyrow - 1
End If
Case Chr$(0) + Chr$(75) 'left
If emptycol < 4 - 1 Then
board(emptyrow, emptycol) = board(emptyrow, emptycol + 1)
board(emptyrow, emptycol + 1) = 0
emptycol = emptycol + 1
End If
Case Chr$(0) + Chr$(77) 'right
If emptycol > 0 Then
board(emptyrow, emptycol) = board(emptyrow, emptycol - 1)
board(emptyrow, emptycol - 1) = 0
emptycol = emptycol - 1
End If
Case Chr$(27) 'quit
End
End Select
GoSub DrawBoard
'== check if puzzle solved
solved = 1: tally = 1
For row = 0 To 4 - 1
For col = 0 To 4 - 1
If board(row, col) <> 0 Then
If board(row, col) <> tally Then solved = 0
tally = tally + 1
End If
Next
Next
If solved = 1 Then Exit Do
Loop
GoSub DrawBoard
Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, 150), BF
Text _Width / 4 + 2, _Height / 3 + 2, _Width / 8, _RGB(0, 0, 0), "SOLVED!!"
Text _Width / 4, _Height / 3, _Width / 8, _RGB(255, 255, 0), "SOLVED!!"
_Display
End
'========
DrawBoard:
'========
size = _Width / 4
For row = 0 To 4 - 1
For col = 0 To 4 - 1
x1 = (col * size): x2 = x1 + size
y1 = (row * size): y2 = y1 + size
If board(row, col) = 0 Then
Line (x1, y1)-(x2, y2), _RGB(0, 0, 0), BF
Else
Line (x1, y1)-(x2, y2), _RGB(200, 0, 0), BF
Line (x1, y1)-(x2, y2), _RGB(0, 0, 0), B
p$ = _Trim$(Str$(board(row, col)))
If Len(p$) = 1 Then x1 = x1 + (size / 4)
Text x1 + 2, y1 + 2, size, _RGB(0, 0, 0), p$
Text x1, y1, size, _RGB(255, 255, 255), p$
End If
Next
Next
_Display
Return
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
'Text SUB by bplus.
Dim fg As _Unsigned Long, cur&, I&, multi, xlen
fg = _DefaultColor
cur& = _Dest
I& = _NewImage(8 * Len(txt$), 16, 32)
_Dest I&
Color K, _RGBA32(0, 0, 0, 0)
_PrintString (0, 0), txt$
multi = textHeight / 16
xlen = Len(txt$) * 8 * multi
_PutImage (x, y)-Step(xlen, textHeight), I&, cur&
Color fg
_FreeImage I&
End Sub
|
|
|
|
| hello , memset not funktion. |
|
Posted by: funkheld - 10-13-2024, 08:49 AM - Forum: General Discussion
- Replies (1)
|
|
hello, good day.
I can't get this memset demo to work.
thanks. regards
Code: (Select All) DECLARE LIBRARY
FUNCTION memsetB& ALIAS memset (p AS _BYTE, BYVAL c AS _UNSIGNED LONG, BYVAL n AS _UNSIGNED LONG)
FUNCTION memsetI& ALIAS memset (p AS INTEGER, BYVAL c AS _UNSIGNED LONG, BYVAL n AS _UNSIGNED LONG)
FUNCTION memsetL& ALIAS memset (p AS LONG, BYVAL c AS _UNSIGNED LONG, BYVAL n AS _UNSIGNED LONG)
END DECLARE
DIM Barray(1 TO 10) AS _BYTE
res& = memsetB(Barray(1), 65, 5)
FOR i = 1 TO 10
PRINT Barray(i); 'display BYTE array decimal values
NEXT
PRINT: PRINT
DIM Larray(1 TO 10) AS LONG
res& = memsetL(Larray(1), 65, 5)
FOR i = 1 TO 10
PRINT Larray(i); 'displays LONG array decimal values
NEXT i
PRINT
FOR i = 1 TO 10
PRINT " " + HEX$(Larray(i)); 'displays each byte value &H41 = 65
NEXT i
![[Image: memset.jpg]](https://i.ibb.co/yR7jhKn/memset.jpg)
|
|
|
|
| PieSlice |
|
Posted by: SMcNeill - 10-12-2024, 09:07 PM - Forum: Works in Progress
- Replies (14)
|
 |
As Terry pointed out elsewhere, CIRCLE has always been broken when it comes to doing arcs for us to fill. I thought I'd give a quick shot at tossing something together to work for us, and here's what I came up with. (Not tested extensively so may break with various angles/combos. I hope not.)
Code: (Select All)
Screen _NewImage(1280, 720, 32)
$Color:32
PieSlice 100, 100, 100, 45, 0, Red
PieSlice 200, 200, 50, 270, 120, Green
PieSlice 300, 300, 50, 120, 270, Gold
Sub PieSlice (cx As Long, cy As Long, r As Long, startAngle As Long, endAngle As Long, c As _Unsigned Long)
Dim As Long x, y, x1, y1
If startAngle > endAngle Then endAngle = endAngle + 360
x1 = Sin(_D2R(startAngle + 90)) * r
y1 = Cos(_D2R(startAngle + 90)) * r
Line (cx, cy)-Step(x1, y1), c
For i = startAngle To endAngle Step Sgn(endAngle - startAngle)
x = Sin(_D2R(i + 90)) * r
y = Cos(_D2R(i + 90)) * r
Line -(cx + x, cy + y), c
If x <> x1 And y <> y1 And xt = 0 Then 'chose a point inside the arc to fill
xt = Sin(_D2R(i + 90)) * r / 2
yt = Cos(_D2R(i + 90)) * r / 2
End If
Next
Line -(cx, cy), c
Paint (cx + xt, cy + yt), c
End Sub
|
|
|
|
| CIRCLE issue |
|
Posted by: TerryRitchie - 10-12-2024, 05:35 PM - Forum: GitHub Discussion
- Replies (2)
|
 |
The CIRCLE statement is not closing pie slices correctly.
SCREEN _NEWIMAGE(640, 480, 32)
CIRCLE (319, 239), 30, _RGB32(255, 255, 255), -.000001, -1, 1
|
|
|
|
|
