Welcome, Guest |
You have to register before you can post on our site.
|
Latest Threads |
The Crucial Role of Getti...
Forum: Utilities
Last Post: Martinstobe
3 hours ago
» Replies: 0
» Views: 2
|
The Essential Role of See...
Forum: Utilities
Last Post: Martinstobe
7 hours ago
» Replies: 0
» Views: 2
|
astuce pour survivre fina...
Forum: Utilities
Last Post: coletteleger
05-14-2025, 04:47 AM
» Replies: 0
» Views: 48
|
trouver permis de conduir...
Forum: Utilities
Last Post: nicolasrene
05-05-2025, 05:24 AM
» Replies: 0
» Views: 56
|
LIGHTBAR Menu
Forum: Programs
Last Post: nicolasrene
05-05-2025, 05:08 AM
» Replies: 15
» Views: 1,068
|
Learning Pallet Rack Safe...
Forum: Utilities
Last Post: Sandrapew
04-03-2025, 09:36 AM
» Replies: 0
» Views: 62
|
Choosing New Versus or Pr...
Forum: Utilities
Last Post: Sandrapew
03-18-2025, 01:11 AM
» Replies: 0
» Views: 63
|
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 1,159
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 91
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 94
|
|
|
A little mod of a Love Song |
Posted by: bplus - 05-09-2023, 05:27 PM - Forum: Programs
- No Replies
|
 |
Silly Love Songs:
Code: (Select All) You'd think that people would've had enough of silly love songs
I look around me, and I see it isn't so
Some people want to fill the world with silly love songs
And what's wrong with that?
I'd like to know, 'cause here I go again
I love you
I love you
I love you
I love you
I can't explain, the feeling's plain to me (I love you)
Now can't you see?
Ah, she gave me more, she gave it all to me (I love you)
Now can't you see?
What's wrong with that?
I need to know, 'cause here I go again
I love you
I love you
Love doesn't come in a minute
Sometimes it doesn't come at all
I only know that when I'm in it
It isn't silly, love isn't silly, love isn't silly at all
How can I tell you about my loved one?
How can I tell you about my loved one?
How can I tell you about my loved one? (I love you)
How can I tell you about my loved one? (I love you)
I love you
I love you
I love you (I can't explain, the feeling's plain to me, say, can't you see?)
I love you (Ah, he gave me more, he gave it all to me, say, can't you see?)
I love you (I can't explain, the feeling's plain to me
Say, can't you see?)
{How can I tell you about my loved one?}
I love you (Ah, he gave me more, he gave it all to me
Say, can't you see?)
How can I tell you about my loved one?
I love you
I can't explain, the feeling's plain to me
(Say, can't you see?)
How can I tell you about my loved one?
I love you
Ah, he gave me more, he gave it all to me
(Say, can't you see?)
How can I tell you about my loved one?
You'd think that people would've had enough of silly love songs
I look around me and I see it isn't so, oh, no
Some people want to fill the world with silly love songs
And what's wrong with that?
modification code:
Code: (Select All) _Title "Silly Love Songs Rewrite" ' b+ 2023-05-09
Open "Silly Love Songs.txt" For Input As #1
Open "Silly Graph Apps.txt" For Output As #2
While EOF(1) = 0
Line Input #1, fl$
fl$ = strReplace$(fl$, "song", "app")
fl$ = strReplace$(fl$, "loved", "graphed")
fl$ = strReplace$(fl$, "love", "graph")
fl$ = strReplace$(fl$, "Love", "Graph")
fl$ = strReplace$(fl$, " he ", " e ")
fl$ = strReplace$(fl$, " she ", " e ")
Print fl$
Print #2, fl$
Wend
Close
Function strReplace$ (s$, replace$, new$) 'case sensitive 2020-07-28 version
Dim p As Long, sCopy$, LR As Long, lNew As Long
If Len(s$) = 0 Or Len(replace$) = 0 Then
strReplace$ = s$: Exit Function
Else
LR = Len(replace$): lNew = Len(new$)
End If
sCopy$ = s$ ' otherwise s$ would get changed
p = InStr(sCopy$, replace$)
While p
sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)
p = InStr(p + lNew, sCopy$, replace$)
Wend
strReplace$ = sCopy$
End Function
The rewrite, Silly Graph Apps.txt:
Code: (Select All) You'd think that people would've had enough of silly graph apps
I look around me, and I see it isn't so
Some people want to fill the world with silly graph apps
And what's wrong with that?
I'd like to know, 'cause here I go again
I graph you
I graph you
I graph you
I graph you
I can't explain, the feeling's plain to me (I graph you)
Now can't you see?
Ah, e gave me more, e gave it all to me (I graph you)
Now can't you see?
What's wrong with that?
I need to know, 'cause here I go again
I graph you
I graph you
Graph doesn't come in a minute
Sometimes it doesn't come at all
I only know that when I'm in it
It isn't silly, graph isn't silly, graph isn't silly at all
How can I tell you about my graphed one?
How can I tell you about my graphed one?
How can I tell you about my graphed one? (I graph you)
How can I tell you about my graphed one? (I graph you)
I graph you
I graph you
I graph you (I can't explain, the feeling's plain to me, say, can't you see?)
I graph you (Ah, e gave me more, e gave it all to me, say, can't you see?)
I graph you (I can't explain, the feeling's plain to me
Say, can't you see?)
{How can I tell you about my graphed one?}
I graph you (Ah, e gave me more, e gave it all to me
Say, can't you see?)
How can I tell you about my graphed one?
I graph you
I can't explain, the feeling's plain to me
(Say, can't you see?)
How can I tell you about my graphed one?
I graph you
Ah, e gave me more, e gave it all to me
(Say, can't you see?)
How can I tell you about my graphed one?
You'd think that people would've had enough of silly graph apps
I look around me and I see it isn't so, oh, no
Some people want to fill the world with silly graph apps
And what's wrong with that?
|
|
|
Random Tessellations |
Posted by: bplus - 05-09-2023, 02:29 PM - Forum: Programs
- Replies (33)
|
 |
Inspired by Charlie's BAM version I started from scratch for QB64 version with added full colorization mode.
Use b key to toggle color modes or esc to quit, any other key shows another random tile tessellated screen:
Code: (Select All) _Title "Tessellation use b to toggle to 1 color and black or full color"
' b+ 2023-05-09 - Tiling with a pattern
'
' Inspired by Charlie's BAM example:
' https://staging.qb64phoenix.com/showthread.php?tid=1646&pid=15772#pid15772
'
' But I also wanted to try a colorized version.
'
' So use b key to toggle between:
' 1. a mod of Charlies version with different pixel block size with black backgrounds
' 2. the colorized version which reminds me of Magic Eye Art
'
DefLng A-Z
Screen _NewImage(800, 600, 12) ' only 16 colors here
_ScreenMove 250, 50
Dim Shared Pix ' Pix is number of pixels to Tile side
Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim Shared Tile ' Handle that stores Tile Image in memory to call up with _PutImage
Dim Shared B ' Set color mode from Full 16 colors Rainbow to 1 like for printing a label
Do
If InKey$ = "b" Then B = 1 - B ' toggle coloring mode on a b keypress
MakeTile ' create a new random tiling pattern
Tessellate ' tile the screen with it
_PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press
Sleep
Loop Until _KeyDown(27) ' quit when detect escape key on sleep
Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring
Pix = Int(Rnd * 9) + 4 ' sets tile size: pix X pix or a 4X4 to 12X12 Tile coloring
Scale = Int(Rnd * 6) + 4 ' to change pixels to square blocks
If Tile Then _FreeImage Tile ' throw old image away
Tile = _NewImage(Scale * Pix - 1, Scale * Pix - 1) ' make new one
_Dest Tile ' draw in the memory area Tile not on screen
oneColor = Int(Rnd * 15) + 1 ' one color and black background for B Mode
For y = 0 To Scale * Pix - 1 Step Scale
For x = 0 To Scale * Pix - 1 Step Scale
If B Then
If Rnd < .5 Then c = 0 Else c = oneColor 'one color and black background for B Mode
Else
c = Int(Rnd * 16)
End If
Line (x, y)-Step(Scale, Scale), c, BF ' draw square that is scaled pixel
Next
Next
_Dest 0
End Sub
Sub Tessellate ' just covering the screen with our Tile
For y = 0 To _Height Step Scale * Pix
For x = 0 To _Width Step Scale * Pix
_PutImage (x, y)-Step(Scale * Pix - 1, Scale * Pix - 1), Tile, 0
Next
Next
End Sub
|
|
|
Robot floor painter |
Posted by: mnrvovrfc - 05-08-2023, 10:39 PM - Forum: Programs
- Replies (2)
|
 |
This is a silly program that could almost be used as screensaver. It needs music LOL, so it's better.
I derrived the idea from a book on programming games in GW-BASIC by David L. Heiserman (had to look it up), but it's not the book being sold on Amazon that readily comes up in the searches. I think it was called "101 Games In BASIC" or alike. The programs weren't all games; some of them did silly things on the screen. My favorite from them was the "Hacker's Aid". I made my own version with fancy text-graphics and with beeping from "SOUND". It even emulated dial-tone telephone and ringing LOL.
Honorable mention was the "Surrogate Cusser" which could have gotten boring quickly. Fiddlesticks!
I don't remember very well but there might have been a version of that book for the Radio Shack TRS-80 Color Computer, or for the Model III which was incapable of sound. Instead of sound it had a subroutine that "blinked" a short message on the screen. That was its favorite trick.
This program has the "robot" moving in a different way from the old program it was derrived from. It has a quirk not found in the old program.
Code: (Select All) 'by mnrvovrfc 8-May-2023
OPTION _EXPLICIT
DIM AS LONG scren
DIM AS INTEGER px, py, xi, yi, xn, yn, xx, yy, c, l, nivel
DIM AS _UNSIGNED _BYTE redo
RANDOMIZE TIMER
scren = _NEWIMAGE(120, 31, 0)
SCREEN scren
_DELAY 0.5
_SCREENMOVE 0, 0
_TITLE "Press [ESC] to quit."
nivel = 1
px = Random1(100) + 10
py = Random1(29) + 1
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
xn = nivel
yn = nivel
c = 0
l = Random1(8) + 4
redo = 0
DO
_LIMIT 100
IF redo THEN
redo = 0
ELSE
outchar px, py, 219, 0
END IF
px = px + xi * xn
py = py + yi * yn
IF px < 1 OR px > 120 THEN
px = px - xi * xn
py = py - yi * yn
redo = 1
END IF
IF py < 1 OR py > 30 THEN
px = px - xi * xn
py = py - yi * yn
IF nivel > 1 THEN nivel = nivel - 1
IF Random1(2) = 1 AND xn > 1 THEN xn = xn - 1
IF Random1(2) = 1 AND yn > 1 THEN yn = yn - 1
redo = 1
END IF
IF redo = 0 THEN
IF SCREEN(py, px) = 219 THEN
px = px - xi * xn
py = py - yi * yn
IF c < l THEN
IF Random1(2) = 1 THEN
xn = nivel
IF xn > 40 THEN xn = 40
ELSEIF Random1(2) = 1 THEN
yn = nivel
IF yn > 16 THEN yn = 16
ELSE
nivel = nivel + 1
IF nivel > 50 THEN
nivel = 1
FOR yy = 1 TO 30
FOR xx = 1 TO 120
outchar xx, yy, 32, 219
NEXT
NEXT
END IF
END IF
END IF
END IF
c = c + 1
IF c > l THEN
outchar px, py, 219, 0
IF nivel > 1 THEN nivel = nivel - 1
IF Random1(2) = 1 AND xn > 1 THEN xn = xn - 1
IF Random1(2) = 1 AND yn > 1 THEN yn = yn - 1
redo = 1
END IF
END IF
IF redo THEN
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
c = 0
l = Random1(8) + 4
ELSE
outchar px, py, 82, 0
_DISPLAY
END IF
LOOP UNTIL _KEYDOWN(27)
_AUTODISPLAY
SYSTEM
SUB outchar (x AS INTEGER, y AS INTEGER, ca AS _UNSIGNED _BYTE, cb AS _UNSIGNED _BYTE)
STATIC sch AS _UNSIGNED _BYTE
IF cb THEN
sch = SCREEN(y, x)
IF sch = cb THEN sch = ca ELSE sch = cb
ELSE
sch = ca
END IF
LOCATE y, x: PRINT CHR$(sch);
END SUB
FUNCTION Random1& (maxvaluu&)
DIM sg%
sg% = SGN(maxvaluu&)
IF sg% = 0 THEN
Random1& = 0
ELSE
IF sg% = -1 THEN maxvaluu& = maxvaluu& * -1
Random1& = INT(RND * maxvaluu& + 1) * sg%
END IF
END FUNCTION
|
|
|
Looking for a reliable way to determine if a drive letter is in use |
Posted by: hanness - 05-08-2023, 03:46 PM - Forum: General Discussion
- Replies (24)
|
 |
I'm looking for a reliable way to determine if a drive letter is in use but I'm running into some difficulties.
Take the following small clip as an example:
A$ = "F:\"
If _DirExists(A$) Then
Print A$; " Exists"
Else
Print A$; "Does not exist"
End If
Normally, this works fine and indicates if the drive letter contained in A$ exists. But now consider these two exceptions:
1) Suppose I have a thumbdrive attached to the system that has been wiped clean. By wiped clean, I mean you open DISKPART, select the thumbdrive, and perform a "CLEAN" on that drive. In this instance, there will be no partitions on the drive, but in File Explorer, the drive still shows up with a drive letter. However, the clip above will indicate that this drive letter does NOT exist. As a result, if I try to assign that drive letter to another drive, it will fail because it is already in use.
2) The same thing happens if I connect a drive that has BitLocker encryption but has not yet been unlocked. The QB64PE code will indicate that the drive letter does not exist even though it is already in use.
Any suggestions on a better way to determine if a drive letter is in use?
|
|
|
SHELL creates unicode file, can't read correctly with LINE INPUT |
Posted by: thesolarcode - 05-05-2023, 10:39 PM - Forum: Help Me!
- Replies (3)
|
 |
Hi,
I have this snippet to get the number of processor cores.
Problem is that the SHELL command produces a unicode text file and LINE INPUT is not able to read the text correctly.
Manually converting tmp.txt to an ascii file solves the problem.
Question is why is the file created as unicode by default?
Can I influence this from within QB64?
OS is Win 11.
Btw.: I tried also OPEN ... FOR BINARY - doesn't change anything (e.g. LINE INPUT still can't read UNICODE as text):
Code: (Select All) returncode% = SHELL("wmic cpu get NumberOfCores >tmp.txt")
IF _FILEEXISTS("tmp.txt") THEN
OPEN "tmp.txt" FOR INPUT AS #1
DO UNTIL EOF(1)
LINE INPUT #1, a$
?">";a$;"<";filecount%;",len=";len(a$)
filecount% = filecount% + 1
LOOP
CLOSE #1
END IF
'KILL "tmp.txt"
|
|
|
QB64 Phoenix Edition v3.7.0 Released! |
Posted by: DSMan195276 - 05-05-2023, 06:02 AM - Forum: Announcements
- Replies (59)
|
 |
QB64 Phoenix Edition v3.7.0!
https://github.com/QB64-Phoenix-Edition/...tag/v3.7.0
Enhancements - #315, #319, #327 - Implemented a new "Code Export" feature reachable via the "File" menu. - @RhoSigma-QB64
- Useful for authors of tutorials, documentations or Wiki pages, they can now easily export the currently edited code and insert it in their work. The code is highlighted according to the currently chosen color scheme in the IDE and the keywords are linked to its respective Wiki pages.
- Export is possible as Hypertext (.html), Rich Text (.rtf) or Wiki encoded text (.txt).
- #188, #330, #335 - Added commands for rendering Unicode text - @a740g
- _UPrintString
acts like regular _PrintString but accepts Unicode strings.
- _UFontHeight gives the global glyph height of a given font, which may be larger than the _FontHeight. _UPrintString uses this height.
- _UPrintWidth acts like _PrintWidth and returns the width in pixels a Unicode string will take up when printed using _UPrintString.
- _ULineSpacing will give the proper vertical spacing (font height + extra pixels) to vertically separate multiple lines of text.
- #188, #335, #330 - Improve and optimize Font internals - @a740g
- Font loading should be significantly faster due to the addition of a lazy Glyph cache.
- #232, #330, #335 - Added a new _LoadFont() argument which allows loading a font from memory - @a740g
- #316, #317, #318, #320, #322, #325 - Many internal libraries were updated or replaced - @a740g
- zlib was replaced with miniz
- stb_image.h was updated to v2.28
- miniaudio was updated to v0.11.13
- tinysoundfont was updated to the latest version (2/18/23)
- #325 - Added support for using SoundFont3 (SF3) format files with $MinisoundFont - @a740g
- #329 - Added RAD v1 file support - @a740g
- #124, #321, #326 - Improved Declare Library header file resolution - @a740g, @mkilgore
- If Declare Library is in an '$include'd file, then it can also find header files that are relative to the location of the '$include'd file rather than the original source file.
Bug Fixes- #319 - Fixed the "Update All Pages" process in the IDE. - @RhoSigma-QB64
- #333, #334 - Fixed the Keyboard _Devices entry on Windows - @mkilgore
- Alt+key combination will now be correctly reported.
- Pressing left and right shift at the same time will now be correctly reported.
- #332 - Fixed potential segfault in PLAY() - @a740g
- BEEP was also improved so that multiple BEEPs in a row will have a short pause separating them.
Full Changelog: v3.6.0...v3.7.0
|
|
|
Good Coding with ElseIF |
Posted by: Dimster - 05-04-2023, 04:11 PM - Forum: Help Me!
- Replies (12)
|
 |
Going back through some of my coding I found I've used Else and If where I perhaps should have used ELSEIF. It seemed to work out ok but I'm not sure if there is difference in how these two work together.
For example
If ..... then
....
....
...Else
... if .. then
...
...
Else
......
......
End if
V's
If ... then
....
....
ElseIF .... then
.....
....
Else
....
End If
The logic flow would suggest there is no difference.
|
|
|
|