Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Xmas Star
#4
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
b = b + ...
Reply


Messages In This Thread
Xmas Star - by bplus - 12-25-2022, 05:51 PM
RE: Xmas Star - by bplus - 01-01-2023, 09:24 PM
RE: Xmas Star - by bplus - 12-27-2023, 03:19 AM
RE: Xmas Star - by bplus - 12-29-2023, 03:12 AM



Users browsing this thread: 1 Guest(s)