Screen Savers

[vince]

great mod, B+! thanks to Steve's ellipsefill you made something almost interesting interesting

[bplus]

So "almost" a thumbs up then, OK LOL!

[bplus]

Celebrate The Fourth With Some Fake Fireworks 

Code: (Select All)

DefInt A-Z
_Title "ASCII Fireworks  Move Mousewheel to Expand or Contract #2" '2020-01-01
' 2020-01-02 update with graivity effect by tsh73 from JB forum
' 2020-08-11 modified for xpanding and contracting screen size
' 2020-08-11 Steve catches memory leak, fixed!
' 2020-08-12 manstersoft gives me idea for Font 8, added more works and switched color to more! RGB32
' 2022-07-04 mods for The Forth
Const nR = 9, t = "     Celebrating July 4th, 2022 at QB64 PE Forum, ASCII Fireworks Brought To You By Bplus Inspired by Pete, TempodiBasic and Code Hunter Recent Efforts, Gravity Effect by tsh73 at JB Forum, Thanks Steve for saving memory and manstersoft for Font 8 idea, Let Freedom Ring!....."
Type rocket
    x As Single
    y As Single
    bang As Integer
    age As Integer
    c As _Unsigned Long
End Type

Dim Shared r(1 To nR) As rocket
For i = 1 To nR
    new i
Next
Dim Shared fire&
fire& = _NewImage(640, 400, 32)
_ScreenMove 0, 0
Dim tmp&(0 To 10)
lastt = 20
sc& = _NewImage(640, 350, 32)
_Font 8
Do
    _Dest fire&
    _Font 16
    Cls
    Color &HFFFF88AA
    lc = lc + 1
    If lc Mod 3 = 0 Then p = (p + 1) Mod Len(t)
    Locate 2, 20: Print Mid$(t, p + 1, 40);
    _Font 8
    rocs = rocs + 1
    If rocs > nR Then rocs = nR
    For i = 1 To rocs
        drawRocket i
    Next


    _Dest 0
    While _MouseInput
        scroll = scroll + _MouseWheel
    Wend
    If scroll < 800 And scroll > -400 And .56 * scroll < _DesktopHeight Then
        tp = (tp + 1) Mod 10
        tmp&(tp) = _NewImage(640 + scroll, 358 + .56 * scroll, 32)
        Screen tmp&(tp)
        _PutImage , fire&, 0
    Else
        lastt = 20
    End If

    'debug
    'COLOR qb(15)
    'LOCATE 1, 1: PRINT lastt, tp, scroll

    If lastt <> 20 Then _FreeImage tmp&(lastt)
    lastt = tp

    _Display
    _Limit 20
Loop Until _KeyDown(27)

Sub new (i)
    r(i).x = Rnd * 60 + 10
    r(i).y = 50
    r(i).bang = Rnd * 30
    r(i).age = 0
    r(i).c = _RGB32(200 * Rnd + 55, 200 * Rnd + 55, 200 * Rnd + 55)
End Sub

Sub drawRocket (i)
    If r(i).y > r(i).bang Then
        Color r(i).c
        Locate r(i).y, r(i).x: Print Chr$(24);
        r(i).y = r(i).y - 1
    Else
        r(i).age = r(i).age + 1
        If r(i).age > 50 Then
            new i
        Else
            Color r(i).c
            If r(i).age > 4 Then start = r(i).age - 4 Else start = 1
            For a = start To r(i).age
                For j = 1 To 12
                    xx = r(i).x + 1 * a * Cos(j * _Pi / 6)
                    yy = r(i).y + .5 * a * Sin(j * _Pi / 6)
                    yy = yy + (r(i).y - a) ^ 2 / 15 '<<<< tsh73 gravity
                    If xx > 0 And xx < 81 And yy > 0 And yy < 51 Then
                        Locate Int(yy), Int(xx)
                        Print "*";
                    End If
                Next
            Next
        End If
    End If
End Sub

   

[Kernelpanic]

Nice @bplus, but what is a screensaver without the right background music? 

Note the women how they wielding the swords. . . from 01:27 (Corrected!)

Kazachka

[bplus]

Yeah, they swing a mean sword or 2 that's for sure but can they code in QB64? ;-))

[Kernelpanic]

Yeah, they swing a mean sword or 2 that's for sure but can they code in QB64?  ;-))

I don't know,   (Corrected: 01:27) but this scene should one be incorporated into a screensaver. So incorporate the scene as a video. Is that possible with QB64?

I once had a program with which one could isolate video sequences. . . Let's see.

PS: In "Fireworks" that would fit well. The video should appear and disappear erratically.

[bplus]

Another Golden Oldie from bplus collection:

Morph Curve

Code: (Select All)

_Title "Morph Curve" 'b+ 2022-07-19 trans from
' Morph Curve on Plasma.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-11
'from SpecBAS version Paul Dunn Dec 2, 2015
'https://www.youtube.com/watch?v=j2rmBRLEVms
' mods draw lines segments with drawpoly, add plasma, play with numbers

Option _Explicit
Const xmax = 1200, ymax = 700, pts = 500, interps = 30, pi = _Pi
Dim Shared plasmaR, plasmaG, plasmaB, plasmaN
Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_FullScreen

Dim p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps)
Dim As Long L, c, j
Dim As Single cx, cy, sc, st, n, m, t, lastx, lasty
L = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * pi / pts
For n = 1 To interps
    i(n) = Sin(n / interps * (pi / 2))
Next
While _KeyDown(27) = 0
    resetPlasma
    n = Int(Rnd * 75) + 2: m = Int(Rnd * 500) - 250: c = 0
    For t = 0 To 2 * pi Step st
        If _KeyDown(27) Then System
        q(c, 0) = cx + sc * (Cos(t) + Cos(n * t) / 2 + Sin(m * t) / 3)
        q(c, 1) = cy + sc * (Sin(t) + Sin(n * t) / 2 + Cos(m * t) / 3)
        setPlasma
        If t > 0 Then pline lastx, lasty, q(c, 0), q(c, 1), 10
        lastx = q(c, 0): lasty = q(c, 1)
        c = c + 1
    Next
    q(c, 0) = q(0, 0): q(c, 1) = q(0, 1)
    If L = 0 Then
        L = L + 1
        _Display
        _Limit 30
    Else
        For t = 1 To interps
            Cls
            For n = 0 To pts
                If _KeyDown(27) Then System
                s(n, 0) = q(n, 0) * i(t) + p(n, 0) * (1 - i(t))
                s(n, 1) = q(n, 1) * i(t) + p(n, 1) * (1 - i(t))
                setPlasma
                If n > 0 Then pline lastx, lasty, s(n, 0), s(n, 1), 10
                lastx = s(n, 0): lasty = s(n, 1)
            Next
            s(n, 0) = s(0, 0)
            s(n, 1) = s(0, 1)
            _Display
            _Limit 30
        Next
    End If
    For j = 0 To pts + 1 'copy q into p
        If _KeyDown(27) Then System
        p(j, 0) = q(j, 0)
        p(j, 1) = q(j, 1)
    Next
    _Display
    _Delay 4
Wend

'fast thick line!!!
Sub pline (x1, y1, x2, y2, thick) 'this draws a little rectangle
    Dim r, dx, dy, perpA1, perpA2, x3, y3, x4, y4, x5, y5, x6, y6

    r = thick / 2
    dx = x2 - x1
    dy = y2 - y1
    perpA1 = _Atan2(dy, dx) + pi / 2
    perpA2 = perpA1 - pi
    x3 = x1 + r * Cos(perpA1) 'corner 1
    y3 = y1 + r * Sin(perpA1)
    x4 = x2 + r * Cos(perpA1) 'corner 2
    y4 = y2 + r * Sin(perpA1)
    x5 = x2 + r * Cos(perpA2) 'corner 3
    y5 = y2 + r * Sin(perpA2)
    x6 = x1 + r * Cos(perpA2) 'corner 4
    y6 = y1 + r * Sin(perpA2)
    Line (x3, y3)-(x4, y4)
    Line (x4, y4)-(x5, y5)
    Line (x5, y5)-(x6, y6)
    Line (x6, y6)-(x3, y3)
End Sub

Sub resetPlasma () 'all globals
    plasmaR = Rnd ^ 2: plasmaG = Rnd ^ 2: plasmaB = Rnd ^ 2: plasmaN = 0
End Sub

Sub setPlasma () 'all globals
    plasmaN = plasmaN + .37
    Color _RGB32(120 + 84 * Sin(plasmaR * plasmaN), 120 + 84 * Sin(plasmaG * plasmaN), 120 + 84 * Sin(plasmaB * plasmaN))
End Sub

   

QBJS Share: https://qbjs.org/?code=X1RpdGxlICJNb3Jwa...AMjKI+kBLw==

Some of these actually look better in QBJS, lines are so skinny.

[bplus]

Rain Drain

Code: (Select All)

'Rain Drain.bas started 2017-09-13
'translated from
'Rain Drain.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-26

' 2020-08-29 Rain Drain 2: What if we move one side of every line up and down?

_Define A-Z As SINGLE
Randomize Timer
Const xmax = 1100
Const ymax = 700

Screen _NewImage(xmax, ymax, 32)
_FullScreen
_Title "Rain Drain 2:   spacebar for new arrangement,    esc to quit"

Type ball
    x As Single
    y As Single
    speed As Single
    r As Single
    c As Long
End Type

Type bLine
    x1 As Single
    y1 As Single
    x2 As Single
    y2 As Single
    a As Double
End Type

While _KeyDown(27) = 0
    balls = 1500
    ReDim b(balls) As ball
    For i = 1 To balls
        b(i).x = Rnd * xmax
        b(i).y = Rnd * ymax
        b(i).speed = 9.85
        b(i).r = 6
        b(i).c = _RGB(0, rand%(200, 255), rand%(200, 255))
    Next

    m = 10
    nbl = 12
    ReDim bl(nbl) As bLine
    For i = 1 To nbl
        d = rand%(50, 200)
        bl(i).x1 = rand%(m, xmax - d - m)
        bl(i).y1 = i * ymax / nbl - 10
        bl(i).a = Rnd * _Pi(1 / 4) - _Pi(1 / 8)
        bl(i).x2 = bl(i).x1 + d * Cos(bl(i).a)
        bl(i).y2 = bl(i).y1 + d * Sin(bl(i).a)
    Next
    dir = .5: lp = 0
    While 1
        Cls
        If 32 = _KeyHit Then
            Exit While
        ElseIf 27 = _KeyHit Then
            End
        End If
        lp = lp + dir
        If lp > 50 Then dir = -dir
        If lp < -50 Then dir = -dir

        For j = 1 To balls
            If b(j).y - b(j).r > ymax Or b(j).x + b(j).r < 0 Or b(j).x - b(j).r > xmax Then
                b(j).x = rand%(0, xmax): b(j).y = 0
            End If
            fcirc b(j).x, b(j).y, b(j).r, b(j).c
            testx = b(j).x + b(j).speed * Cos(_Pi(.5))
            testy = b(j).y + b(j).speed * Sin(_Pi(.5))
            cFlag = 0
            For i = 1 To nbl
                Color _RGB(255, 0, 0)
                If j = 1 Then bl(i).y1 = bl(i).y1 + dir
                Line (bl(i).x1, bl(i).y1)-(bl(i).x2, bl(i).y2)
                If cFlag = 0 Then
                    If hitLine(testx, testy, b(j).r, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) Then
                        bx1 = b(j).x + b(j).speed * Cos(bl(i).a)
                        bx2 = b(j).x + b(j).speed * Cos(_Pi(1) - bl(i).a)
                        by1 = yy(bx1, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
                        by2 = yy(bx2, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
                        If by1 = (-9999 - b(j).r - 1) Or by2 = (-9999 - b(j).r - 1) Then
                            cFlag = 0: Exit For
                        End If
                        If by1 >= by2 Then b(j).y = by1: b(j).x = bx1 Else b(j).y = by2: b(j).x = bx2
                        cFlag = 1
                    End If
                End If
            Next
            If cFlag = 0 Then b(j).x = testx: b(j).y = testy
        Next
        _Limit 20
        _Display
    Wend
Wend

Function hitLine (x, y, r, xx1, yy1, xx2, yy2)
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2
    If x1 > x2 Then Swap x1, x2: Swap y1, y2
    If x < x1 Or x > x2 Then hitLine = 0: Exit Function
    If ((y2 - y1) / (x2 - x1)) * (x - x1) + y1 - r < y And y < ((y2 - y1) / (x2 - x1)) * (x - x1) + y1 + r Then
        hitLine = 1
    Else
        hitLine = 0
    End If
End Function

Function yy (x, xx1, yy1, xx2, yy2) 'this puts drop on line
    'copy parameters that are changed
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2
    If x1 > x2 Then Swap x1, x2: Swap y1, y2
    If x1 <= x And x <= x2 Then
        yy = ((y2 - y1) / (x2 - x1)) * (x - x1) + y1
    Else
        yy = -9999
    End If
End Function

Function rand% (lo%, hi%)
    rand% = (Rnd * (hi% - lo% + 1)) \ 1 + lo%
End Function

Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
    Dim Radius As Integer, RadiusError As Integer
    Dim X As Integer, Y As Integer
    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 Sub

   

[TempodiBasic]

Hi boys,
@ thanks for sharing your interesting and beautyful demos
moreover I thank you for letting me meet QBJS that I didn't know

Happy coding

[bplus]

Alien Trees Mod 3

Code: (Select All)

_Title "Alien Trees Mod 3: Leaves" 'b+ 2022-09-05
Randomize Timer
DefDbl A-Z
Const xmax = 1024, ymax = 600
Type ship
    As Double x, y, dx, dy, scale, tilt
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 170, 40 ' clear sides
_FullScreen
Randomize Timer
Dim Shared As Long bk ' background image
bk = _NewImage(xmax, ymax, 32) 'container for drawings

Dim Shared As Long seed(1 To 3), start, cN ' Randomize seeds for trees and plasma starters
Dim Shared As Single rd(1 To 3), gn(1 To 3), bl(1 To 3) ' plasma colors for trees
Dim Shared leaf ' indexing ends of branches
ref& = _NewImage(xmax, ymax * .2, 32) 'container for reflection image
Dim Shared ships(448) As ship ' ships / leaves
Dim Shared leaves(448) As Long ' ship images
makeShips ' just do this once for images and travel rates

restart:
makeBackground
seed(1) = Rnd * 1000 ' get new trees setup  including the Plasma generators
seed(2) = Rnd * 1000
seed(3) = Rnd * 1000
For i = 1 To 3
    rd(i) = Rnd * Rnd
    gn(i) = Rnd * Rnd
    bl(i) = Rnd * Rnd
Next
leaf = 0
start = 0
cN = start
Randomize Using seed(1)
branch xmax * .6 + Rnd * .3 * xmax, ymax * .8 - 30, 6, 90, xmax / 20, 0, 1, 1
cN = start
Randomize Using seed(2)
branch Rnd * .3 * xmax, ymax * .8 - 15, 7, 90, xmax / 18, 0, 2, 1
cN = start
Randomize Using seed(3)
branch xmax / 2, ymax * .8 - 8, 8, 90, xmax / 16, 0, 3, 1

start = 0: d = 1300: ds = 5 ' start the show! press spacebar to start a different setting
Do
    _PutImage , bk, 0
    start = start + 1
    cN = start
    Randomize Using seed(1)
    branch xmax * .6 + Rnd * .3 * xmax, ymax * .8 - 30, 6, 90, xmax / 20, 0, 1, 0
    cN = start
    Randomize Using seed(2)
    branch Rnd * .3 * xmax, ymax * .8 - 15, 7, 90, xmax / 18, 0, 2, 0
    cN = start
    Randomize Using seed(3)
    branch xmax / 2, ymax * .8 - 8, 8, 90, xmax / 16, 0, 3, 0
    For i = 448 To 1 Step -1
        RotoZoom ships(i).x + d * ships(i).dx, ships(i).y + d * ships(i).dy, leaves(i), ships(i).scale, 0
    Next
    d = d + ds
    If d > 1300 Then ds = -3: d = 1300
    If d < 0 Then ds = 7: d = 0: _Delay 2
    If _KeyDown(32) Then GoTo restart
    _PutImage , 0, ref&, (0, 0)-(xmax, .8 * ymax)
    _PutImage (0, .8 * ymax)-(xmax, ymax), ref&, 0, (0, _Height(ref&))-(xmax, 0)
    _Display
    _Limit 30
Loop Until _KeyDown(27)

Sub makeShips
    cN = 0
    rd(1) = Rnd
    gn(1) = Rnd
    bl(1) = Rnd
    For i = 0 To 448
        leaves(i) = _NewImage(61, 31, 32) ' ship is 60 x 30 drawn in top left hand corner
        ' need black backgrounf for ship
        Color , &HFF000000 '= balck background
        Cls
        drawShip 30, 15, changePlasma(1)
        _PutImage , 0, leaves(i), (0, 0)-(61, 31) ' <<<< upper left corner of screen!!!
        ' make the background black of ship transparent
        _ClearColor &HFF000000, leaves(i)
        a = _Pi(2) * Rnd
        ships(i).dx = Cos(a)
        ships(i).dy = Sin(a)
    Next
End Sub

Sub makeBackground
    _Dest bk
    For i = 0 To ymax
        Line (0, i)-(xmax, i), _RGB32(70, 60, i / ymax * 160)
    Next
    stars = xmax * ymax * 10 ^ -4
    horizon = .67 * ymax
    For i = 1 To stars 'stars in sky
        PSet (Rnd * xmax, Rnd * horizon), _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
    Next
    stars = stars / 2
    For i = 1 To stars
        fcirc Rnd * xmax, Rnd * horizon, 1, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
    Next
    stars = stars / 2
    For i = 1 To stars
        fcirc Rnd * xmax, Rnd * horizon, 2, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
    Next
    DrawTerrain 405, 25, &HFF002255
    DrawTerrain 420, 15, &HFF224444
    DrawTerrain 435, 6, &HFF448855
    DrawTerrain 450, 5, &HFF88FF66
    _Dest 0
End Sub

Sub branch (x, y, startr, angD, lngth, lev, tree, leafTF)
    x2 = x + Cos(_D2R(angD)) * lngth
    y2 = y - Sin(_D2R(angD)) * lngth
    dx = (x2 - x) / lngth
    dy = (y2 - y) / lngth
    For i = 0 To lngth
        fcirc x + dx * i, y + dy * i, startr, changePlasma~&(tree)
    Next
    If startr <= 0 Or lev > 11 Or lngth < 5 Then
        If leafTF Then
            'fcirc x + dx * i, y + dy * i, 5, &HFF008800
            leaf = leaf + 1
            ships(leaf).x = x + dx * i
            ships(leaf).y = y + dy * i
            ships(leaf).scale = .5 - (4 - tree) * .075
        End If
        Exit Sub
    Else
        lev2 = lev + 1
        branch x2, y2, startr - 1, angD + 10 + 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
        branch x2, y2, startr - 1, angD - 10 - 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
    End If
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 Sub

Function changePlasma~& (n)
    cN = cN - 1 'dim shared cN as _Integer64, pR as long, pG as long, pB as long
    changePlasma~& = _RGB32(127 + 127 * Sin(rd(n) * cN), 127 + 127 * Sin(gn(n) * cN), 127 + 127 * Sin(bl(n) * cN))
End Function

Sub drawShip (x, y, colr As _Unsigned Long) 'shipType     collisions same as circle x, y radius = 30
    Static ls
    Dim light As Long, r As Long, g As Long, b As Long
    r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
    fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
    fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
    fellipse x, y, 30, 7, _RGB32(r, g, b)
    For light = 0 To 5
        fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
    Next
    ls = ls + 1
    If ls > 5 Then ls = 0
End Sub

' ======== helper subs for drawShip that you can use for other things specially fcirc = fill_circle  x, y, radius, color

Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
    If xr = 0 Or yr = 0 Then Exit Sub
    Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
    Dim x As Long, y As Long
    w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
    Line (CX - xr, CY)-(CX + xr, CY), C, BF
    Do While y < yr
        y = y + 1
        x = Sqr((h2w2 - y * y * w2) \ h2)
        Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
        Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
    Loop
End Sub

Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
    For x = 0 To _Width
        If x Mod modN = 0 Then ' adjust mod number for ruggedness the higher the number the more jagged
            If h < 600 - modN And h > 50 + modN Then
                dy = Rnd * 20 - 10
            ElseIf h >= 600 - modN Then
                dy = Rnd * -10
            ElseIf h <= 50 + modN Then
                dy = Rnd * 10
            End If
        End If
        h = h + .1 * dy
        Line (x, _Height)-(x, h), c
    Next
End Sub

Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Double, degreesRotation As Double)
    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 Sub