+- 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: Christmas Code (https://qb64phoenix.com/forum/forumdisplay.php?fid=48)
+---- Thread: Xmas Star (/showthread.php?tid=1330)
Xmas Star - bplus - 12-25-2022
Code: (Select All)
_Title "Xmas Star" ' b+ 2022-12-25
Screen _NewImage(500, 500, 32)
star& = _NewImage(500, 500, 32)
XmasStar _Width / 2, _Height / 2, .1 * _Height, .2 * _Height, .45 * _Height, 125
_PutImage , 0, star&
s2& = _NewImage(500, 500, 32)
XmasStar _Width / 2, _Height / 2, .1 * _Height, .2 * _Height, .45 * _Height, 75
_PutImage , 0, s2&
d = 1
Do
Cls
For r = 0 To .45 * _Height Step 1
fcirc _Width / 2, _Height / 2, r, _RGB32(255, 255, 255, 5)
Next
a = a + d * .05
If Abs(a) < .05 Then
If d < 0 Then a = -.05
If d > 0 Then a = .05
End If
If a < -1 Then a = -1: d = 1
If a > 1 Then a = 1: d = -1
If a > 0 Then RotoZoom3 _Width / 2, _Height / 2, star&, a, 1, 0 Else RotoZoom3 _Width / 2, _Height / 2, s2&, a, 1, 0
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub XmasStar (xc, yc, r1, r2, r3, c As _Unsigned Long)
a = _Pi(2 / 16)
For p = 0 To 200
p1 = p / 200
For i = 0 To 15
If i Mod 2 = 1 Then
x1 = xc + p1 * r1 * Cos(i * a): y1 = yc + p1 * r1 * Sin(i * a)
ElseIf i Mod 4 = 0 Then
x1 = xc + p1 * r3 * Cos(i * a): y1 = yc + p1 * r3 * Sin(i * a)
ElseIf i Mod 4 = 2 Then
x1 = xc + p1 * r2 * Cos(i * a): y1 = yc + p1 * r2 * Sin(i * a)
End If
If i > 0 Then Line (lastx, lasty)-(x1, y1), _RGB32(255 - (p1 * 192), 255 - (p1 * 192), c, 60) Else firstx = x1: firsty = y1
lastx = x1: lasty = y1
Next
Line (lastx, lasty)-(firstx, firsty), _RGB32(255 - (p1 * 192), 255 - (p1 * 192), c, 60)
Next
End Sub
Sub RotoZoom3 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, radianRotation As Single) ' 0 at end means no scaling of x or y
Dim px(3) As Single: Dim py(3) As Single
Dim 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(-radianRotation): cosr! = Cos(-radianRotation)
For i& = 0 To 3
x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle _Seamless(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle _Seamless(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End SubRE: Xmas Star - bplus - 01-01-2023
Interesting this is still showing no views until after I make a new post.
RE: Xmas Star - bplus - 12-27-2023
2023 update:
Code: (Select All)
_Title "Xmas Star 2023" ' b+ 2022-12-25 update 2023-12-26
Const a = _Pi(2 / 16)
Screen _NewImage(760, 760, 32)
_ScreenMove 250, -23
rr1 = 100: rr2 = 200: rr3 = 300
rrr1 = 20: rrr2 = 40: rrr3 = 60
xc = 380: yc = 380
XmasStar 370, 370, 100, 200, 300, &HFFFFFFFF
For i = 0 To 15
If i Mod 2 = 1 Then
ElseIf i Mod 4 = 0 Then
x1 = xc + rr3 * Cos(i * a): y1 = yc + rr3 * Sin(i * a)
ElseIf i Mod 4 = 2 Then
x1 = xc + rr2 * Cos(i * a): y1 = yc + rr2 * Sin(i * a)
End If
XmasStar x1, y1, 20, 40, 60, &HFFDDDDFF
For j = 0 To 15
If j Mod 2 = 1 Then
'x1 = xc + rr1 * Cos(j * a): y1 = yc + rr1 * Sin(j * a)
ElseIf j Mod 4 = 0 Then
x2 = x1 + rrr3 * Cos(j * a): y2 = y1 + rrr3 * Sin(j * a)
ElseIf j Mod 4 = 2 Then
x2 = x1 + rrr2 * Cos(j * a): y2 = y1 + rrr2 * Sin(j * a)
End If
XmasStar x2, y2, 6, 12, 18, &HFFFFFFDD
Next
Next
XmasStar 380, 380, 20, 40, 60, &HFFDDDDFF
For j = 0 To 15
If j Mod 2 = 1 Then
'x1 = xc + rr1 * Cos(j * a): y1 = yc + rr1 * Sin(j * a)
ElseIf j Mod 4 = 0 Then
x2 = 380 + rrr3 * Cos(j * a): y2 = 380 + rrr3 * Sin(j * a)
ElseIf j Mod 4 = 2 Then
x2 = 380 + rrr2 * Cos(j * a): y2 = 380 + rrr2 * Sin(j * a)
End If
XmasStar x2, y2, 6, 12, 18, &HFFFFFFDD
Next
Sleep
Sub XmasStar (xc, yc, r1, r2, r3, c As _Unsigned Long)
For p = 0 To 200
p1 = p / 200
For i = 0 To 15
If i Mod 2 = 1 Then
x1 = xc + p1 * r1 * Cos(i * a): y1 = yc + p1 * r1 * Sin(i * a)
ElseIf i Mod 4 = 0 Then
x1 = xc + p1 * r3 * Cos(i * a): y1 = yc + p1 * r3 * Sin(i * a)
ElseIf i Mod 4 = 2 Then
x1 = xc + p1 * r2 * Cos(i * a): y1 = yc + p1 * r2 * Sin(i * a)
End If
If i > 0 Then Line (lastx, lasty)-(x1, y1), c - &HEE000000 Else firstx = x1: firsty = y1
lastx = x1: lasty = y1
Next
Line (lastx, lasty)-(firstx, firsty), c - &HEE000000
Next
End SubRE: Xmas Star - bplus - 12-29-2023
2023 variation that should fit in any Windows Screen:
Code: (Select All)
_Title "Xmas Star 2023" ' b+ 2022-12-25 update 2023-12-26
Dim Shared As Long Xmax, Ymax ' for screen width and height
SetXYMaxAndMove
Print Xmax, Ymax
If Xmax > Ymax Then max = Ymax Else max = Xmax
Const a = _Pi(2 / 16)
rr1 = .1 * max: rr2 = .5 * max: rr3 = .271 * max
rrr1 = .3 * rr1: rrr2 = .3 * rr2: rrr3 = .3 * rr3
xc = Xmax / 2: yc = Ymax / 2
XmasStar xc, yc, rr1, rr2, rr3, &HFFFFFFFF
For i = 0 To 15
If i Mod 2 = 1 Then
ElseIf i Mod 4 = 0 Then
x1 = xc + rr3 * Cos(i * a): y1 = yc + rr3 * Sin(i * a)
ElseIf i Mod 4 = 2 Then
x1 = xc + rr2 * Cos(i * a): y1 = yc + rr2 * Sin(i * a)
End If
XmasStar x1, y1, rrr1, rrr2, rrr3, &HFFDDDDFF
For j = 0 To 15
If j Mod 2 = 1 Then
'x1 = xc + rr1 * Cos(j * a): y1 = yc + rr1 * Sin(j * a)
ElseIf j Mod 4 = 0 Then
x2 = x1 + rrr3 * Cos(j * a): y2 = y1 + rrr3 * Sin(j * a)
ElseIf j Mod 4 = 2 Then
x2 = x1 + rrr2 * Cos(j * a): y2 = y1 + rrr2 * Sin(j * a)
End If
XmasStar x2, y2, .3 * rrr1, .3 * rrr2, .3 * rrr3, &HFFFFFFDD
Next
Next
XmasStar xc, yc, rrr1, rrr2, rrr3, &HFFDDDDFF
For j = 0 To 15
If j Mod 2 = 1 Then
'x1 = xc + rr1 * Cos(j * a): y1 = yc + rr1 * Sin(j * a)
ElseIf j Mod 4 = 0 Then
x2 = xc + rrr3 * Cos(j * a): y2 = yc + rrr3 * Sin(j * a)
ElseIf j Mod 4 = 2 Then
x2 = xc + rrr2 * Cos(j * a): y2 = yc + rrr2 * Sin(j * a)
End If
XmasStar x2, y2, .3 * rrr1, .3 * rrr2, .3 * rrr3, &HFFFFFFDD
Next
Sleep
Sub XmasStar (xc, yc, r1, r2, r3, c As _Unsigned Long)
For p = 0 To 200
p1 = p / 200
For i = 0 To 15
If i Mod 2 = 1 Then
x1 = xc + p1 * r1 * Cos(i * a): y1 = yc + p1 * r1 * Sin(i * a)
ElseIf i Mod 4 = 0 Then
x1 = xc + p1 * r3 * Cos(i * a): y1 = yc + p1 * r3 * Sin(i * a)
ElseIf i Mod 4 = 2 Then
x1 = xc + p1 * r2 * Cos(i * a): y1 = yc + p1 * r2 * Sin(i * a)
End If
If i > 0 Then Line (lastx, lasty)-(x1, y1), c - &HEE000000 Else firstx = x1: firsty = y1
lastx = x1: lasty = y1
Next
Line (lastx, lasty)-(firstx, firsty), c - &HEE000000
Next
End Sub
Sub SetXYMaxAndMove
'''' If you don't have taskbar.h in your QB64pe.exe folder
'''' copy the following, remove single comments in code below,
'''' paste into an editor, and save the file as:
'''' taskbar.h in your QB64PE.exe folder.
'int32 taskbar_height() {
' RECT rect;
' HWND taskBar = FindWindow("Shell_traywnd", NULL);
' if(taskBar && GetWindowRect(taskBar, &rect)) {
' return rect.bottom - rect.top;
' }
'}
'int32 taskbar_width() {
' RECT rect;
' HWND taskBar = FindWindow("Shell_traywnd", NULL);
' if (taskBar && GetWindowRect(taskBar, &rect)) {
' return rect.right - rect.left;
' }
'}
'int32 taskbar_top() {
' RECT rect;
' HWND taskBar = FindWindow("Shell_traywnd", NULL);
' if (taskBar && GetWindowRect(taskBar, &rect)) {
' return rect.top;
' }
'}
'int32 taskbar_left() {
' RECT rect;
' HWND taskBar = FindWindow("Shell_traywnd", NULL);
' if (taskBar && GetWindowRect(taskBar, &rect)) {
' return rect.left;
' }
'}
'int32 taskbar_bottom() {
' RECT rect;
' HWND taskBar = FindWindow("Shell_traywnd", NULL);
' if (taskBar && GetWindowRect(taskBar, &rect)) {
' return rect.bottom;
' }
'}
'int32 taskbar_right() {
' RECT rect;
' HWND taskBar = FindWindow("Shell_traywnd", NULL);
' if (taskBar && GetWindowRect(taskBar, &rect)) {
' return rect.right;
' }
'}
DH = _DesktopHeight: DW = _DesktopWidth
$If WIN Then
Do Until _Width <> 0 And _ScreenExists <> 0: Loop
$If TASKBARDEC = UNDEFINED Then
$Let TASKBARDEC = TRUE
Declare Library "taskbar"
Function taskbar_height& ()
Function taskbar_width& ()
Function taskbar_top& ()
Function taskbar_left& ()
Function taskbar_bottom& ()
Function taskbar_right& ()
End Declare
$End If
TBW = taskbar_width&
TBH = taskbar_height&
$Else
Flag$ = "Sorry, this is a Windows Only application."
$End If
$If BORDERDEC = UNDEFINED Then
$Let BORDERDEC = TRUE
Declare Library
Function glutGet& (ByVal what&)
End Declare
$End If
If Flag$ <> "" Then Print Flag$: End
TH = glutGet(507)
BW = glutGet(506)
If TBH = DH Then TBH = 0 'Users taskbar is configured vertical, not hortizonal.
If TBW = DW Then TBW = 0
Xmax = DW - TBW - BW * 2
Ymax = DH - TBH - TH - BW * 2
Screen _NewImage(Xmax, Ymax, 32)
If taskbar_bottom = TBH Then ScreenY = TBH Else ScreenY = 0
If taskbar_right = TBW Then ScreenX = TBW Else ScreenX = 0
_ScreenMove ScreenX, ScreenY
End Sub