Combining old Bonker's Symphony #37 and Bplus Plinko, I came up with this to start the season early:

Option _Explicit

_Title "bplus Plinko Christmas Theme" ' b+ 2024-11-09 messing around with speed and gravity

' from bplus Plinko to Christmas version

Const XMax = 800

Const YMax = 720

Dim Shared BX, BY, BA, BCnt

Dim gravity, br, speed, pR, maxRow, np, pxo, pyo, row, col

Dim pidx, i, r, j, dx, dy, slotSpace, slot, score, backg

Dim slots(11), s$, f32 As Long, f16 As Long

Screen _NewImage(XMax, YMax, 32): _ScreenMove 250, 0

Randomize Timer: _PrintMode _KeepBackground

f32 = _LoadFont("arial.ttf", 32)

f16 = _LoadFont("arial.ttf", 20)

gravity = 2.0: slotSpace = XMax / 12

br = 24: speed = 3.75 'balls  ' speed orig 4.0  4.0 keeps payout for 1000 balls low 300$

pR = 9: maxRow = 11: np = maxRow * (maxRow + 1) * .5 - 3 '   pins

pxo = XMax / (maxRow + 1) 'pin space along x

pyo = YMax / (maxRow + 1) 'pin spacing along y

Dim px(np), py(np), pc(np) As _Unsigned Long

For row = 3 To maxRow

    For col = 1 To row

        pidx = pidx + 1

        px(pidx) = pxo * col + (maxRow - row) * .5 * pxo

        py(pidx) = pyo * row

        pc(pidx) = _RGB32(Rnd * 100 + 155, (pidx Mod 2) * (Rnd * 155 + 100), 0)

    Next

Next

backg = BackImageHandle&: _PutImage , backg, 0: NewBall

While 1

    ' clear top score line

    _PutImage (0, 0)-(_Width, 60), backg, 0, (0, 0)-(_Width, 60)

    ' clear bottom text area

    _PutImage (0, _Height - 45)-(_Width, _Height), backg, 0, (0, _Height - 45)-(_Width, _Height)

    For i = 1 To np '                      draw pins

        FC3 px(i), py(i), pR, pc(i)

        FC3 px(i), py(i), 6, &H88999999

        FC3 px(i), py(i), 2, &H88FFFFFF

    Next

    For j = 1 To np '                      calc collsions

        If Sqr((BX - px(j)) ^ 2 + (BY - py(j)) ^ 2) < br + pR Then

            BA = _Atan2(BY - py(j), BX - px(j))

            FC3 px(j), py(j), pR, &HFF000000

            Sound 120 + (YMax - py(j)) / YMax * 2000, .25

            Exit For

        End If

    Next

    dx = Cos(BA) * speed: dy = Sin(BA) * speed + gravity '  update ball

    BA = _Atan2(dy, dx)

    BX = BX + Cos(BA) * speed: BY = BY + Sin(BA) * speed ' + 2 * Rnd - 1

    If BX < br Or BX > XMax + br Or BY > YMax + br Then

        slot = Int(BX / slotSpace): slots(slot) = slots(slot) + 1

        BCnt = BCnt + 1: NewBall ' Now the time is right to count a ball

    End If

    For r = br To 1 Step -1

        FC3 BX, BY, r, _RGB32(0, 255 - (r / br) * 220, 0)

    Next

    score = 0: Color &HFF990000 '       recalc and display slot counts and score

    For i = 0 To 11

        Select Case i

            Case 0: s$ = "  "

            Case 11: s$ = "  "

            Case 1: score = score + slots(1) * 100: s$ = "x100$"

            Case 10: score = score + slots(10) * 100: s$ = "x100$"

            Case 2: score = score + slots(2) * 10: s$ = "x10$"

            Case 9: score = score + slots(9) * 10: s$ = "x10$"

            Case 3: score = score + slots(3) * 2: s$ = "x2$"

            Case 8: score = score + slots(8) * 2: s$ = "x2$"

            Case 4: score = score + slots(4) * 0: s$ = "x0$"

            Case 7: score = score + slots(7) * 0: s$ = "x0$"

            Case 5: score = score + slots(5) * -1: s$ = "x-1$"

            Case 6: score = score + slots(6) * -1: s$ = "x-1$"

        End Select

        centerText i * slotSpace, (i + 1) * slotSpace, _Height - 30, _Trim$(Str$(slots(i)))

        centerText i * slotSpace, (i + 1) * slotSpace, _Height - 10, s$

    Next

    Color &HFFFFFFFF: s$ = "Balls:" + Str$(BCnt) + "         Score: $" + _Trim$(Str$(score))

    _Font f32: centerText 0, _Width, 35, s$: _Font f16: _Display: _Limit 30

Wend



Sub NewBall ' get ready to drop

    BX = XMax / 2 + 10 * Rnd - 5: BY = 150 - Rnd * 20

    BA = _Pi(.5) + _Pi(2 / 90) * Rnd - _Pi(.9999 / 90)

End Sub



Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' new fill circle

    Dim As Long r2, x, y ' for Option _Explicit

    If r < 1 Then Exit Sub

    Line (cx - r, cy)-(cx + r, cy), clr~&, BF

    r2 = r * r

    Do

        y = y + 1: x = Sqr(r2 - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF

        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF

    Loop Until y = r

End Sub



Sub centerText (x1, x2, midy, s$) '  fit a string between two goal posts x1, and x2

    _PrintString ((x1 + x2) / 2 - _PrintWidth(s$) / 2, midy - _FontHeight(_Font) / 2), s$

End Sub



Function BackImageHandle& ' make background image and return it's handle

    Dim As Long horizon, nStars, i, back, land, cc

    horizon = YMax - 45: nStars = 150 '                                  making the stars

    Dim xstar(nStars), ystar(nStars), rstar(nStars)

    For i = 1 To nStars

        xstar(i) = Rnd * (XMax): ystar(i) = Rnd * horizon

        If i < .80 * nStars Then

            rstar(i) = 1

        ElseIf i < .97 * nStars Then

            rstar(i) = 2

        Else

            rstar(i) = 3

        End If

    Next

    back = _NewImage(_Width, _Height, 32): _Dest back

    For i = 0 To horizon '                 the nite sky

        Line (0, i)-(XMax, i), _RGB32(i / horizon * 70, i / horizon * 22, 60 * (i) / horizon)

    Next

    land = YMax - horizon '                                        the winter snow on ground

    For i = horizon To YMax

        cc = 128 + (i - horizon) / land * 127

        Line (0, i)-(XMax, i), _RGB32(cc, cc, cc)

    Next

    For i = 1 To nStars '                                           paint the sky with stars

        FC3 xstar(i), ystar(i), rstar(i), &HFFEEEEFF

    Next

    BackImageHandle& = back: _Dest 0

End Function

What am I missing in this code?  I've done this before using _CLEARCOLOR, but for some reason it's not working this time.  I must have forgotten how to use it correctly....

I was going to make a scrolling credits over the screen, using a separate screen image of text to scroll over the main display.  Setting the background color of the credits screen as transparent it should work, but I'm not getting there.  Using _CLEARCOLOR.

- Dav

Screen _NewImage(800, 800, 32)

credits& = _NewImage(800, 800, 32)



_Dest credits&

_ClearColor _RGB(0, 0, 0), credits&



'just some sample text for now

For t = 1 To 1000

    Print Rnd;

Next



_Dest 0

For x = 1 To _Width

    For y = 1 To _Height

        PSet (x, y), _RGB(Rnd * 100, Rnd * 100, Rnd * 100)

    Next

Next

back& = _CopyImage(_Display)



y = _Height

Do

    _PutImage (0, 0), back&

    _PutImage (0, y), credits&

    y = y - 10

    _Display

    _Limit 30

Loop Until y < -_Height

click play for a ball and use arrow keys to change amount

https://qbjs.org/?code=dHlwZSBwxAYKICAgI...hpxEcyNwoK

I plan to create a program using many SUB procedures.  Values to change in a sub must be passed or DIM shared.
But which way makes more sense or is more efficient?  Shared it all (variables), shared some variables ?

Questions like these is a big factor to size of program, speed of the program and forgetting to shared a value.
Common sense is out the windows when playing with QB64 code.

Thanks

Hello

can someone tell me why this little program will not work i dont really understand why.

badger

thanks in advance

DECLARE SUB GenerateUniqueNumbers()



DIM numbers(5) AS INTEGER

DIM count AS INTEGER

DIM i AS INTEGER

DIM newNumber AS INTEGER

DIM isDuplicate AS INTEGER



SUB GenerateUniqueNumbers

    count = 0

    DO

        ' Generate a random number between -1 and 71

        newNumber = INT(RND * 73) - 1

        isDuplicate = 0



        ' Check if the number is already in the array

        FOR i = 1 TO count

            IF numbers(i) = newNumber THEN

                isDuplicate = 1

                EXIT FOR

            END IF

        NEXT i



        ' If it's not a duplicate, add it to the array

        IF isDuplicate = 0 THEN

            count = count + 1

            numbers(count) = newNumber

        END IF

    LOOP UNTIL count = 5



    ' Print the selected numbers

    PRINT "The 5 unique numbers are:"

    FOR i = 1 TO 5

        PRINT numbers(i)

    NEXT i

END SUB



' Seed the random number generator

RANDOMIZE TIMER



' Call the subroutine to generate and display the numbers

GenerateUniqueNumbers

I'm trying to use mouse functions to identify points on the screen, but noticed the corsor is displaying about 5 pixels below its actual point. Is this something unique to my system? I know I can compensate with my zone positions, but just curious. Try this:

Hi. I think this might be a useful feature for someone.

inspired by: https://demonstrations.wolfram.com/Findi...Factoring/

NumA = 1000

NumB = 552

E = GreatestCommonDivisor(NumA, NumB)

Print "Greatest Common Divisor for"; NumA; "and"; NumB; " is:"; E

End





Function GreatestCommonDivisor& (A As Long, B As Long)

    If A = 0 And Abs(B) > 0 Then GreatestCommonDivisor& = B: Exit Function

    If B = 0 And Abs(A) > 0 Then GreatestCommonDivisor& = A: Exit Function

    If A = 0 And B = 0 Then GreatestCommonDivisor& = 0: Exit Function

    Dim As Long NrA(0)

    Dim As Long NrB(0)

    Dim As Long i, NrAI, NrBI, NumA, NumB



    NumA = A

    i = 1

    Do Until i >= NumA

        i = i + 1

        If NumA Mod i = 0 Then

            NumA = NumA \ i

            NrA(NrAI) = i

            NrAI = NrAI + 1

            ReDim _Preserve NrA(NrAI) As Long

            i = 1

        End If

    Loop



    NumB = B

    i = 1

    Do Until i >= NumB

        i = i + 1

        If NumB Mod i = 0 Then

            NumB = NumB \ i

            NrB(NrBI) = i

            NrBI = NrBI + 1

            ReDim _Preserve NrB(NrBI) As Long

            i = 1

        End If

    Loop



    Dim Outs(0) As Long

    Do Until ArrA = UBound(NrA) 

        If ArrA > UBound(NrA) Then Exit Do

        NumA = NrA(ArrA)

        ArrB = 0

        Do Until ArrB = UBound(NrB) 

            If ArrB > UBound(NrB) Then Exit Do

            NumB = NrB(ArrB)

            If NumA > 0 And NumB > 0 Then

                If NumA = NumB Then

                    Pass = 1

                    Outs(outI) = NumA

                    outI = outI + 1

                    ReDim _Preserve Outs(outI) As Long

                    NrA(ArrA) = -1 'just rewrite used numbers to wrong values (so the same valid is not used twice)

                    NrB(ArrB) = -1

                    Exit Do

                End If

            End If

            ArrB = ArrB + 1

        Loop

        ArrA = ArrA + 1

    Loop



    If UBound(Outs) > 0 Then

        ReDim _Preserve Outs(UBound(Outs) - 1) As Long

    End If

    Erase NrA

    Erase NrB

    If Pass = 0 Then

        GreatestCommonDivisor& = 1

        Erase Outs

        Exit Function

    End If

    'calculate greatest common divisor

    GCD& = Outs(0)

    For o = 1 To UBound(Outs)

        GCD& = GCD& * Outs(o)

    Next

    Erase Outs

    GreatestCommonDivisor& = GCD&

End Function

Hello Galleon - heard so much about you. All good!

How can I convert this line:

Line (H, V)-(H+ 37, V+ 38), _RGB(200, 200, 200), BF

to set the _RGB colour to a colour in a sub, instead of this fixed colour?  (I'm using a _NewImage 32-bit screen)
Sub Red might contain Color: _RGB(255,0,0)

Hi to all !!!

I will try to explain myself with my limited english ?

I am making a space shooting/strategy game that loads multiple images. I have a main image (ship) and when it is attacked I load two different images in other two layers (shields impact, damages made to the ship). Last thing I do is _PUTIMAGE of these three layers. During the game I use _LOADIMAGE to change the images of these layers, and there are several ships in the game with the same three layers.

I noticed that when I start my game, the Windows task manager shows some RAM used, and as I am playing it this RAM is increasing.

I know the _FREEIMAGE command, but my code is very large and I find very difficult to check when to use it...

Also I noticed that when I execute a _LOADIMAGE command, and some time later I execute this command over the same variable the memory is still increasing. I thought that when using the same variable the RAM occupied was the same... obviously I was wrong

Is there any way to re-use some LONG variable to load several images without having to _FREEIMAGE between every load? I thought to make a SUB that makes a _FREEIMAGE in the variable just before load an image, but it goes wrong a lot of times

Anybody can help me? Thank you !!!