Sierpinski Triangle in QB64PE (and others)

Sierpinski Triangle in QB64PE (and others) - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Sierpinski Triangle in QB64PE (and others) (/showthread.php?tid=3446)

Pages: 1 2

RE: Sierpinski Triangle in QB64PE (and others) - SMcNeill - 02-06-2025

Code: (Select All)

_Title "Fractal Squares in QB64PE"

Screen _NewImage(640, 480, 32)

Dim Shared maxDepth

For maxDepth = 0 To 8

    Cls , &HFF000000&&

    drawSquare 220, 140, 200, 0 'center the initial square

    _Display

    _Delay 2

Next

System



Sub drawSquare (x, y, size, depth)

    If depth > maxDepth Then Exit Sub

    ' Draw the current square

    Line (x, y)-(x + size, y + size), , B

    ' Calculate new size and new depth

    newSize = size / 2

    newDepth = depth + 1

    ' Recursively draw smaller squares in each corner

    drawSquare x - newSize / 2, y - newSize / 2, newSize, newDepth

    drawSquare x + size - newSize / 2, y - newSize / 2, newSize, newDepth

    drawSquare x - newSize / 2, y + size - newSize / 2, newSize, newDepth

    drawSquare x + size - newSize / 2, y + size - newSize / 2, newSize, newDepth

End Sub

RE: Sierpinski Triangle in QB64PE (and others) - Pete - 02-06-2025

How are you at quadangles? If you can make a square, I'd say you're perfect!

I tried making a quintangle, but it got confiscated by the Pentagon.

Pete Big Grin

RE: Sierpinski Triangle in QB64PE (and others) - SMcNeill - 02-06-2025

And just for fun, here's the same as the above, except instead of squares, you can use images!

Code: (Select All)

_Title "Fractal Pictures in QB64PE"

Screen _NewImage(640, 480, 32)

Dim Shared image As Long

image = _LoadImage(_OpenFileDialog$("Select an image file."), 32)

If image >= -1 Then System 'you chose a bad file.  We're terminating!



Dim Shared maxDepth

For maxDepth = 0 To 8

    Cls , &HFF000000&&

    drawSquare 220, 140, 200, 0 'center the initial square

    _Display

    _Delay 2

Next

System



Sub drawSquare (x, y, size, depth)

    If depth > maxDepth Then Exit Sub

    ' Draw the current square

    'Line (x, y)-(x + size, y + size), , B

    _PutImage (x, y)-(x + size, y + size), image

    ' Calculate new size and new depth

    newSize = size / 2

    newDepth = depth + 1

    ' Recursively draw smaller squares in each corner

    drawSquare x - newSize / 2, y - newSize / 2, newSize, newDepth

    drawSquare x + size - newSize / 2, y - newSize / 2, newSize, newDepth

    drawSquare x - newSize / 2, y + size - newSize / 2, newSize, newDepth

    drawSquare x + size - newSize / 2, y + size - newSize / 2, newSize, newDepth

End Sub

RE: Sierpinski Triangle in QB64PE (and others) - bplus - 02-06-2025

cool!

RE: Sierpinski Triangle in QB64PE (and others) - Pete - 02-06-2025

HELP!!!

I went big and enclosed Steve's program in a loop

For i%%= 1 to 1,000,000,000,000

Now I'm being attacked by a terafractal

Pete Big Grin

(And no the 'P's not silent, which is why the wife insists I close the door).