+- 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: Drawing 20 planets with graphical commands (/showthread.php?tid=4449)
Drawing 20 planets with graphical commands - Delsus - 02-05-2026
Hello team! I thought I would share a bit of fun code with graphical statements, to draw planets randomly. Trying to make it as beautiful as possible.
Code: (Select All)
Screen _NewImage(800, 600, 32)
_Title "20 Beautiful Planets in QB64PE"
Randomize Timer
Type PlanetData
x As Integer
y As Integer
radius As Integer
r As Integer
g As Integer
b As Integer
hasRings As Integer
ringAngle As Single
atmosphere As Integer
spots As Integer
End Type
Dim Shared Planets(1 To 20) As PlanetData
Dim Shared i As Integer
Dim Shared f As Long
f = _LoadFont("Arial.ttf", 16, "MONOSPACE")
If f > 0 Then _Font f
For i = 1 To 20
Planets(i).x = 70 + ((i - 1) Mod 5) * 150
Planets(i).y = 70 + ((i - 1) \ 5) * 120
Planets(i).radius = 20 + Rnd * 25
Planets(i).hasRings = IIf(Rnd > 0.5, -1, 0)
Planets(i).ringAngle = Rnd * _Pi
Planets(i).atmosphere = IIf(Rnd > 0.3, -1, 0)
Planets(i).spots = Int(Rnd * 8) + 2
Select Case i
Case 1: ' Blue gas giant
Planets(i).r = 50: Planets(i).g = 100: Planets(i).b = 200
Case 2: ' Red desert planet
Planets(i).r = 180: Planets(i).g = 80: Planets(i).b = 60
Case 3: ' Green jungle planet
Planets(i).r = 60: Planets(i).g = 150: Planets(i).b = 80
Case 4: ' Purple crystal planet
Planets(i).r = 150: Planets(i).g = 70: Planets(i).b = 200
Case 5: ' Orange lava planet
Planets(i).r = 220: Planets(i).g = 120: Planets(i).b = 40
Case 6: ' Ice planet
Planets(i).r = 200: Planets(i).g = 230: Planets(i).b = 250
Case 7: ' Brown rocky planet
Planets(i).r = 140: Planets(i).g = 110: Planets(i).b = 90
Case 8: ' Pink nebula planet
Planets(i).r = 230: Planets(i).g = 150: Planets(i).b = 200
Case 9: ' Yellow sun-like
Planets(i).r = 240: Planets(i).g = 220: Planets(i).b = 100
Case 10: ' Teal ocean planet
Planets(i).r = 70: Planets(i).g = 180: Planets(i).b = 170
Case 11: ' Maroon volcanic
Planets(i).r = 120: Planets(i).g = 40: Planets(i).b = 50
Case 12: ' Cyan gas giant
Planets(i).r = 80: Planets(i).g = 200: Planets(i).b = 220
Case 13: ' Gold metallic
Planets(i).r = 210: Planets(i).g = 180: Planets(i).b = 80
Case 14: ' Emerald green
Planets(i).r = 40: Planets(i).g = 180: Planets(i).b = 120
Case 15: ' Deep blue
Planets(i).r = 30: Planets(i).g = 70: Planets(i).b = 150
Case 16: ' Rust planet
Planets(i).r = 170: Planets(i).g = 90: Planets(i).b = 70
Case 17: ' Lilac planet
Planets(i).r = 180: Planets(i).g = 140: Planets(i).b = 220
Case 18: ' Turquoise
Planets(i).r = 70: Planets(i).g = 210: Planets(i).b = 190
Case 19: ' Copper
Planets(i).r = 190: Planets(i).g = 130: Planets(i).b = 100
Case 20: ' Violet storm
Planets(i).r = 130: Planets(i).g = 80: Planets(i).b = 180
End Select
Next i
Cls , _RGB32(5, 5, 20)
For i = 1 To 200
PSet (Rnd * 800, Rnd * 600), _RGB32(200 + Rnd * 55, 200 + Rnd * 55, 200 + Rnd * 55)
Next i
For i = 1 To 5
DrawNebula Rnd * 800, Rnd * 600, Int(Rnd * 100) + 50
Next i
For i = 1 To 20
DrawPlanet Planets(i)
Next i
Color _RGB32(180, 180, 255)
_PrintMode _KeepBackground
_PrintString (320, 550), "Press SPACE to regenerate"
_PrintString (350, 570), "Press ESC to exit"
Do
k$ = InKey$
If k$ = " " Then
Randomize Timer
For i = 1 To 20
Planets(i).radius = 20 + Rnd * 25
Planets(i).hasRings = IIf(Rnd > 0.5, -1, 0)
Planets(i).ringAngle = Rnd * _Pi
Planets(i).atmosphere = IIf(Rnd > 0.3, -1, 0)
Planets(i).spots = Int(Rnd * 8) + 2
Next i
Cls , _RGB32(5, 5, 20)
For i = 1 To 200
PSet (Rnd * 800, Rnd * 600), _RGB32(200 + Rnd * 55, 200 + Rnd * 55, 200 + Rnd * 55)
Next i
For i = 1 To 5
DrawNebula Rnd * 800, Rnd * 600, Int(Rnd * 100) + 50
Next i
For i = 1 To 20
DrawPlanet Planets(i)
Next i
Color _RGB32(180, 180, 255)
_PrintString (320, 550), "Press SPACE to regenerate"
_PrintString (350, 570), "Press ESC to exit"
End If
_Limit 30
Loop Until k$ = Chr$(27)
System
Sub DrawPlanet (p As PlanetData)
For r = p.radius To 0 Step -1
intensity = 0.3 + 0.7 * (r / p.radius)
Circle (p.x - 3, p.y - 3), r, _RGB32(p.r * intensity * 0.3, p.g * intensity * 0.3, p.b * intensity * 0.3)
Next r
For r = p.radius To 0 Step -1
intensity = 0.5 + 0.5 * (r / p.radius)
gradient = 0.7 + 0.3 * Sin(r * _Pi / p.radius)
Circle (p.x, p.y), r, _RGB32(p.r * intensity * gradient, p.g * intensity * gradient, p.b * intensity * gradient)
Next r
If p.atmosphere Then
For r = p.radius + 3 To p.radius + 10 Step 1
alpha = 50 - (r - p.radius - 3) * 7
If alpha > 0 Then
Circle (p.x, p.y), r, _RGBA32(p.r, p.g, p.b, alpha)
End If
Next r
End If
If p.hasRings Then
DrawRings p.x, p.y, p.radius, p.ringAngle, p.r, p.g, p.b
End If
DrawSurfaceDetails p.x, p.y, p.radius, p.spots, p.r, p.g, p.b
For r = p.radius \ 3 To 0 Step -1
intensity = 0.8 + 0.2 * (r / (p.radius \ 3))
Circle (p.x - p.radius \ 3, p.y - p.radius \ 3), r, _RGBA32(255, 255, 255, 100 * intensity)
Next r
End Sub
Sub DrawRings (x, y, radius, angle, r, g, b)
For ring = 1 To 3
ringRadius = radius + 15 + ring * 5
ringWidth = 3
For w = -ringWidth To ringWidth
For a = 0 To _Pi(2) Step 0.01
rx = ringRadius * Cos(a)
ry = (ringRadius + w) * Sin(a) * 0.3
rx2 = rx * Cos(angle) - ry * Sin(angle)
ry2 = rx * Sin(angle) + ry * Cos(angle)
distFromCenter = Abs(w) / ringWidth
alpha = 150 * (1 - distFromCenter)
ringColor = _RGBA32(r + 30, g + 30, b + 30, alpha)
PSet (x + rx2, y + ry2), ringColor
Next a
Next w
Next ring
End Sub
Sub DrawSurfaceDetails (x, y, radius, numSpots, baseR, baseG, baseB)
For spot = 1 To numSpots
angle = Rnd * _Pi(2)
distance = Rnd * radius * 0.8
spotX = x + distance * Cos(angle)
spotY = y + distance * Sin(angle)
spotSize = radius * (0.1 + Rnd * 0.2)
spotType = Int(Rnd * 3)
Select Case spotType
Case 0:
spotR = baseR * 0.5
spotG = baseG * 0.5
spotB = baseB * 0.5
Case 1:
spotR = _Min(255, baseR * 1.3)
spotG = _Min(255, baseG * 1.3)
spotB = _Min(255, baseB * 1.3)
Case 2:
spotR = _Min(255, baseG * 1.2)
spotG = _Min(255, baseB * 1.2)
spotB = _Min(255, baseR * 1.2)
End Select
For r = spotSize To 0 Step -1
alpha = 200 * (r / spotSize)
Circle (spotX, spotY), r, _RGBA32(spotR, spotG, spotB, alpha)
Next r
If Rnd > 0.7 Then
craterSize = spotSize * 0.5
Circle (spotX + craterSize * 0.3, spotY + craterSize * 0.3), craterSize, _RGB32(baseR * 0.3, baseG * 0.3, baseB * 0.3)
Circle (spotX + craterSize * 0.2, spotY + craterSize * 0.2), craterSize * 0.7, _RGB32(baseR * 0.7, baseG * 0.7, baseB * 0.7)
End If
Next spot
End Sub
Sub DrawNebula (x, y, size)
For i = 1 To 5
nx = x + (Rnd - 0.5) * size
ny = y + (Rnd - 0.5) * size
ns = size * (0.3 + Rnd * 0.3)
nr = 50 + Rnd * 100
ng = 50 + Rnd * 100
nb = 100 + Rnd * 100
For r = ns To 0 Step -1
alpha = 30 * (r / ns)
Circle (nx, ny), r, _RGBA32(nr, ng, nb, alpha)
Next r
Next i
End Sub
Function IIf% (condition, trueValue, falseValue)
If condition Then
IIf = trueValue
Else
IIf = falseValue
End If
End Function
Let me know what you think!
RE: Drawing 20 planets with graphical commands - Unseen Machine - 02-05-2026
Not bad at all, I like the atmosphere affect especially.
One tweak I could suggest is when you draw your rings the back bits should be obscured by the planets but other than thast, good job! + 1
John
RE: Drawing 20 planets with graphical commands - OldMoses - 02-07-2026
That's a very pleasing graphic to the eye.
Doing ring obscuring is quite a challenge. I added that to my space flight program, but I was using _PUTIMAGE to split the planets in two, then draw one half of the planet, then draw the rings, then draw the other half while switching between _BLEND and _DONTBLEND to get the foreground part of the ring to be translucent. In my case, I wasn't angling my planets, but once you have an image, Rotozoom can tilt it.
RE: Drawing 20 planets with graphical commands - grymmjack - 02-07-2026
This is good thank you for sharing. One thing I would suggest you check into is SVG format, because you can do a LOT with it.
QB64PE has the ability to use vector graphics with SVG format so you could render to raster using it, but also gain all the nice workflow of using procedural SVG to create beautiful planets. You get filled shapes, gradients, opacities, etc.
https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Element
Check out the QB64 PE Manual here on _LOADIMAGE (scroll down to example 4 which shows how to use a string of SVG and then load into an image)
You can use Inkscape to make SVG graphics and reverse engineer them as well:
https://inkscape.org
Not to overwhelm you but here is an example of someone doing a solar system:
https://cloudfour.com/thinks/generating-svg-solar-systems-part-1-setting-the-scene/
Thanks for sharing your program.
You may get more responses / comments if you share a screenshot with your code. It was a small snippet so I just added one for you.
![[Image: Screenshot-20260207-112914.png]](https://i.ibb.co/C5q9RqGz/Screenshot-20260207-112914.png)
RE: Drawing 20 planets with graphical commands - bplus - 02-07-2026
How to draw a ring around a planet with just QB64. Basically draw the back half of the ellipse ring draw the planet then draw the front half of the ellipse ring.
Code: (Select All)
Option _Explicit
_Title "Arc of Ellisps" 'b+ 2021-12-25
Dim sw, sh
sw = 600: sh = 600
Screen _NewImage(sw, sh, 32)
_ScreenMove 300, 200
ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(0), _Pi(1), .25, &HFFAAAAFF
Ring sw / 2, sh / 2, 0, 85, &HFF880088
ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(1), _Pi(1.999), .25, &HFFAAAAFF
Sub Ring (cx, cy, innerRadius, outerRadius, colr~&) ' wont work well with alpha's < 255
Dim r
For r = innerRadius To outerRadius Step .25
Circle (cx, cy), r, colr~&
Next
End Sub
'ra's here go Counter Clockwise from East
Sub ArcRing (cx, cy, innerRadius, outerRadius, raStart, raEnd, colr~&) ' ra's 0 to <2*pi (almost)
Dim r
For r = innerRadius To outerRadius Step .25
Circle (cx, cy), r, colr~&, raStart, raEnd
Next
End Sub
'ra's here go Counter Clockwise from East
Sub ArcRingOfEllipse (cx, cy, innerRadius, outerRadius, raStart, raEnd, aspect, colr~&) ' ra's 0 to <2*pi (almost)
Dim r
For r = innerRadius To outerRadius Step .25
Circle (cx, cy), r, colr~&, raStart, raEnd, aspect
Next
End SubIf you are not familiar with Radians: to convert Degrees to Radians (ra = radian angle 0 to _Pi(2)) use D2R() function. Radians are just another scale system for angle measures and used for all trig functions as opposed to Degrees.
If you want to draw ellipse rings that are transparent, Steve's recent Ellipse.Arc.Ring stuff might work because he is using scan lines that dont overlap. That's what you need for transparencies without overlap (no stripes and you can see whats under the drawing). https://qb64phoenix.com/forum/showthread.php?tid=3691&pid=34131#pid34131
As OldMoses mentioned, you can tilt the ellipsii with Rotozoom (after putting the image like above into a contianer with an image handle eg Image below) x,y is your planet center, scale just use 1 for no shrink nor expanding and degreesRotation the angle to shift the ellipse to.
Code: (Select All)
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)
Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End SubRE: Drawing 20 planets with graphical commands - bplus - 02-07-2026
Oh putting an image into a container you will need to know about _PutImage here is a little tutorial on that:
https://qb64phoenix.com/forum/showthread.php?tid=1119&pid=9825#pid9825
RE: Drawing 20 planets with graphical commands - bplus - 02-07-2026
here is demo adding tilts to the rings using RotoZoom and _PutImage, more advanced graphics commands:
Code: (Select All)
Option _Explicit
_Title "Arc of Ellipse 2 add tilt demo" 'b+ 2021-12-25 tilt added 2026-02-07
Dim sw, sh, img&, x, y, tilt
sw = 600: sh = 600
Screen _NewImage(sw, sh, 32)
_ScreenMove 300, 200
ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(0), _Pi(1), .25, &HFFAAAAFF
Ring sw / 2, sh / 2, 0, 85, &HFF880088
ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(1), _Pi(1.999), .25, &HFFAAAAFF
' copy this image into a container
img& = _NewImage(sw, sh, 32) ' screen sized container
_PutImage , 0, img& ' the easiest use of _PutImage!!!
Cls ' disappear screen image
' now RotoZoom image
tilt = 65
For y = 150 To 450 Step 300
For x = 150 To 450 Step 300
RotoZoom x, y, img&, .25, tilt
tilt = tilt + 65
Next
Next
Sub Ring (cx, cy, innerRadius, outerRadius, colr~&) ' wont work well with alpha's < 255
Dim r
For r = innerRadius To outerRadius Step .25
Circle (cx, cy), r, colr~&
Next
End Sub
'ra's here go Counter Clockwise from East
Sub ArcRing (cx, cy, innerRadius, outerRadius, raStart, raEnd, colr~&) ' ra's 0 to <2*pi (almost)
Dim r
For r = innerRadius To outerRadius Step .25
Circle (cx, cy), r, colr~&, raStart, raEnd
Next
End Sub
'ra's here go Counter Clockwise from East
Sub ArcRingOfEllipse (cx, cy, innerRadius, outerRadius, raStart, raEnd, aspect, colr~&) ' ra's 0 to <2*pi (almost)
Dim r
For r = innerRadius To outerRadius Step .25
Circle (cx, cy), r, colr~&, raStart, raEnd, aspect
Next
End Sub
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)
Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End SubRE: Drawing 20 planets with graphical commands - ahenry3068 - 02-07-2026
Now someone @bplus Needs to take some of these Planets and sprinkle them into the standard "warping Starfield" screen blanker display !
RE: Drawing 20 planets with graphical commands - dbox - 02-08-2026
(02-07-2026, 11:14 PM)ahenry3068 Wrote: Now someone @bplus Needs to take some of these Planets and sprinkle them into the standard "warping Starfield" screen blanker display !Reminds me of this one that vince did:
https://boxgaming.github.io/qbjs-samples/#src=qbjs-starscape.bas
RE: Drawing 20 planets with graphical commands - ahenry3068 - 02-08-2026
(02-08-2026, 12:42 AM)dbox Wrote:(02-07-2026, 11:14 PM)ahenry3068 Wrote: Now someone @bplus Needs to take some of these Planets and sprinkle them into the standard "warping Starfield" screen blanker display !Reminds me of this one that vince did:
https://boxgaming.github.io/qbjs-samples/#src=qbjs-starscape.bas
Very close to what I had in mind !