Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Is there a faster way to do this glow circle effect?
#3
faster? better light for sure
Code: (Select All)
_Title "text over search light, move mouse wheel" 'started 2019-04-21 B+

Const xmax = 800
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove _Middle
Dim txt(1 To 37) As String, v(1 To 37)
For i = 1 To 37
    b$ = ""
    For j = 1 To 100
        b$ = b$ + Chr$(Int(Rnd * 96) + 32)
    Next
    txt(i) = b$: v(i) = Int(Rnd * 3) + 1
Next
r = 100
Color _RGB32(40, 20, 10), _RGBA32(0, 0, 0, 40)
While _KeyDown(27) = 0
    Cls
    Do While _MouseInput
        r = r + _MouseWheel
    Loop
    mx = _MouseX: my = _MouseY
    For i = r To 0 Step -1
        fcirc mx, my, i, _RGB((r - i) ^ 1.2 / r * 255, (r - i) / r * 255, (r - i) / r * 255)
    Next
    For i = 1 To 37
        txt(i) = Mid$(txt(i), v(i)) + Mid$(txt(i), 1, v(i) - 1)
        Locate i, 1: Print Mid$(txt(i), 1, 100);
    Next
    _Display
    _Limit 5
Wend

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
b = b + ...
Reply


Messages In This Thread
RE: Is there a faster way to do this glow circle effect? - by bplus - 06-16-2024, 01:39 PM



Users browsing this thread: 6 Guest(s)