You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


QB64 Spiro-Roses
06-15-2014, 02:59 AM (This post was last modified: 07-05-2014 07:12 PM by Waltersmind.)
Post: #1
 (Print Post)
QB64 Spiro-Roses
Here's a little cool gem that draws interesting shapes:

Code Snippet: [Select]
DIM SHARED PI AS _FLOAT
DIM SHARED Degrees AS _FLOAT
DIM SHARED ScreenWidth AS _UNSIGNED INTEGER
DIM SHARED ScreenHeight AS _UNSIGNED INTEGER
DIM Colr AS _UNSIGNED LONG

ScreenWidth = 800
ScreenHeight = 600

SCREEN _NEWIMAGE(ScreenWidth, ScreenHeight, 32)

PI = 3.141592654
Degrees = PI / 180
DO
   _LIMIT 30
   LINE (0, 0)-(ScreenWidth - 1, ScreenHeight - 1), _RGBA(0, 0, 0, 50), BF

   FOR iteration = 0 TO 0

       CenterX = RND * ScreenWidth
       CenterY = RND * ScreenHeight
       Colr = _RGB(RND * 256, RND * 256, RND * 256)

       Design = INT(RND * 10)

       SELECT CASE Design
           CASE 0
               Radius = RND * 150 + 50
               RosesAreRed CenterX, CenterY, Radius, Colr
           CASE 1
               Radius = RND * 30 + 20
               Shape1 CenterX, CenterY, Radius, Colr
           CASE 2
               Radius = RND * 600 + 100
               Shape2 CenterX, CenterY, Radius, Colr
           CASE 3
               Radius = RND * 70 + 10
               Shape3 CenterX, CenterY, Radius, Colr
           CASE 4
               Radius = RND * 50 + 50
               Shape4 CenterX, CenterY, Radius, Colr
           CASE 5
               Radius = RND * 50 + 50
               Shape5 CenterX, CenterY, Radius, Colr
           CASE 6
               Radius = RND * 80 + 20
               Shape6 CenterX, CenterY, Radius, Colr
           CASE 7
               Radius = RND * 200 + 50
               Shape7 CenterX, CenterY, Radius, Colr
           CASE 8
               Radius = RND * 100 + 50
               Shape8 CenterX, CenterY, Radius, Colr
           CASE 9
               Radius = RND * 80 + 30
               Shape9 CenterX, CenterY, Radius, Colr
       END SELECT

   NEXT

   _DISPLAY

LOOP WHILE INKEY$ = ""
SYSTEM

' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB RosesAreRed (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

Petals = INT(RND(1) * 20) + 1
q = INT(RND(1) * 20) + 1
dec = Petals / q

' *** SETUP FIRST POSITION
rad = COS(dec)
x = (rad * Radius) * COS(0)
y = (rad * Radius) * SIN(0)
ox = CenterX + x
oy = CenterY + y

FOR i = 0 TO 360 * q
   rad = COS(dec * (i * Degrees))
   x = (rad * Radius) * COS(i * Degrees)
   y = (rad * Radius) * SIN(i * Degrees)
   LINE (ox, oy)-(CenterX + x, CenterY + y), Colr
   ox = CenterX + x
   oy = CenterY + y
NEXT

END SUB

' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape1 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT
DIM Rad AS _FLOAT

FOR Theta = 0 TO 12 * PI STEP .05

   Rad = COS(Theta) * SIN(Theta / 3) * SIN(Theta / 2) * Radius * (3 + COS(Theta * 6.333))
   xp = CenterX + Rad * COS(Theta)
   yp = CenterY + Rad * SIN(Theta)

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape2 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT
DIM Rad AS _FLOAT
DIM Angle AS _FLOAT

FOR Theta = 0 TO 2 * PI STEP .015

   Rad = -(.5 * SIN(5 * Theta)) * (.5 * COS(4 * Theta)) * Radius '1000
   Angle = Theta + SIN(Rad / 100)
   xp = CenterX + Rad * COS(Angle)
   yp = CenterY + Rad * SIN(Angle)

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape3 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT
DIM Rad AS _FLOAT
DIM Angle AS _FLOAT

FOR Theta = 0 TO 4 * PI STEP .04

   Rad = (1.05 + SIN(Theta * 4.5)) * Radius
   Angle = Theta - COS(Theta * 10) / 10
   xp = CenterX + Rad * COS(Angle)
   yp = CenterY + Rad * SIN(Angle)

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape4 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT
DIM Rad AS _FLOAT

FOR Theta = 0 TO 4 * PI STEP .02

   xp = CenterX + SIN(Theta * 5) * Radius
   yp = CenterY + COS(Theta * 5.5) * Radius

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape5 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT
DIM Rad AS _FLOAT

FOR Theta = 0 TO 2 * PI STEP .02

   xp = CenterX + SIN(Theta * 5) * COS(Theta * 6) * Radius
   yp = CenterY + COS(Theta * 5.5) * SIN(Theta * 6.5) * Radius

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape6 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT

FOR Theta = 0 TO 4 * PI STEP .004

   xp = CenterX + EXP(SIN(Theta * 10)) * Radius - 100
   t = CenterY + EXP(COS(Theta * 9.5)) * Radius - 100
   yp = t + SIN(xp / 20) * 20
   xp = xp + SIN(t / 20) * 20

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape7 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT
DIM nthet AS _FLOAT

FOR Theta = 0 TO 4 * PI STEP .004

   xt = CenterX + SIN(Theta * 10) * Radius
   yt = CenterY + COS(Theta * 9.5) * Radius
   nthet = xt / 30 + yt / 30
   yp = yt + SIN(nthet) * 20
   xp = xt + COS(nthet) * 20

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape8 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT

FOR Theta = 0 TO 160 STEP .06

   xt = SIN(Theta) * Theta * 2 + CenterX
   yt = COS(Theta) * Theta * 2 + CenterY
   nthet = xt / 30 + yt / 30
   othet = xt / 30 - yt / 30
   yp = yt + SIN(nthet) * 15 + SIN(othet) * 15
   xp = xt + COS(nthet) * 15 + COS(othet) * 15

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB


' #################################################################################################
' #                                                                                               #
' #################################################################################################
SUB Shape9 (CenterX AS _UNSIGNED INTEGER, CenterY AS _UNSIGNED INTEGER, Radius AS _UNSIGNED INTEGER, Colr AS LONG)

DIM Theta AS _FLOAT

FOR Theta = 0 TO 40 * PI STEP .04

   rad = (1.4 + SIN(Theta * 3.05)) * Radius
   xt = SIN(Theta) * rad + CenterX
   yt = COS(Theta) * rad + CenterY
   nthet = xt / 20
   othet = yt / 20
   yp = yt + SIN(nthet) * 15
   xp = xt + COS(othet) * 15

   IF Theta = 0 THEN
       PSET (xp, yp), Colr
   ELSE
       LINE -(xp, yp), Colr
   END IF

NEXT Theta

END SUB

I have attached the *.BAS file as well (Same Code).

Here is a screenshot:

   


Attached File(s)
.bas  Waltersmind - Spiro Roses.bas (Size: 9.79 KB / Downloads: 54)

My goal is to bring joy, excitement, fun and education to all computer programming hobbyists, tinkerers, and amateurs. I also enjoy helping and working with those who aspire at becoming masters of their craft.
Find all posts by this user
Like Post
08-21-2017, 08:36 PM
Post: #2
 (Print Post)
RE: QB64 Spiro-Roses
Hi Walter,

This is a great demo

Donald
Find all posts by this user
Like Post
08-22-2017, 12:24 AM
Post: #3
 (Print Post)
RE: QB64 Spiro-Roses
Donald,

This demo is a recreation of one I had originally wrote in Visual Basic 6.0 many years ago. The original demo's name was, "Roses" and had many other shapes. But I lost the code and had to recreate what you see here from memory.


Walter Whitman
The Joyful Programmer

My goal is to bring joy, excitement, fun and education to all computer programming hobbyists, tinkerers, and amateurs. I also enjoy helping and working with those who aspire at becoming masters of their craft.
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Foursight
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Color Triangles
QB64 Member Project - Domain
QB64 Member Project - Quarto
QB64 Member Project - Dakapo
QB64 Member Project - Exit
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Rubix's Magic
QB64 Member Project - ARB Checkers
QB64 Member Project - Dreamy Clock
QB64 Member Project - Basic Dithering
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Isolation
QB64 Member Project - Touche
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Splatter
QB64 Member Project - Inside Moves
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Kings Court
QB64 Member Project - Algeria Weather
QB64 Member Project - Pivot version two
QB64 Member Project - Rotating Background
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Sabotage
QB64 Member Project - Input
QB64 Member Project - Spiro Roses
QB64 Member Project - Score 4
QB64 Member Project - Overboard
QB64 Member Project - Blokus
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Point Blank
QB64 Member Project - Color Rotating Text
QB64 Member Project - 9 Board
QB64 Member Project - Connect Four
QB64 Member Project - Othello
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Pivet version one
QB64 Member Project - Swirl
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Amazon
QB64 Member Project - Qubic
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Bowditch curve
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Line Thickness