Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 492
» Latest member: Feederumn
» Forum threads: 2,833
» Forum posts: 26,548

Full Statistics

Latest Threads
Another Dir/File compare ...
Forum: Utilities
Last Post: eoredson
6 hours ago
» Replies: 0
» Views: 28
Problems with QBJS
Forum: Help Me!
Last Post: hsiangch_ong
8 hours ago
» Replies: 3
» Views: 72
another variation of "10 ...
Forum: Programs
Last Post: hsiangch_ong
8 hours ago
» Replies: 2
» Views: 94
sleep command in compiler...
Forum: General Discussion
Last Post: Pete
11 hours ago
» Replies: 1
» Views: 50
Aloha from Maui guys.
Forum: General Discussion
Last Post: madscijr
Yesterday, 04:33 PM
» Replies: 8
» Views: 145
which day of the week
Forum: Programs
Last Post: Pete
Yesterday, 03:32 PM
» Replies: 29
» Views: 639
Playing sound files in QB...
Forum: Programs
Last Post: ahenry3068
Yesterday, 05:37 AM
» Replies: 9
» Views: 1,188
Rock Jockey 2.0 is ready ...
Forum: Games
Last Post: NakedApe
01-09-2025, 09:02 PM
» Replies: 20
» Views: 622
Button rack or hotkey fun...
Forum: Utilities
Last Post: Jack002
01-09-2025, 08:20 PM
» Replies: 6
» Views: 405
ANSIPrint
Forum: a740g
Last Post: bplus
01-09-2025, 05:36 PM
» Replies: 11
» Views: 225

 
  Alt-Keys pattern
Posted by: eoredson - 07-07-2023, 04:52 AM - Forum: Utilities - Replies (3)

I have been looking at the keyboard scancodes for the keys Alt-A to Alt-Z and found no pattern to them!

Are they internal to the electronic keyboard itself?

Thanks, Erik.

Here is a program to trap and display them:

Code: (Select All)
Rem $Dynamic
DefInt A-Z

Dim Keys(1 To 26) As Integer

' scancodes for Alt-A to Alt-Z.
Data 30,48,46,32,18,33,34,35,23,36,37,38,50,49,24,25,16,19,31,20,22,47,17,45,21,44

' read Alt-<key> data.
For Var = 1 To 26
    Read Keys(Var)
Next
Color 15
Print "Press <escape> to exit. Otherwise press Alt-A to Alt-Z."
Color 14
Do
    _Limit 50
    I$ = InKey$
    If Len(I$) Then
        If I$ = Chr$(27) Then Color 7: End
    End If
    If Len(I$) = 2 Then
        X = Asc(Right$(I$, 1))
        For Z = 1 To 26
            If Keys(Z) = X Then
                Print "Pressed Alt-"; Chr$(Z + 64); " scan"; X
            End If
        Next
    End If
Loop
End

' scancodes for Alt-A to Alt-Z.
Rem ALT-A = 30
Rem ALT-B = 48
Rem ALT-C = 46
Rem ALT-D = 32
Rem ALT-E = 18
Rem ALT-F = 33
Rem ALT-G = 34
Rem ALT-H = 35
Rem ALT-I = 23
Rem ALT-J = 36
Rem ALT-K = 37
Rem ALT-L = 38
Rem ALT-M = 50
Rem ALT-N = 49
Rem ALT-O = 24
Rem ALT-P = 25
Rem ALT-Q = 16
Rem ALT-R = 19
Rem ALT-S = 31
Rem ALT-T = 20
Rem ALT-U = 22
Rem ALT-V = 47
Rem ALT-W = 17
Rem ALT-X = 45
Rem ALT-Y = 21
Rem ALT-Z = 44

Print this item

  Files for QBasic Programming Book.....
Posted by: Space_Ghost - 07-07-2023, 04:30 AM - Forum: Help Me! - Replies (7)

Quick BASIC Programming for Scientists and Engineers :  CRC-Press; 1st edition (January 1, 1993)
This is a pretty hopeful request, but does anyone know if the modules (.bas files) for this book are available anywhere on the web?
The book originally came with a (yes) 5-1/4 inch floppy disk with the files.  I no longer have such a drive, but hope the files reside somewhere.
Thanks in advance if you have any information.  I would love to work through the programs being an engineer by trade.
PS - Uses QBasic 4.0 and book is 30 years old, but very relevant still.

[Image: book-cover.jpg]

Print this item

  Archive-dot-org simple helper
Posted by: mnrvovrfc - 07-06-2023, 10:39 PM - Forum: Utilities - Replies (11)

This is a program that could make life a bit easier to navigate "archive-dot-org" if the user is only looking to download music or video.

N.B. This requires a bit of research to configure the program as desired. As it stands it only works for audio (FLAC, MP3, OGG, WAV etc.) This research is to obtain the "subjects" which are tags that have to be written precisely into a web address. On "archive-dot-org" some categories are written out like plain English, capitalized short phrases with spaces, which cannot stand into a web address. The site has a chooser of subjects which puts down stuff which could be unpredictable. (Sometimes it chooses "multiple categories" which is the same word or words but in different upper-lower-case combinations.) Therefore the user must tinker a little bit to obtain a subject tag for use with this program. It's a vain attempt to make this program more flexible.

This program requires one text file, and it's recommended to provide another. The required file has one line which is the full path of the executable to the web browser. Because I programmed this on Linux, I'm not familiar with a way to launch the web browser from an user's QB64 program on MacOS or on Windows. I also programmed to launch the AppImage which might appear clumsy to some of you. This file is not provided, you will have to create it. It is called "helparchorg-browser.txt", it must reside in the same directory as the executable. This program only reads the first line of this file, so make sure it has a correct entry. Smile

It's recommended to have also "helparchorg-category.txt". It could also be called "helparchorg-subject.txt". Here you will put down a subject, one per line, for the media that is sought. If you want two categories at a time then put each tag joined by a plus sign. At the moment no more than two categories could be joined.

The program reads the text files, tells the user that it found the web browser, and then shows a menu with the categories. If there's only one then it's "electronic", at the moment, but this could be changed in the source code. The user types in a number for the subject or subjects he/she desires and presses [ENTER]. Pressing [ENTER] with no entry quits the program.

After that, the user is asked what year of creation or release for the media sought, starting with 2013. Again, this could be modified in the source code. Type in the menu choice for the year, not the year itself LOL, and press [ENTER]. Press [ENTER] without entry at this point to leave the program.

This program then launches the web browser with the address fabricated from the data it was given.

Code: (Select All)

'by mnrvovrfc 6-July-2023
OPTION _EXPLICIT

DIM AS INTEGER c, lsubj, j, plu
DIM prefx$, afile$, launchprog$, comd$, asubj$, ayear$, entry$
DIM fe AS LONG

prefx$ = "helparchorg-"
afile$ = prefx$ + "browser.txt"
IF NOT _FILEEXISTS(afile$) THEN
PRINT "The web browser wasn't found! Aborting."
END
END IF

fe = FREEFILE
OPEN afile$ FOR INPUT AS fe
DO UNTIL EOF(fe)
LINE INPUT #fe, entry$
entry$ = _TRIM$(entry$)
IF entry$ <> "" AND launchprog$ = "" THEN
launchprog$ = entry$
EXIT DO
END IF
LOOP
CLOSE fe

IF NOT _FILEEXISTS(launchprog$) THEN
PRINT "The web browser wasn't found! Aborting."
END
END IF

PRINT "Discovered web browser executable called:"
PRINT launchprog$

afile$ = prefx$ + "subject.txt"
IF NOT _FILEEXISTS(afile$) THEN
afile$ = prefx$ + "category.txt"
END IF
IF _FILEEXISTS(afile$) THEN
fe = FREEFILE
OPEN afile$ FOR INPUT AS fe
DO UNTIL EOF(fe)
LINE INPUT #fe, entry$
entry$ = _TRIM$(entry$)
IF entry$ <> "" THEN lsubj = lsubj + 1
LOOP
CLOSE fe
IF lsubj < 1 THEN
PRINT "At least one entry required from input file!"
END
END IF
REDIM subj(1 TO lsubj) AS STRING
c = 0
fe = FREEFILE
OPEN afile$ FOR INPUT AS fe
DO UNTIL EOF(fe)
LINE INPUT #fe, entry$
entry$ = _TRIM$(entry$)
IF entry$ <> "" THEN
c = c + 1
subj(c) = entry$
END IF
LOOP
CLOSE fe
ELSE
lsubj = 1
REDIM subj(1 TO lsubj) AS STRING
subj(lsubj) = "electronic"
END IF

PRINT "*** archive-dot-org helper ***"
IF lsubj = 1 THEN
PRINT: PRINT "There's only one category available: "; subj(1)
asubj$ = subj(1)
ELSE
PRINT: PRINT "Please choose your category."
FOR j = 1 TO lsubj
PRINT USING "(##)"; j;
PRINT " "; subj(j)
NEXT
LINE INPUT entry$
entry$ = _TRIM$(entry$)
IF entry$ = "" THEN SYSTEM
c = VAL(entry$)
IF c > 0 AND c <= lsubj THEN
asubj$ = subj(c)
ELSE
PRINT "Incorrect input given! Aborting."
END
END IF
END IF

PRINT: PRINT "Please choose the year of release."
FOR j = 2013 TO 2023
PRINT USING "(####)"; j - 2012;
PRINT " "; j
NEXT
LINE INPUT entry$
entry$ = _TRIM$(entry$)
IF entry$ = "" THEN SYSTEM
c = VAL(entry$)
IF c > 0 AND c < 12 THEN
ayear$ = _TRIM$(STR$(c + 2012))
ELSE
PRINT "Incorrect input given! Aborting."
END
END IF

comd$ = launchprog$ + " 'https://archive.org/details/audio?and[]=year%3A%22" + ayear$ + _
"%22&and[]=mediatype%3A%22audio%22&and[]=subject%3A%22"
plu = INSTR(asubj$, "+")
IF plu > 0 THEN
comd$ = comd$ + LEFT$(asubj$, plu - 1) + "%22&and[]=subject%3A%22" + MID$(asubj$, plu + 1) + "%22'"
ELSE
comd$ = comd$ + asubj$ + "%22'"
END IF
SHELL _HIDE _DONTWAIT comd$
SYSTEM

For this program as it stands, try this as "helparchorg-category.txt":
Code: (Select All)
electronic
podcast
Popular Music+Jazz

Print this item

  Auto reload program upon RUN
Posted by: Cobalt - 07-06-2023, 08:58 PM - Forum: Help Me! - Replies (2)

Anybody have any clever ideas on how one would get the IDE to reload a program when it was run? The program in question actually updates  itself when it runs, and I was just wondering if there was a way to get the ide to reload the code so I wouldn't forget to reload it and go change some code save it and destroy the changes the program made last time it ran.

Print this item

  Calculating Anti-Primes
Posted by: Space_Ghost - 07-06-2023, 06:56 PM - Forum: Works in Progress - Replies (17)

Can this be sped up?   The code below calculates the first 45 anti-primes in ~6.3 seconds on my W11 PC. 
Definition of anti-primes: A natural number that has more divisors (factors, not just prime factors) than any number less that it. For example, 6 has 4 factors, including 1 and itself, and this is more than 1,2,3 or 5 which have only the minimum of 2 factors and 4 which has 3 factors.

Code: (Select All)

'Anti-Primes: Calculate first 45 anti-primes
'date of code: 06 JUL 2023
'Space Ghost (modified QBasic 4.5 from Rosetta Code)

'HOUSEKEEPING -----------------------------------
$CONSOLE:ONLY
OPTION _EXPLICIT
CLS

'VARIABLE DECLARATIONS  -------------------------
DIM t AS DOUBLE
DIM tmp AS STRING
DIM AS INTEGER MaxAntiPrime, AntiPrimeCount
DIM AS LONG MaxDivisors, Divisors, n

'MAIN BLOCK  ------------------------------------
t = TIMER(0.001)

MaxAntiPrime = 45
n = 0
MaxDivisors = 0
AntiPrimeCount = 0

PRINT "The first 45 anti-primes are:"
PRINT

WHILE AntiPrimeCount < MaxAntiPrime
    n = n + 1
    Divisors = DivisorCount(n)
    IF Divisors > MaxDivisors THEN
        PRINT n;
        MaxDivisors = Divisors
        AntiPrimeCount = AntiPrimeCount + 1
    END IF
WEND

PRINT: PRINT
tmp = "Execution Time in secs:##.###"
PRINT USING tmp; TIMER(0.001) - t

END

'FUNCTIONS AND SUBROUTINES ----------------------
FUNCTION DivisorCount (v)
    DIM AS LONG total, count, n, p
    total = 1
    n = v
    WHILE n MOD 2 = 0
        total = total + 1
        n = n \ 2
    WEND
    p = 3
    WHILE (p * p) <= n
        count = 1
        WHILE n MOD p = 0
            count = count + 1
            n = n \ p
        WEND
        p = p + 2
        total = total * count
    WEND
    IF n > 1 THEN total = total * 2
    DivisorCount = total
END FUNCTION

'END OF PROGRAM  --------------------------------

CONSOLE OUTPUT
The first 45 anti-primes are: 1  2  4  6  12  24  36  48  60  120  180  240  360  720  840  1260  1680  2520  5040  7560  10080  15120  20160  25200  27720  45360  50400  55440  83160  110880  166320  221760  277200  332640  498960  554400  665280  720720  1081080  1441440  2162160  2882880  3603600  4324320  6486480

Execution Time in secs: 6.334

Print this item

  help moving a sprite in a ellipse
Posted by: Cobalt - 07-06-2023, 12:21 AM - Forum: Help Me! - Replies (8)

Can somebody help me figure out the code to get a sprite to follow an ellipse? I've tried various methods with SIN() but can't quite pull it off, I am trying to recreate the effect in the attached gif


[Image: Bounder-Tower.gif]

Print this item

  Boring plot of 5000 functions!
Posted by: mnrvovrfc - 07-05-2023, 10:38 PM - Forum: Works in Progress - Replies (4)

This is another program that would only display graphic silliness. Don't expected colored, fractal stuff; a program such as this might have been attempted with QuickBASIC or Turbo Pascal, trying to burn those weak single-core CPU's to a crisp. Many pictures are just an useless line at the top or at the side of the screen. Others are just near-diagonal lines. Others are "steps" as if trying to plot binary or something else. But there are a few good ones here.

The program tries to plot a function with 500 points of Cartesian coordinates taking part in a polar scheme. If the function is not plottable, it's skipped. The "Illegal function call" had to be trapped for it. The functions were fabricated from another QB64 program I wrote. Don't spend too much time looking at them or it will cause some loss of sanity!

Press [ESC] to quit, or on Linux leave it for long enough and then it seg-faults, I don't know why. (shrugs)

At the terminal command line it's possible to follow the executable file's name with an integer from 1 to 5000, to start from the function indicated by the huge "SELECT CASE... END SELECT" block. This has nothing to do with random numbers. It was already taken care of by my "extreme function maker" LOL.

That is the first parameter. There is a second parameter which is a float-type factor. The default is to just plot a circle with X,Y for 500 points. The circle is always created by this program with a "radius" of 2. The factor in this program can only cause the effect of an open shape. In other words, the chosen factor by the user cannot be smaller than the default value of 1.3888.

The actual program is too big to post into this forum, so I'm posting only a portion of it. Otherwise you will have to download the attachment. Smile

Code: (Select All)

'by mnrvovrfc 06-Jun-2023
option _explicit
dim v(1 to 500) as double
dim as double n, x, y, z, mult, factdiv, smaller, largger
dim as integer i, j, cn
dim redu$

if command$(1) = "" then
cn = 1
else
cn = val(command$(1))
if cn = 0 then
cn = 1
elseif cn < 1 or cn > 5000 then
cn = 1
end if
end if
if command$(2) = "" then
mult = 1.3888
else
mult = val(command$(1))
if mult < 1.3888 or mult > 5.0 then
mult = 1.3888
end if
end if

screen _newimage(1000, 500, 12)

for i = cn to 5000
on error goto 100
for z = 1 to 500
x = 2 * cos(_d2r(z / mult))
y = 2 * sin(_d2r(z / mult))
select case i
case 1
n = Z10B46#(x, y, z)
case 2
n = Z10B48#(x, y, z)
case 3
n = Z10B4A#(x, y, z)
case 4
n = Z10B4C#(x, y, z)
case 5
n = Z10B4E#(x, y, z)
case 6
n = Z10B50#(x, y, z)
case 7
n = Z10B52#(x, y, z)
case 8
n = Z10B54#(x, y, z)
case 9
n = Z10B56#(x, y, z)
case 10
n = Z10B58#(x, y, z)
' :
' :
case 4990
n = Z13240#(x, y, z)
case 4991
n = Z13242#(x, y, z)
case 4992
n = Z13244#(x, y, z)
case 4993
n = Z13246#(x, y, z)
case 4994
n = Z13248#(x, y, z)
case 4995
n = Z1324A#(x, y, z)
case 4996
n = Z1324C#(x, y, z)
case 4997
n = Z1324E#(x, y, z)
case 4998
n = Z13250#(x, y, z)
case 4999
n = Z13252#(x, y, z)
case 5000
n = Z13254#(x, y, z)
end select
endoflongcase:
v(z) = n
next

on error goto 0

smaller = 0
largger = 0
for z = 1 to 500
if v(z) < smaller then smaller = v(z)
if v(z) > largger then largger = v(z)
next

if int(smaller * 1e+6) = 0 and int(largger * 1e+6) = 0 then
cls
_continue
end if

redu$ = ""
if abs(smaller) > abs(largger) then factdiv = abs(smaller) else factdiv = abs(largger)
do while factdiv > 1e+6
redu$ = "*"
smaller = smaller / 100
largger = largger / 100
if abs(smaller) > abs(largger) then factdiv = abs(smaller) else factdiv = abs(largger)
loop

_title _trim$(str$(i)) + ": " + redu$ + "Smaller =" + str$(smaller) + "| " + redu$ + "Larger =" + str$(largger)
window screen(smaller, 1)-(largger, 500)

doscreen:
pset(v(1), 1), 15
for z = 2 to 500
line -(v(z), z), 15
next

for j = 1 to 30
_delay 0.1
if _keydown(27) then exit for
next

cls
if _keydown(27) then exit for
next
system

100 n = 0
resume endoflongcase
' :
' :
'then what follows are the functions to plot graphs with.


.zip   forceq-graph.bas.zip (Size: 125.59 KB / Downloads: 68)

Print this item

  BAM: New version:Program Tags and New Program Defaults
Posted by: CharlieJV - 07-05-2023, 12:39 AM - Forum: QBJS, BAM, and Other BASICs - Replies (2)

https://basicanywheremachine-news.blogsp...s-and.html

Print this item

  Fireworks!
Posted by: Dustinian - 07-04-2023, 05:27 PM - Forum: Programs - Replies (13)

This is a fireworks program I've been working on for some time; finally polished it up today in honor of the 4th. Very open to feedback!

Code: (Select All)
'FIREWORK.BAS
'============

'DESCRIPTION
'-----------
'   A fireworks screensaver for QBasic.

'AUTHOR
'------
'   Dustinian Camburides

'PLATFORM
'--------
'   Written in QB64. I hope to make it QBasic-compatible, but no work on that yet.

'VERSION
'-------
'1.0, 2022-09-08: First working version.
'1.1, 2023-07-04: Changed hues by month.

'META
'----
'$DYNAMIC

'USER-DEFINED TYPES
'------------------
TYPE Particle
    X0 AS SINGLE 'Current X value of particle (current frame) (used to draw flare point).
    Y0 AS SINGLE 'Current Y value of particle (current frame) (used to draw flare point).
    X1 AS SINGLE 'Previous X value of particle (last frame) (used to draw bright trail).
    Y1 AS SINGLE 'Previous Y value of particle (last frame) (used to draw bright trail).
    X2 AS SINGLE 'Previous X value of particle (frame before last) (used to draw dim trail).
    Y2 AS SINGLE 'Previous Y value of particle (frame before last) (used to draw dim trail).
    Angle AS SINGLE 'Trajectory of particle (degrees).
    Velocity AS SINGLE 'Velocity of particle (pixels per frame).
    Stage AS INTEGER 'Stage of particle (a particle with one or more stages left will "burst" when the fuse is 0).
    Hue AS INTEGER 'The hue of the particle (this the bright color, the program assumes that (Hue MINUS 8) is the dim color).
    Fuse AS INTEGER 'The number of frames left before the particle bursts or burns out.
END TYPE
TYPE Hue
    Brighter AS INTEGER
    Dimmer AS INTEGER
END TYPE

'SUBS
'----
DECLARE SUB Initialize_Hues (Hues() AS Hue)
DECLARE SUB Remove_Particle (Particles() AS Particle, ID AS INTEGER)
DECLARE SUB Append_Particle (Particles() AS Particle, New_Particle AS Particle)
DECLARE SUB Particle_Burst (Current AS Particle, Past AS Particle)
DECLARE SUB Particle_Move (Current AS Particle)
DECLARE SUB Particle_Draw (Current AS Particle, Hues() AS Hue)
DECLARE FUNCTION NewX! (X AS SINGLE, Angle AS SINGLE, Distance AS SINGLE)
DECLARE FUNCTION NewY! (Y AS SINGLE, Angle AS SINGLE, Distance AS SINGLE)
DECLARE FUNCTION RandomBetween% (Minimum AS INTEGER, Maximum AS INTEGER)

'CONSTANTS
'---------
CONST X_MIN = 250 'Minimum X value of firework launch point.
CONST X_MAX = 425 'Maximum X value of firework launch point.
CONST Y_MIN = 350 'Minimum Y value of firework launch point.
CONST Y_MAX = 350 'Maximum Y value of firework launch point.
CONST ANGLE_MIN = 135 'Mimimum angle of firework launch (degrees) (MINUS 180).
CONST ANGLE_MAX = 225 'Maximum angle of firework launch (degrees) (MINUS 180).
CONST VELOCITY_MIN = 5 'Minimum velocity of firework launch (pixels per frame).
CONST VELOCITY_MAX = 12 'Maximum velocity of firework launch (pixels per frame).
CONST STAGE_MIN = 1 'Minimum stages of firework at launch (will burst until 0).
CONST STAGE_MAX = 2 'Maximum stages of firework at launch (will burst until 0).
CONST FUSE_MIN = 20 'Minimum frames the firework will last until the next stage.
CONST FUSE_MAX = 30 'Maximum frames the firework will last until the next stage.
CONST BURST_MIN = 15 'Minimum number of particles that will be produced by a burst.
CONST BURST_MAX = 25 'Maximum number of particles that will be produced by a burst.
CONST DELAY = .04 'The number of seconds between snowflake recalculation / re-draw... QBasic can't detect less than 0.04 seconds...
CONST NEWFIREWORKODDS = 11 'The odds a new firework will be launched.

'VARIABLES
'---------
DIM sngStart AS SINGLE 'The timer at the start of the delay loop.
DIM intParticle AS INTEGER 'The current particle being worked in the loop.
DIM intChildParticles AS INTEGER 'The number of child particles being created after a burst.
DIM intChildParticle AS INTEGER 'The current child particle being worked in the loop.
DIM Fireworks(0) AS Particle 'All of the particles in the fireworks show.
DIM New_Particle AS Particle 'The new particle being created at launch.
DIM Hues(0) AS Hue 'An array of brighter / dimmer firework hues.

'PROCEDURES
'----------

'INITIALIZE SCREEN: Set the screen to mode 9.
'Active page (where the cls, pset, and line commands occur) of 0 and a v
'Visible page (that the user sees) of 1.
'640 X 350
SCREEN 9, , 0, 1: CLS

'INITIALIZE HUES
CALL Initialize_Hues(Hues())

'INITIALIZE TIMER
TIMER ON: RANDOMIZE TIMER

'LOOP EVERY FRAME
WHILE INKEY$ = ""
    'Reset current particle...
    intParticle = LBOUND(Fireworks)
    'Start timer...
    sngStart = TIMER
    'If we generate a random number within the new firework odds...
    IF RandomBetween%(1, 100) <= NEWFIREWORKODDS THEN
        'Launch a new firework...
        New_Particle.X0 = RandomBetween%(X_MIN, X_MAX)
        New_Particle.Y0 = RandomBetween%(Y_MIN, Y_MAX)
        New_Particle.X1 = New_Particle.X0
        New_Particle.Y1 = New_Particle.Y0
        New_Particle.X2 = New_Particle.X0
        New_Particle.Y2 = New_Particle.Y0
        New_Particle.Angle = RandomBetween%(ANGLE_MIN, ANGLE_MAX) - 180
        New_Particle.Velocity = RandomBetween%(VELOCITY_MIN, VELOCITY_MAX)
        New_Particle.Stage = RandomBetween(STAGE_MIN, STAGE_MAX)
        New_Particle.Hue = RandomBetween(LBOUND(Hues), UBOUND(Hues))
        New_Particle.Fuse = RandomBetween(FUSE_MIN, FUSE_MAX)
        CALL Append_Particle(Fireworks(), New_Particle)
    END IF
    'For each particle...
    WHILE intParticle <= UBOUND(Fireworks)
        'If the fuse is zero...
        IF Fireworks(intParticle).Fuse = 0 AND Fireworks(intParticle).Stage > 0 THEN
            'Burst the particle...
            intChildParticles = RandomBetween%(BURST_MIN, BURST_MAX)
            FOR intChildParticle = 0 TO intChildParticles
                CALL Particle_Burst(New_Particle, Fireworks(intParticle))
                CALL Append_Particle(Fireworks(), New_Particle)
            NEXT intChildParticle
        END IF
        'If the fuse is > -2...
        IF Fireworks(intParticle).Fuse > -2 THEN
            'Draw the particle...
            CALL Particle_Move(Fireworks(intParticle))
            CALL Particle_Draw(Fireworks(intParticle), Hues())
            'MAYBE ONLY INCREMENT PARTICLES HERE?
            intParticle = intParticle + 1 'WE'RE SKIPPING FRAMES SOMETIMES HERE...
        ELSE
            CALL Remove_Particle(Fireworks(), intParticle)
        END IF
    WEND
    'Wait for the delay to pass before starting over...
    WHILE (TIMER < (sngStart + DELAY)) AND (TIMER >= sngStart)
    WEND
    'Copy the active page (where we just drew the snow) to the visible page...
    PCOPY 0, 1
    'Clear the active page for the next frame...
    CLS
WEND
TIMER OFF
PCOPY 0, 1
END

SUB Initialize_Hues (Hues() AS Hue)
    'Sets the hues by month using the default 16-color palette.
    SELECT CASE VAL(LEFT$(DATE$, 2))
        CASE 2 'February
            'Pink and White
            REDIM Hues(1) AS Hue
            Hues(0).Brighter = 13: Hues(0).Dimmer = 5
            Hues(1).Brighter = 15: Hues(1).Dimmer = 7
        CASE 3 'March
            'Green and White
            REDIM Hues(1) AS Hue
            Hues(0).Brighter = 10: Hues(0).Dimmer = 2
            Hues(1).Brighter = 15: Hues(1).Dimmer = 7
        CASE 7 'July
            'Red, White, and Blue
            REDIM Hues(2) AS Hue
            Hues(0).Brighter = 12: Hues(0).Dimmer = 4
            Hues(1).Brighter = 15: Hues(1).Dimmer = 7
            Hues(2).Brighter = 9: Hues(2).Dimmer = 1
        CASE 12 'December
            'Red and Green
            REDIM Hues(1) AS Hue
            Hues(0).Brighter = 12: Hues(0).Dimmer = 4
            Hues(1).Brighter = 10: Hues(1).Dimmer = 2
        CASE ELSE
            'All colors 9-15
            REDIM Hues(6) AS Hue
            Hues(0).Brighter = 9: Hues(0).Dimmer = 1
            Hues(1).Brighter = 10: Hues(1).Dimmer = 2
            Hues(2).Brighter = 11: Hues(2).Dimmer = 3
            Hues(3).Brighter = 12: Hues(3).Dimmer = 4
            Hues(4).Brighter = 13: Hues(4).Dimmer = 5
            Hues(5).Brighter = 14: Hues(5).Dimmer = 6
            Hues(6).Brighter = 15: Hues(6).Dimmer = 7
    END SELECT
END SUB

SUB Remove_Particle (Particles() AS Particle, ID AS INTEGER)
    'Note: This would be a lot easier with PRESERVE, but I want to be QB1.1/4.5 compatible... one day.
    DIM intMember AS INTEGER
    'Create a place to save the data...
    DIM Temp(LBOUND(Particles) TO UBOUND(Particles) - 1) AS Particle
    'Save the data before the ID...
    FOR intMember = LBOUND(Particles) TO ID - 1
        Temp(intMember) = Particles(intMember)
    NEXT intMember
    'Save the data after the ID...
    FOR intMember = ID + 1 TO UBOUND(Particles)
        Temp(intMember - 1) = Particles(intMember)
    NEXT intMember
    'Re-create the array with one less row...
    REDIM Particles(LBOUND(Temp) TO UBOUND(Temp)) AS Particle
    'Re-load the saved data back into the original array...
    FOR intMember = LBOUND(TEMP) TO UBOUND(Temp)
        Particles(intMember) = Temp(intMember)
    NEXT intMember
END SUB

SUB Append_Particle (Particles() AS Particle, New_Particle AS Particle)
    'Note: This would be a lot easier with PRESERVE, but I want to be QB1.1/4.5 compatible... one day.
    DIM intMember AS INTEGER
    'Create a place to save the data...
    DIM Temp(LBOUND(Particles) TO UBOUND(Particles)) AS Particle
    'Save the data...
    FOR intMember = LBOUND(Particles) TO UBOUND(Particles)
        Temp(intMember) = Particles(intMember)
    NEXT intMember
    'Re-create the array with one additional row...
    REDIM Particles(LBOUND(Temp) TO UBOUND(Temp) + 1) AS Particle
    'Re-load the saved data back into the original array...
    FOR intMember = LBOUND(TEMP) TO UBOUND(Temp)
        Particles(intMember) = Temp(intMember)
    NEXT intMember
    'Put the new particle at the end...
    Particles(UBOUND(Particles)) = New_Particle
END SUB

SUB Particle_Burst (Current AS Particle, Past AS Particle)
    'Basically set the child particle (after the burst) to the properties of its parent.
    Current.X0 = Past.X0
    Current.Y0 = Past.Y0
    Current.X1 = Past.X0
    Current.Y1 = Past.Y0
    Current.X2 = Past.X0
    Current.Y2 = Past.Y0
    Current.Angle = RandomBetween%(0, 359)
    Current.Velocity = RandomBetween%(2, 4)
    Current.Stage = Past.Stage - 1
    Current.Hue = Past.Hue
    Current.Fuse = RandomBetween(10, 20)
END SUB

SUB Particle_Move (Current AS Particle)
    'Move the tail forward.
    Current.X2 = Current.X1
    Current.X1 = Current.X0
    Current.Y2 = Current.Y1
    Current.Y1 = Current.Y0
    'Move the particle along its current trajectory.
    IF Current.Fuse > 0 THEN
        Current.X0 = NewX!(Current.X0, Current.Angle, Current.Velocity)
        Current.Y0 = NewY!(Current.Y0, Current.Angle, Current.Velocity)
    END IF
    'Burn Fuse
    Current.Fuse = Current.Fuse - 1
END SUB

SUB Particle_Draw (Current AS Particle, Hues() AS Hue)
    'Draw oldest segment
    LINE (Current.X2, Current.Y2)-(Current.X1, Current.Y1), Hues(Current.Hue).Dimmer
    'If the fuse hasn't been burnt out for more than one turn...
    IF Current.Fuse > -1 THEN
        'Draw newest segment
        LINE (Current.X1, Current.Y1)-(Current.X0, Current.Y0), Hues(Current.Hue).Brighter
        'If the fuse isn't burnt out...
        IF Current.Fuse > 0 THEN
            'Draw flare
            PSET (Current.X0, Current.Y0), 15
        END IF
    END IF
END SUB

FUNCTION NewX! (X AS SINGLE, Angle AS SINGLE, Distance AS SINGLE)
    NewX! = X + SIN(Angle * 3.141592 / 180) * Distance
END FUNCTION

FUNCTION NewY! (Y AS SINGLE, Angle AS SINGLE, Distance AS SINGLE)
    NewY = Y! + ((COS(Angle! * 3.141592 / 180) * Distance!) * -1)
END FUNCTION

FUNCTION RandomBetween% (Minimum AS INTEGER, Maximum AS INTEGER)
    RandomBetween% = CINT(Minimum + (RND * (Maximum - Minimum)))
END FUNCTION

Print this item

Question How to read Google Calendar events?
Posted by: Ikerkaz - 07-04-2023, 06:49 AM - Forum: Help Me! - Replies (10)

Hi to all  Cool

I am trying to make a basic calendar program, in order to show my future calendar events.
I would like to READ my Google Calendar and show events on screen (only read, it is not necessary to write new events), and I have no idea on how to make it.

Do you know if it is possible with QB64PE Huh ?

Thank you very much!!!   Heart

Print this item