|
Post by bplus on Jul 4, 2024 20:11:49 GMT
earliest(for me)
_Title "Fireworks 3 translation to QB64 2017-12-26 bplus" 'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09 'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris 'fireworks 3.bas try with map variables make bursts around a central point
Const xmax = 1000 Const ymax = 720
Screen _NewImage(xmax, ymax, 32) _ScreenMove 180, 0 Type placeType x As Single y As Single End Type Type flareType x As Single y As Single dx As Single dy As Single c As Long End Type Type debrisType x As Single y As Single c As Long End Type Common Shared debris() As debrisType flareMax = 1000: debrisMax = 5000: debrisStack = 0 Dim flare(flareMax) As flareType Dim debris(debrisMax) As debrisType Dim burst As placeType While 1 rndCycle = Rnd * 30 loopCount = 0 burst.x = .75 * xmax * Rnd + .125 * xmax burst.y = .5 * ymax * Rnd + .125 * ymax While loopCount < 7 Cls 'color 14 : locate 0,0: ? debris_stack; " Debris" 'debug line For i = 1 To 200 'new burst using random old flames to sim burnout nxt = Int(Rnd * flareMax) angle = Rnd * _Pi(2) flare(nxt).x = burst.x + Rnd * 5 * Cos(angle) flare(nxt).y = burst.y + Rnd * 5 * Sin(angle) angle = Rnd * _Pi(2) flare(nxt).dx = Rnd * 15 * Cos(angle) flare(nxt).dy = Rnd * 15 * Sin(angle) rc = Int(Rnd * 3) If rc = 0 Then flare(nxt).c = _RGB32(255, 100, 0) ElseIf rc = 1 Then flare(nxt).c = _RGB32(0, 0, 255) Else flare(nxt).c = _RGB32(255, 255, 255) End If Next For i = 0 To flareMax If flare(i).dy <> 0 Then 'while still moving vertically Line (flare(i).x, flare(i).y)-Step(flare(i).dx, flare(i).dy), _RGB32(98, 98, 98) flare(i).x = flare(i).x + flare(i).dx flare(i).y = flare(i).y + flare(i).dy Color flare(i).c Circle (flare(i).x, flare(i).y), 1 flare(i).dy = flare(i).dy + .4 'add gravity flare(i).dx = flare(i).dx * .95 'add some air resistance If flare(i).x < 0 Or flare(i).x > xmax Then flare(i).dy = 0 'outside of screen 'add some spark bouncing here If flare(i).y > ymax Then If Abs(flare(i).dy) > .5 Then flare(i).y = ymax: flare(i).dy = flare(i).dy * -.25 Else flare(i).dy = 0 End If End If End If Next For i = 0 To debrisStack PSet (debris(i).x, debris(i).y), debris(i).c debris(i).x = debris(i).x + Rnd * 3 - 1.5 debris(i).y = debris(i).y + Rnd * 3.5 - 1.5 If debris(i).x < 0 Or debris(i).y < 0 Or debris(i).x > xmax Or debris(i).y > ymax Then NewDebris (i) Next _Display _Limit 20 loopCount = loopCount + 1 Wend If debrisStack < debrisMax Then For i = 1 To 20 NewDebris i + debrisStack Next debrisStack = debrisStack + 20 End If Wend Sub NewDebris (i) debris(i).x = Rnd * xmax debris(i).y = Rnd * ymax c = Rnd * 255 debris(i).c = _RGB32(c, c, c) End Sub
|
|
|
Post by bplus on Jul 4, 2024 20:13:14 GMT
State of the Art (for me)
_Title "Happy Trails 2020" 'from Happy Trails 2018 ' 2017-12-29 another redesign of fireworks ' 2017-12-28 redesign fireworks ' now with lake refelction 2017-12-27 forget the bouncing sparks ' combine Welcome Plasma Font with landscape '_title "Fireworks 3 translation to QB64 2017-12-26 bplus" 'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09 'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris 'fireworks 3.bas try with map variables make bursts around a central point
Randomize Timer Const xmax = 1200 Const ymax = 720 Const waterline = 600 ' 600 = ratio 5 to 1 sky to water ' raise and lower waterline as desired highest about 400? Const lTail = 15 Const bluey = 5 * 256 ^ 2 + 256 * 5 + 5 Const debrisMax = 28000
Screen _NewImage(xmax, ymax, 32) _ScreenMove 120, 20
Type fireWorkType x As Integer y As Integer seed As Integer age As Integer life As Integer End Type
Type debrisType x As Single y As Single c As Long End Type
Common Shared fw() As fireWorkType Common Shared debris() As debrisType Common Shared cN, pR!, pG!, pB!
Screen _NewImage(xmax, ymax, 32)
'prepare message font mess$ = " Happy New Year 2020" Print mess$ w = 8 * Len(mess$): h = 16 Dim p(w, h) black&& = Point(0, 10) For y = 0 To h For x = 0 To w If Point(x, y) <> black&& Then p(x, y) = 1 End If Next Next xo = 0: yo = 15: m = 7.2 resetPlasma
'prepare landscape Cls land& = _NewImage(xmax, ymax, 32) _Dest land& drawLandscape _Dest 0
'prepare fire works nFW = 3 Dim fw(1 To 10) As fireWorkType For i = 1 To nFW initFireWork (i) Next
''debris feild 'DIM debris(debrisMax) AS debrisType
'OK start the show While 1 'cls screen with land image _PutImage , land&, 0
'draw fireworks For f = 1 To nFW If fw(f).age <= fw(f).life Then drawfw (f) Else initFireWork f Next
''debris 'FOR i = 0 TO debrisStack ' PSET (debris(i).x, debris(i).y), debris(i).c ' debris(i).x = debris(i).x + RND * 3 - 1.5 ' debris(i).y = debris(i).y + RND * 3.5 - 1.5 ' IF debris(i).x < 0 OR debris(i).y < 0 OR debris(i).x > xmax OR debris(i).y > waterline + RND * 20 THEN NewDebris (i) 'NEXT
'text message in plasma For y = 0 To h - 1 For x = 0 To w - 1 If p(x, y) Then changePlasma Else Color 0 End If Line (xo + x * m, yo + y * m)-(xo + x * m + m, yo + y * m + m), , BF Next Next lc = lc + 1 If lc Mod 200 = 0 Then resetPlasma
'reflect sky skyWaterRatio = waterline / (ymax - waterline) - .05 For y = waterline To ymax For x = 0 To xmax c&& = Point(x, waterline - ((y - waterline - 1) * skyWaterRatio) + Rnd * 5) PSet (x, y + 1), c&& + bluey Next Next
_Display _Limit 200 'no limit needed on my system!
''accumulate debris 'IF lc MOD 2000 THEN ' IF debrisStack < debrisMax THEN ' FOR i = 1 TO 2 ' NewDebris i + debrisStack ' NEXT ' debrisStack = debrisStack + 2 ' END IF 'END IF Wend
'SUB NewDebris (i) ' debris(i).x = RND * xmax ' debris(i).y = RND * ymax ' c = RND * 155 ' debris(i).c = _RGB32(c, c, c) 'END SUB
Sub changePlasma () cN = cN + .01 Color _RGB(127 + 127 * Sin(pR! * .3 * cN), 127 + 127 * Sin(pG! * .3 * cN), 127 + 127 * Sin(pB! * .3 * cN)) End Sub
Sub resetPlasma () pR! = Rnd ^ 2: pG! = Rnd ^ 2: pB! = Rnd ^ 2 End Sub
Sub drawLandscape 'the sky For i = 0 To ymax midInk 0, 0, 0, 78, 28, 68, i / ymax Line (0, i)-(xmax, i) Next 'the land startH = waterline - 80 rr = 10: gg = 20: bb = 15 For mountain = 1 To 6 Xright = 0 y = startH While Xright < xmax ' upDown = local up / down over range, change along Y ' range = how far up / down, along X upDown = (Rnd * .8 - .35) * (1 / (1 * mountain)) range = Xright + rand&&(5, 35) * 2.5 / mountain lastx = Xright - 1 For X = Xright To range y = y + upDown Color _RGB32(rr, gg, bb) Line (lastx, y)-(X, ymax), , BF 'just lines weren't filling right lastx = X Next Xright = range Wend rr = rand&&(rr + 5, rr): gg = rand&&(gg + 5, gg): bb = rand&&(bb + 4, bb) If rr < 0 Then rr = 0 If gg < 0 Then gg = 0 If bb < 0 Then bb = 0 startH = startH + rand&&(1, 10) Next 'LINE (0, waterline)-(xmax, ymax), _RGB32(0, 0, 0), BF End Sub
Sub midInk (r1, g1, b1, r2, g2, b2, fr) Color _RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr) End Sub
Function rand&& (lo&&, hi&&) rand&& = Int(Rnd * (hi&& - lo&& + 1)) + lo&& End Function
Sub drawfw (i) 'here's how to "save" a bunch of random numbers without data and arrays but tons of redundant calculations Randomize Using fw(i).seed 'this repeats all random numbers generated by seed in same sequence 'recreate our firework from scratch! red = rand&&(200, 255) green = rand&&(200, 255) blue = rand&&(200, 255) x = rand&&(1, 4) If x = 1 Then red = 0 ElseIf x = 2 Then green = 0 ElseIf x = 3 Then blue = 0 Else x = rand&&(1, 4) If x = 1 Then red = 0: green = 0 ElseIf x = 2 Then green = 0: blue = 0 ElseIf x = 3 Then blue = 0: red = 0 End If End If ne = rand&&(80, 300) Dim embers(ne, 1) For e = 0 To ne r = Rnd * 3 embers(e, 0) = r * Cos(e * _Pi(2) / 101) embers(e, 1) = r * Sin(e * _Pi(2) / 101) Next start = fw(i).age - lTail ' don't let tails get longer than lTail const If start < 1 Then start = 1 For e = 0 To ne cx = fw(i).x: cy = fw(i).y: dx = embers(e, 0): dy = embers(e, 1) For t = 1 To fw(i).age cx = cx + dx cy = cy + dy If t >= start Then 'too much like a flower? midInk 60, 60, 60, red, green, blue, (t - start) / lTail 'midInk 60, 60, 60, 128, 160, 150, (t - start) / lTail fcirc cx, cy, (t - start) / lTail End If
dx = dx * .99 'air resitance dy = dy + .01 'gravity Next Color _RGB32(255, 255, 255) 'COLOR _RGB32(red, green, blue) cx = cx + dx: cy = cy + dy fcirc cx, cy, (t - start) / lTail Next fw(i).age = fw(i).age + 1 End Sub
Sub initFireWork (i) fw(i).x = rand&&(.1 * xmax, .9 * xmax) fw(i).y = rand&&(.1 * ymax, .5 * ymax) fw(i).seed = rand&&(0, 32000) fw(i).age = 0 fw(i).life = rand&&(20, 120) End Sub
'Steve McNeil's copied from his forum note: Radius is too common a name Sub fcirc (CX As Long, CY As Long, R As Long) Dim subRadius As Long, RadiusError As Long Dim X As Long, Y As Long
subRadius = Abs(R) RadiusError = -subRadius X = subRadius Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop, ' which would be a problem with blending turned on. Line (CX - X, CY)-(CX + X, CY), , 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), , BF Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF End If X = X - 1 RadiusError = RadiusError - X * 2 End If Y = Y + 1 Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF Wend End Sub
|
|
|
Post by bplus on Jul 4, 2024 20:14:44 GMT
An ASCII version, use mousewheel to expand and shrink screen:
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
Const nR = 9, t = " Happy New Year QB64 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, Go In Peace 2020!....." 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) Dim tmp&(0 To 10) lastt = 20 sc& = _NewImage(640, 400, 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 Then tp = (tp + 1) Mod 10 tmp&(tp) = _NewImage(640 + scroll, 400 + 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
|
|
Aaditya Parashar
Full Member
![*](//storage.proboards.com/forum/images/stars/star.png) ![*](//storage.proboards.com/forum/images/stars/star.png)
Just somebody with an abnormal coding routine.
Posts: 124
|
Post by Aaditya Parashar on Jul 5, 2024 3:19:19 GMT
What if someone projected this on a new year's eve? I think it would look cool.
|
|
|
Post by bplus on Jul 5, 2024 14:46:22 GMT
Thanks AP, projected where, into sky?
All these would be improved by some explosion sounds.
|
|
ubi44
Junior Member
![*](//storage.proboards.com/forum/images/stars/star.png)
Posts: 51
|
Post by ubi44 on Jul 8, 2024 12:34:45 GMT
Nice !
here's my attempt about fireworks...
Screen _NewImage(600 * 16 / 9, 600, 32)
Type artifice P As _Float Vx As _Float Vy As _Float pX As _Float pY As _Float r As Single g As Single b As Single End Type ReDim Shared NBArtif, NBPArtif NBPArtif = 350 NBArtif = 7 ReDim Shared maxCercle maxCercle = _Height / 5
ReDim Shared Artif(NBArtif, NBPArtif) As artifice ReDim Shared ActiF(NBArtif) ReDim Shared maCv(maxCercle, maxCercle * 2, maxCercle * 2) As Single precalcus FPS = 60 before = Timer + 1 Type vec3 x As Single y As Single z As Single End Type
ReDim Shared Letoil As vec3 Letoil.x = -2 Letoil.y = -0.1 Letoil.z = -4 ReDim Shared NBr, NBPackEtoile, NBEtoileShow NBPackEtoile = 100 NBEtoileShow = 20 ReDim Shared diamEtoile diamEtoile = HIGH / 150 Type etoile x As Single y As Single z As Single r As Single g As Single b As Single vit As Integer diam As _Float dx As _Float dy As _Float End Type NBr = 14 ReDim Shared E(NBPackEtoile, NBr + NBr * NBr) As etoile
Do Etoiles FPS * 10, 10 _Title "FireWorks by ubi44 _/ FPS:" + Str$(FPS)
For i = 0 To NBArtif If ActiF(i) = 0 And gotime < Timer(.01) Then mfx = _Width / 2 + (Rnd - Rnd) * (_Width / 3) mfy = (_Height / 1.2) - _Height / 6.5 - (Rnd) * (_Height / 5) initARTIF i, mfx, mfy gotime = Timer(.01) + .1 + Rnd * .2 End If Next i For i = 0 To NBArtif If ActiF(i) = 1 Then updateArtif i, FPS Next i _Limit FPS
totfps = totfps + 1 If before < Timer Then before = Timer + 1 FPS = totfps totfps = 0 End If _Display Cls Loop Until _KeyDown(27)
Sub updateArtif (i, tfps) HIGH = _Height If tfps < 10 Then tfps = 10 hp = Rnd tic = 0 If hp < .1 Then tic = 1 If hp > .9 Then tic = 2
For j = 0 To NBPArtif Select Case Artif(i, j).P Case Is <= 0 Artif(i, j).P = 0 Artif(i, j).Vx = 0 Artif(i, j).Vy = 0 Artif(i, j).pX = 0 Artif(i, j).pY = 0 Case Is > .5 Artif(i, j).P = Artif(i, j).P - (.3 + .3 * Rnd) / tfps Artif(i, j).Vy = Artif(i, j).Vy + (1.2 / tfps) Artif(i, j).pX = Artif(i, j).pX + Artif(i, j).Vx * ((600) / tfps) * (HIGH / 1080) Artif(i, j).pY = Artif(i, j).pY + Artif(i, j).Vy * ((600) / tfps) * (HIGH / 1080) If tic = 0 Then If Artif(i, j).P < .5 Then Artif(i, j).Vy = Cos(j + Timer(.0001)) Artif(i, j).Vx = Sin(j + Timer(.0001)) Artif(i, j).P = .1 + Rnd * .39 End If End If If tic = 1 Then If Artif(i, j).P < .5 Then Artif(i, j).Vy = (-Rnd) Artif(i, j).Vx = (Rnd - Rnd) Artif(i, j).P = .1 + Rnd * .39 End If End If If tic = 2 Then If Artif(i, j).P < .5 Then Artif(i, j).Vy = Cos(j * _Pi + Timer) Artif(i, j).Vx = Sin(j * _Pi + Timer) Artif(i, j).P = .1 + Rnd * .39 End If End If If j = Int(NBPArtif / 2) Then hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228 hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228 hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 50), (1 - Artif(i, j).P) * 128, hr, hg, hb, 2, 4 End If Case Is < .5 Artif(i, j).P = Artif(i, j).P - ((_Height - Artif(i, j).pY) / _Height) * ((.65 + .55 * Rnd) / tfps) Artif(i, j).Vy = Artif(i, j).Vy + (.5 - Artif(i, j).P) * (Artif(i, j).pY / _Height) * (5 / tfps) Artif(i, j).pX = Artif(i, j).pX + Artif(i, j).Vx * (.015 - Rnd * .01 + Artif(i, j).P / 5) * (6000 / tfps) * (HIGH / 1080) Artif(i, j).pY = Artif(i, j).pY + Artif(i, j).Vy * (.015 - Rnd * .01 + Artif(i, j).P / 5) * (6000 / tfps) * (HIGH / 1080)
cl = Artif(i, j).P * 255 * (1.5 - (Artif(i, j).pY / _Height)) hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228 hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228 hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228 cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 28), cl * .75, hr, hg, hb, 2, 4 If hr > hg And hr > hb Then cr = 255 Else cr = 0 If hg > hb And hg > hr Then cg = 255 Else cg = 0 If hb > hg And hb > hr Then cb = 255 Else cb = 0
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 72), cl * 2, cr, cg, cb, 1, 2 PSet (Artif(i, j).pX, Artif(i, j).pY), _RGBA(255, 255, 255, Artif(i, j).P * (355)) Circle (Artif(i, j).pX, Artif(i, j).pY), .5, _RGBA(255, 255, 255, Artif(i, j).P * (255)) End Select Next j q = 0 For j = 0 To NBPArtif If Artif(i, j).P = 0 Or Artif(i, j).pX < 0 Or Artif(i, j).pX > _Width Or Artif(i, j).pY < 0 Or Artif(i, j).pY > _Height Then q = q + 1 Next j If j = q Then ActiF(i) = 0 End Sub Sub initARTIF (I, x, y) pot = Sgn(Rnd - Rnd) * .5 * (Rnd * .5 + .5) rr = Rnd * 155 gg = Rnd * 155 bb = Rnd * 155 For j = 0 To NBPArtif - Rnd * 150 Artif(I, j).P = 1 Artif(I, j).Vx = (pot * .1) Artif(I, j).Vy = (-.9 - .05 * Rnd * (j / NBPArtif)) Artif(I, j).pX = x Artif(I, j).pY = y Artif(I, j).r = rr Artif(I, j).g = gg Artif(I, j).b = bb Next j ActiF(I) = 1 End Sub Sub cercleSUN3 (afx, afy, r, Kalpha, hr, hg, hb, ut1, ut2) Static ut If ut = 0 Then ut = ut1 For aa = 0 To r * 2 Step ut For bb = 0 To r * 2 Step ut cl = (maCv(r, aa, bb)) i% = aa - r j% = bb - r alpha = cl If cl > .3 Then PSet (afx + i%, afy + j%), _RGBA(cl * hr, cl * hg, cl * hb, Kalpha * alpha) Next bb Next aa If ut = ut2 Then ut = ut1 Else ut = ut2 End Sub Sub precalcus For r = 0 To maxCercle diam = (r * r + r * r) a = 0: b = 0 For i% = -r To r For j% = -r To r maCv(r, a, b) = 1 - (Sqr((i% * i%) + (j% * j%)) / r) b = b + 1 Next j% b = 0: a = a + 1 Next i% Next r End Sub Sub Etoiles (globe, bifx) Static oldGFPS If globe < 10 Then cGFPS = 10 Else cGFPS = globe vitesse = NBr / ((1 + cGFPS * 15) * 2) HIGH = _Height oldGFPS = cGFPS Letoil.z = -(_Height / 2) / _Height * bifx * .25 Letoil.x = -(_Width / 2) / _Width * bifx * 1.25 CSx = Cos(.053 * Letoil.x / 55) SNx = Sin(.053 * Letoil.x / 55) CTx = Cos(.053 * Letoil.z / 55) STx = Sin(.053 * Letoil.z / 55) For xx = 0 To NBr For yy = 0 To NBr For q = 0 To NBEtoileShow tut = xx + xx * yy vitesse = NBr / ((1 + cGFPS) * E(q, tut).vit) * 30 ptx = E(q, tut).x + E(q, tut).dx pty = E(q, tut).y + E(q, tut).dy E(q, tut).dx = E(q, tut).dx * (.995 + Rnd * .005) E(q, tut).dy = E(q, tut).dy * (.995 + Rnd * .005) ptz = E(q, tut).z E(q, tut).x = ptx + Letoil.x * vitesse * (.02 / (bifx * .5)) * Cos((1 - (ptz / NBr)) * _Pi * NBr) E(q, tut).y = pty + Letoil.z * vitesse * (.02 / (bifx * .5)) * Sin((1 - (ptz / NBr)) * _Pi * NBr) E(q, tut).z = ptz - (vitesse + .02) / (E(q, tut).diam) afx = (_Width / 2 + (47 + 88) * (ptx + Letoil.x * .5) / ptz * (4 + 1)) If (afx > 0) And afx < _Width And ptz > 0 Then afy = (_Height / 2 + (47 + 78) * (pty) / ptz * (4 + 1)) If afy > 0 And afy < _Height Then r = (1 - (ptz / NBr)) * E(q, tut).diam * .25 If E(q, tut).diam >= (HIGH / 180) + .9 * diamEtoile * 4 Then r = r * 1.5 cr = (1 - (ptz / (NBr * 2))) * 150 If r * HIGH / 450 >= 6 Then cerclefumee afx, afy, r * HIGH / 255, cr * 8, 6, 8, 1.9, E(q, tut).r, E(q, tut).g / 2, E(q, tut).b / 1.5 If r > 2 Then cercle afx - r * .5, afy - r * .5, r * .75, E(q, tut).r * .75, E(q, tut).g * .75, E(q, tut).b * .75, (1 - (ptz / (NBr * 2))) * .6 + .2, 4, 6 End If PSet (afx, afy), _RGBA(185 + 255 * E(q, tut).b * ((ptz / NBr)), 158 + 255 * E(q, tut).r * ((ptz / NBr)), 158 + 255 * E(q, tut).g * ((ptz / NBr)), HIGH * .28 * (1 - (ptz / NBr)) * (E(q, tut).diam / ((HIGH / 180) + diamEtoile * 4))) PSet (afx, afy), _RGBA(255 - E(q, tut).b * 180, 255 - E(q, tut).b * 200, 255 - E(q, tut).b * 255, HIGH * .08 * (1 - (ptz / NBr)) * (E(q, tut).diam / ((HIGH / 180) + diamEtoile * 2))) pitet = pitet + 1 Else If (afx < -_Width) Or afx > _Width * 2 Or ptz < -NBr Then E(q, tut).x = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).y = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).z = (NBr) E(q, tut).diam = (1080 / 180) + Rnd * diamEtoile * 4 E(q, tut).r = Rnd * .813 + .03 E(q, tut).g = Rnd * .803 + .03 E(q, tut).b = Rnd * .803 + .03 E(q, tut).vit = 10 + Rnd * 30 If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b Then If Rnd < .5 Then E(q, tut).r = E(q, tut).g * (1 + Rnd * .1) Else E(q, tut).r = (30 + Rnd * 25) / 655 E(q, tut).g = (92 + Rnd * 60) / 655 E(q, tut).b = (193 - Rnd * 60) / 655 End If End If E(q, tut).dx = (Rnd - Rnd) * (.05 + Rnd * .025) E(q, tut).dy = (Rnd - Rnd) * (.05 + Rnd * .025) If Rnd > .8 Then If E(q, tut).r > E(q, tut).g And E(q, tut).r > E(q, tut).b Then E(q, tut).r = .82: E(q, tut).g = E(q, tut).r * Rnd E(q, tut).b = 0 GoTo ppp End If If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b Then E(q, tut).g = .82 If Rnd > .5 Then E(q, tut).b = E(q, tut).g * Rnd Else E(q, tut).r = E(q, tut).g * (1 + Rnd) If Rnd > .95 Then E(q, tut).r = 0: E(q, tut).b = E(q, tut).b * .1 GoTo ppp End If If E(q, tut).b > E(q, tut).r And E(q, tut).b > E(q, tut).g Then E(q, tut).b = .82 E(q, tut).g = E(q, tut).b * Rnd E(q, tut).r = 0 End If End If ppp: End If End If Else If afy < -_Height Or afy > _Height * 2 Or ptz < 0 Then E(q, tut).x = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).y = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).z = (NBr) E(q, tut).diam = (1080 / 180) + Rnd * diamEtoile * 4 E(q, tut).r = Rnd * .8125 E(q, tut).g = Rnd * .8125 E(q, tut).b = Rnd * .8125
If E(q, tut).b > E(q, tut).r Then E(q, tut).r = (30 + Rnd * 25) / 655 E(q, tut).g = (92 + Rnd * 60) / 655 E(q, tut).b = (193 - Rnd * 60) / 655 Else E(q, tut).g = E(q, tut).g + E(q, tut).b E(q, tut).r = E(q, tut).r * .2 End If If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b And Rnd < .5 Then E(q, tut).r = E(q, tut).g * (1 + Rnd * .1) E(q, tut).vit = 10 + Rnd * 30 E(q, tut).dx = (Rnd - Rnd) * (.05 + Rnd * .025) E(q, tut).dy = (Rnd - Rnd) * (.05 + Rnd * .025) If Rnd > .8 Then If E(q, tut).r > E(q, tut).g And E(q, tut).r > E(q, tut).b Then E(q, tut).r = .82: E(q, tut).g = E(q, tut).r * Rnd E(q, tut).b = 0 GoTo ppp End If If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b Then E(q, tut).g = .82 If Rnd > .5 Then E(q, tut).b = E(q, tut).g * Rnd Else E(q, tut).r = E(q, tut).g * (1 + Rnd) If Rnd > .95 Then E(q, tut).r = 0: E(q, tut).b = E(q, tut).b * .1 GoTo ppp2 End If If E(q, tut).b > E(q, tut).r And E(q, tut).b > E(q, tut).g Then E(q, tut).b = .82 E(q, tut).g = E(q, tut).b * Rnd E(q, tut).r = 0 End If End If ppp2: End If End If Next Next yy Next xx End Sub Sub cerclefumee (afx, afy, r, cr, ut1, ut2, aaa, hr, hg, hb) Static ut If ut = 0 Then ut = ut1 For aa = 0 To r * 2 Step ut For bb = 0 To r * 2 Step ut cl = (maCv(r, aa, bb)) i% = aa - r j% = bb - r alpha = cl * aaa PSet (afx + i%, afy + j%), _RGBA((hr * 100) * alpha, (100 * hg) * alpha, (100 * hb) * alpha, cr * alpha) Next bb, aa If ut = ut2 Then ut = ut1 Else ut = ut2 End Sub Sub cercle (afx, afy, r, hr, hg, hb, aaa, ut1, ut2) Static ut If ut = 0 Then ut = ut1 For aa = 0 To r * 2 Step ut For bb = 0 To r * 2 Step ut cl = (maCv(r, aa, bb)) * 1.3 i% = aa - r j% = bb - r alpha = cl * 2 Line (afx + i%, afy + j%)-(afx + i% + ut, afy + j% + ut), _RGBA((cl * 128 * hr), (cl * 128 * hg), (cl * 128 * hb), 150 * alpha * aaa), BF Next bb Next aa If ut = ut2 Then ut = ut1 Else ut = ut2 End Sub
|
|
|
Post by bplus on Jul 8, 2024 13:18:48 GMT
Nice fumes/atmosphere blend!
|
|
ubi44
Junior Member
![*](//storage.proboards.com/forum/images/stars/star.png)
Posts: 51
|
Post by ubi44 on Jul 8, 2024 17:59:50 GMT
Small update to respect the title of the post! so I reused the message "happy new years" made from the post above but I don't use change and resetplasma ... I also (tried) to put more color in the fireworks!
Screen _NewImage(600 * 16 / 9, 600, 32)
Type artifice P As _Float Vx As _Float Vy As _Float pX As _Float pY As _Float r As Single g As Single b As Single End Type ReDim Shared NBArtif, NBPArtif NBPArtif = 350 NBArtif = 7 ReDim Shared maxCercle maxCercle = _Height / 5 'prepare message font mess$ = " Happy New Year 2024" Print mess$ w = 8 * Len(mess$): h = 16 Dim p(w, h) black&& = Point(0, 10) For y = 0 To h For x = 0 To w If Point(x, y) <> black&& Then p(x, y) = 1 End If Next Next xo = 0: yo = 45: m = 6
ReDim Shared Artif(NBArtif, NBPArtif) As artifice ReDim Shared ActiF(NBArtif) ReDim Shared maCv(maxCercle, maxCercle * 2, maxCercle * 2) As Single precalcus FPS = 60 before = Timer + 1 Type vec3 x As Single y As Single z As Single End Type
ReDim Shared Letoil As vec3 Letoil.x = -2 Letoil.y = -0.1 Letoil.z = -4 ReDim Shared NBr, NBPackEtoile, NBEtoileShow NBPackEtoile = 100 NBEtoileShow = 20 ReDim Shared diamEtoile diamEtoile = HIGH / 150 Type etoile x As Single y As Single z As Single r As Single g As Single b As Single vit As Integer diam As _Float dx As _Float dy As _Float End Type NBr = 14 ReDim Shared E(NBPackEtoile, NBr + NBr * NBr) As etoile
Do Etoiles FPS * 10, 10 _Title "FireWorks by ubi44 _/ FPS:" + Str$(FPS)
For y = 0 To h - 1 For x = 0 To w - 1 If p(x, y) Then yoo = yo + Sin(((((x + Rush) Mod w) / w) * _Pi * 2)) * m * 5 Rush = Rush + FPS * .0001 If Rush > w Then Rush = 0 R = 175 + (Sin(((((x + Rush * .1) Mod w) / w) * _Pi * 2)) * 75) g = 175 + (Sin(((((y + Rush * .1) Mod h) / h) * _Pi * 2)) * 75) b = 175 + (Cos(((((x + Rush * .1) Mod w) / w) * _Pi * 2)) * 75)
Line (xoo + x * m, yoo + y * m)-(xoo + x * m + m - 2, yoo + y * m + m - 2), _RGBA(R, g, b, 128), BF
End If Next Next
For i = 0 To NBArtif If ActiF(i) = 0 And gotime < Timer(.01) Then mfx = _Width / 2 + (Rnd - Rnd) * (_Width / 3) mfy = (_Height / 1.2) - _Height / 6.5 - (Rnd) * (_Height / 5) initARTIF i, mfx, mfy gotime = Timer(.01) + .1 + Rnd * .2 End If Next i For i = 0 To NBArtif If ActiF(i) = 1 Then updateArtif i, FPS Next i _Limit FPS
totfps = totfps + 1 If before < Timer Then before = Timer + 1 FPS = totfps totfps = 0 End If _Display Cls Loop Until _KeyDown(27)
Sub updateArtif (i, tfps) HIGH = _Height If tfps < 10 Then tfps = 10 hp = Rnd tic = 0 If hp < .1 Then tic = 1 If hp > .9 Then tic = 2
For j = 0 To NBPArtif Select Case Artif(i, j).P Case Is <= 0 Artif(i, j).P = 0 Artif(i, j).Vx = 0 Artif(i, j).Vy = 0 Artif(i, j).pX = 0 Artif(i, j).pY = 0 Case Is > .5 Artif(i, j).P = Artif(i, j).P - (.3 + .3 * Rnd) / tfps Artif(i, j).Vy = Artif(i, j).Vy + (1.2 / tfps) Artif(i, j).pX = Artif(i, j).pX + Artif(i, j).Vx * ((600) / tfps) * (HIGH / 1080) Artif(i, j).pY = Artif(i, j).pY + Artif(i, j).Vy * ((600) / tfps) * (HIGH / 1080) If tic = 0 Then If Artif(i, j).P < .5 Then Artif(i, j).Vy = Cos(j + Timer(.0001)) Artif(i, j).Vx = Sin(j + Timer(.0001)) Artif(i, j).P = .1 + Rnd * .39 End If End If If tic = 1 Then If Artif(i, j).P < .5 Then Artif(i, j).Vy = (-Rnd) Artif(i, j).Vx = (Rnd - Rnd) Artif(i, j).P = .1 + Rnd * .39 End If End If If tic = 2 Then If Artif(i, j).P < .5 Then Artif(i, j).Vy = Cos(j * _Pi + Timer) Artif(i, j).Vx = Sin(j * _Pi + Timer) Artif(i, j).P = .1 + Rnd * .39 End If End If If j = Int(NBPArtif / 2) Then hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228 hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228 hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228
cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 50), (1 - Artif(i, j).P) * 128, hr, hg, hb, 2, 4 End If
Case Is < .5 PSet (Artif(i, j).pX, Artif(i, j).pY), _RGBA(255, 255, 255, (.2 + Artif(i, j).P) * (255))
Artif(i, j).P = Artif(i, j).P - ((_Height - Artif(i, j).pY) / _Height) * ((.65 + .55 * Rnd) / tfps) Artif(i, j).Vy = Artif(i, j).Vy + (.5 - Artif(i, j).P) * (Artif(i, j).pY / _Height) * (5 / tfps) Artif(i, j).pX = Artif(i, j).pX + Artif(i, j).Vx * (.015 - Rnd * .01 + Artif(i, j).P / 5) * (6000 / tfps) * (HIGH / 1080) Artif(i, j).pY = Artif(i, j).pY + Artif(i, j).Vy * (.015 - Rnd * .01 + Artif(i, j).P / 5) * (6000 / tfps) * (HIGH / 1080)
cl = Artif(i, j).P * 255 * (1.5 - (Artif(i, j).pY / _Height)) hr = Artif(i, j).r + (1 - Artif(i, j).P) * 228 hg = Artif(i, j).g + (1 - Artif(i, j).P) * 228 hb = Artif(i, j).b + (1 - Artif(i, j).P) * 228 cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 28), cl * .75, hr, hg, hb, 2, 4 If hr > hg And hr > hb Then cr = 255 Else cr = 0 If hg > hb And hg > hr Then cg = 255 Else cg = 0 If hb > hg And hb > hr Then cb = 255 Else cb = 0 Circle (Artif(i, j).pX, Artif(i, j).pY), .5, _RGBA(255, 255, 255, (Artif(i, j).P) * (155)) cercleSUN3 Artif(i, j).pX, Artif(i, j).pY, (1 - Artif(i, j).P) * (HIGH / 42), cl * 2, cr, cg, cb, 1, 2 End Select Next j q = 0 For j = 0 To NBPArtif If Artif(i, j).P = 0 Or Artif(i, j).pX < 0 Or Artif(i, j).pX > _Width Or Artif(i, j).pY < 0 Or Artif(i, j).pY > _Height Then q = q + 1 Next j If j = q Then ActiF(i) = 0 End Sub Sub initARTIF (I, x, y) pot = Sgn(Rnd - Rnd) * .5 * (Rnd * .5 + .5) rr = Rnd * 155 gg = Rnd * 155 bb = Rnd * 155 For j = 0 To NBPArtif - Rnd * 150 Artif(I, j).P = 1 Artif(I, j).Vx = (pot * .1) Artif(I, j).Vy = (-.9 - .05 * Rnd * (j / NBPArtif)) Artif(I, j).pX = x Artif(I, j).pY = y Artif(I, j).r = rr Artif(I, j).g = gg Artif(I, j).b = bb Next j ActiF(I) = 1 End Sub Sub cercleSUN3 (afx, afy, r, Kalpha, hr, hg, hb, ut1, ut2) Static ut If ut = 0 Then ut = ut1 For aa = 0 To r * 2 Step ut For bb = 0 To r * 2 Step ut cl = (maCv(r, aa, bb)) i% = aa - r j% = bb - r alpha = cl If cl > .3 Then PSet (afx + i%, afy + j%), _RGBA(cl * hr, cl * hg, cl * hb, Kalpha * alpha) Next bb Next aa If ut = ut2 Then ut = ut1 Else ut = ut2 End Sub Sub precalcus For r = 0 To maxCercle diam = (r * r + r * r) a = 0: b = 0 For i% = -r To r For j% = -r To r maCv(r, a, b) = 1 - (Sqr((i% * i%) + (j% * j%)) / r) b = b + 1 Next j% b = 0: a = a + 1 Next i% Next r End Sub Sub Etoiles (globe, bifx) Static oldGFPS If globe < 10 Then cGFPS = 10 Else cGFPS = globe vitesse = NBr / ((1 + cGFPS * 15) * 2) HIGH = _Height oldGFPS = cGFPS Letoil.z = -(_Height / 2) / _Height * bifx * .25 Letoil.x = -(_Width / 2) / _Width * bifx * 1.25 CSx = Cos(.053 * Letoil.x / 55) SNx = Sin(.053 * Letoil.x / 55) CTx = Cos(.053 * Letoil.z / 55) STx = Sin(.053 * Letoil.z / 55) For xx = 0 To NBr For yy = 0 To NBr For q = 0 To NBEtoileShow tut = xx + xx * yy vitesse = NBr / ((1 + cGFPS) * E(q, tut).vit) * 30 ptx = E(q, tut).x + E(q, tut).dx pty = E(q, tut).y + E(q, tut).dy E(q, tut).dx = E(q, tut).dx * (.995 + Rnd * .005) E(q, tut).dy = E(q, tut).dy * (.995 + Rnd * .005) ptz = E(q, tut).z E(q, tut).x = ptx + Letoil.x * vitesse * (.02 / (bifx * .5)) * Cos((1 - (ptz / NBr)) * _Pi * NBr) E(q, tut).y = pty + Letoil.z * vitesse * (.02 / (bifx * .5)) * Sin((1 - (ptz / NBr)) * _Pi * NBr) E(q, tut).z = ptz - (vitesse + .02) / (E(q, tut).diam) afx = (_Width / 2 + (47 + 88) * (ptx + Letoil.x * .5) / ptz * (4 + 1)) If (afx > 0) And afx < _Width And ptz > 0 Then afy = (_Height / 2 + (47 + 78) * (pty) / ptz * (4 + 1)) If afy > 0 And afy < _Height Then r = (1 - (ptz / NBr)) * E(q, tut).diam * .25 If E(q, tut).diam >= (HIGH / 180) + .9 * diamEtoile * 4 Then r = r * 1.5 cr = (1 - (ptz / (NBr * 2))) * 150 If r * HIGH / 450 >= 6 Then cerclefumee afx, afy, r * HIGH / 255, cr * 8, 6, 8, 1.9, E(q, tut).r, E(q, tut).g / 2, E(q, tut).b / 1.5 If r > 2 Then cercle afx - r * .5, afy - r * .5, r * .75, E(q, tut).r * .75, E(q, tut).g * .75, E(q, tut).b * .75, (1 - (ptz / (NBr * 2))) * .6 + .2, 4, 6
End If PSet (afx, afy), _RGBA(185 + 255 * E(q, tut).b * ((ptz / NBr)), 158 + 255 * E(q, tut).r * ((ptz / NBr)), 158 + 255 * E(q, tut).g * ((ptz / NBr)), HIGH * .28 * (1 - (ptz / NBr)) * (E(q, tut).diam / ((HIGH / 180) + diamEtoile * 4))) PSet (afx, afy), _RGBA(255 - E(q, tut).b * 180, 255 - E(q, tut).b * 200, 255 - E(q, tut).b * 255, HIGH * .08 * (1 - (ptz / NBr)) * (E(q, tut).diam / ((HIGH / 180) + diamEtoile * 2))) pitet = pitet + 1 Else If (afx < -_Width) Or afx > _Width * 2 Or ptz < -NBr Then E(q, tut).x = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).y = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).z = (NBr) E(q, tut).diam = (1080 / 180) + Rnd * diamEtoile * 4 E(q, tut).r = Rnd * .813 + .03 E(q, tut).g = Rnd * .803 + .03 E(q, tut).b = Rnd * .803 + .03 E(q, tut).vit = 10 + Rnd * 30 If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b Then If Rnd < .5 Then E(q, tut).r = E(q, tut).g * (1 + Rnd * .1) Else E(q, tut).r = (30 + Rnd * 25) / 655 E(q, tut).g = (92 + Rnd * 60) / 655 E(q, tut).b = (193 - Rnd * 60) / 655 End If End If E(q, tut).dx = (Rnd - Rnd) * (.05 + Rnd * .025) E(q, tut).dy = (Rnd - Rnd) * (.05 + Rnd * .025) If Rnd > .8 Then If E(q, tut).r > E(q, tut).g And E(q, tut).r > E(q, tut).b Then E(q, tut).r = .82: E(q, tut).g = E(q, tut).r * Rnd E(q, tut).b = 0 GoTo ppp End If If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b Then E(q, tut).g = .82 If Rnd > .5 Then E(q, tut).b = E(q, tut).g * Rnd Else E(q, tut).r = E(q, tut).g * (1 + Rnd) If Rnd > .95 Then E(q, tut).r = 0: E(q, tut).b = E(q, tut).b * .1 GoTo ppp End If If E(q, tut).b > E(q, tut).r And E(q, tut).b > E(q, tut).g Then E(q, tut).b = .82 E(q, tut).g = E(q, tut).b * Rnd E(q, tut).r = 0 End If End If ppp: End If End If Else If afy < -_Height Or afy > _Height * 2 Or ptz < 0 Then E(q, tut).x = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).y = Rnd * (NBr) * Sgn(Cos(Rnd * 360)) E(q, tut).z = (NBr) E(q, tut).diam = (1080 / 180) + Rnd * diamEtoile * 4 E(q, tut).r = Rnd * .8125 E(q, tut).g = Rnd * .8125 E(q, tut).b = Rnd * .8125
If E(q, tut).b > E(q, tut).r Then E(q, tut).r = (30 + Rnd * 25) / 655 E(q, tut).g = (92 + Rnd * 60) / 655 E(q, tut).b = (193 - Rnd * 60) / 655 Else E(q, tut).g = E(q, tut).g + E(q, tut).b E(q, tut).r = E(q, tut).r * .2 End If If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b And Rnd < .5 Then E(q, tut).r = E(q, tut).g * (1 + Rnd * .1) E(q, tut).vit = 10 + Rnd * 30 E(q, tut).dx = (Rnd - Rnd) * (.05 + Rnd * .025) E(q, tut).dy = (Rnd - Rnd) * (.05 + Rnd * .025) If Rnd > .8 Then If E(q, tut).r > E(q, tut).g And E(q, tut).r > E(q, tut).b Then E(q, tut).r = .82: E(q, tut).g = E(q, tut).r * Rnd E(q, tut).b = 0 GoTo ppp End If If E(q, tut).g > E(q, tut).r And E(q, tut).g > E(q, tut).b Then E(q, tut).g = .82 If Rnd > .5 Then E(q, tut).b = E(q, tut).g * Rnd Else E(q, tut).r = E(q, tut).g * (1 + Rnd) If Rnd > .95 Then E(q, tut).r = 0: E(q, tut).b = E(q, tut).b * .1 GoTo ppp2 End If If E(q, tut).b > E(q, tut).r And E(q, tut).b > E(q, tut).g Then E(q, tut).b = .82 E(q, tut).g = E(q, tut).b * Rnd E(q, tut).r = 0 End If End If ppp2: End If End If Next Next yy Next xx End Sub Sub cerclefumee (afx, afy, r, cr, ut1, ut2, aaa, hr, hg, hb) Static ut If ut = 0 Then ut = ut1 For aa = 0 To r * 2 Step ut For bb = 0 To r * 2 Step ut cl = (maCv(r, aa, bb)) i% = aa - r j% = bb - r alpha = cl * aaa PSet (afx + i%, afy + j%), _RGBA((hr * 100) * alpha, (100 * hg) * alpha, (100 * hb) * alpha, cr * alpha) Next bb, aa If ut = ut2 Then ut = ut1 Else ut = ut2 End Sub Sub cercle (afx, afy, r, hr, hg, hb, aaa, ut1, ut2) Static ut If ut = 0 Then ut = ut1 For aa = 0 To r * 2 Step ut For bb = 0 To r * 2 Step ut cl = (maCv(r, aa, bb)) * 1.3 i% = aa - r j% = bb - r alpha = cl * 2 Line (afx + i%, afy + j%)-(afx + i% + ut, afy + j% + ut), _RGBA((cl * 128 * hr), (cl * 128 * hg), (cl * 128 * hb), 150 * alpha * aaa), BF Next bb Next aa If ut = ut2 Then ut = ut1 Else ut = ut2 End Sub
|
|
|
Post by bplus on Jul 8, 2024 19:27:39 GMT
nice wavey banner!
|
|