+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Christmas Code (https://staging.qb64phoenix.com/forumdisplay.php?fid=48)
+---- Thread: Liney Christmas Star (/showthread.php?tid=1286)
Liney Christmas Star - James D Jarvis - 12-16-2022
one of my facebook groups has gone insane with christmas stars and somebody posted a much simpler version of this that I just had to dress up and add options to.
press any key for a new Christmas star
press c to copy the values to the clipboard, if you see one you want to try to use elsewhere (for windows users, edit it out if you can't use the clipboard command)
press <ESC> to quit
Code: (Select All)
' xmas star
' modified from
' https://www.youtube.com/watch?v=vw3k3xkGtIY
'
' press any key for a new star
' press c to copy values to clipboard
'press ESC to quit
Screen _NewImage(800, 600, 32)
_Title "X-Mas Star"
Randomize Timer
Do
Cls
segments = 8 + 2 * (Int(Rnd * 12))
lineop = Int(Rnd * 14)
xorigin = _Width \ 2
yorigin = _Height \ 2
Color 0: Rem color black
r1 = 70 + Int(Rnd * 150)
r2 = r1 / Int(2 + Rnd * 3)
For counter = 0 To segments
If counter Mod 2 = 0 Then
radius = r1
Else
radius = r2
End If
angle = 360 / segments * counter
angle = angle / 360 * 2 * 3.141592654
x = radius * Sin(angle) + xorigin
y = radius * -Cos(angle) + yorigin
Rem PSet (x, y)
Line (x_hold, y_hold)-(x, y)
Select Case lineop
Case 1
Line (xorigin, yorigin)-(x, y)
Case 2
If counter Mod 2 = 0 Then Line (xorigin, yorigin)-(x, y)
Case 3
If counter Mod 2 <> 0 Then Line (xorigin, yorigin)-(x, y)
Case 4
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
Case 5
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (x, y)-(x2, y2)
xh2 = x2
yh2 = y2
Case 6
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
Line (xorigin, yorigin)-(x, y)
Case 7
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
If counter Mod 2 = 0 Then Line (xorigin, yorigin)-(x, y)
Case 8
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
If counter Mod 2 <> 0 Then Line (xorigin, yorigin)-(x, y)
Case 9
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
Case 10
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
Line (xorigin, yorigin)-(x, y)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
Case 11
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
If counter Mod 2 = 0 Then Line (xorigin, yorigin)-(x, y)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
Case 12
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
If counter Mod 2 <> 0 Then Line (xorigin, yorigin)-(x, y)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
End Select
Color _RGB32(100 + Rnd * 155, 100 + Rnd * 155, 100 + Rnd * 155)
x_hold = x
y_hold = y
Next counter
Do
_Limit 30
kk$ = InKey$
Loop Until kk$ <> ""
'comment this part out if you aren't running in windows
'--------------------------------------------
If kk$ = "c" Then
cc$ = "lineop " + Str$(lineop) + ", segments " + Str$(segments) + ", radius1 " + Str$(r1) + ", radius2 " + Str$(r2)
_Clipboard$ = cc$
Locate 1, 1: Print "Values copied to clipboard"
Sleep 1
End If
'--------------------------
Loop Until kk$ = Chr$(27)