Text in the form of a circle
#6
(02-25-2023, 08:12 PM)Petr Wrote: Thank you, @CharlieJV here is small modification - program create animation from text. 

Code: (Select All)
_Title "Round text as animation"
Screen _NewImage(1024, 768, 32)
'easy way for creating animation
$Color:32
Dim Video(40) As Long
AngleStep = _Pi(2) / 40
R = 50
'create animation frames
For VF = 1 To 40
    Psi = Psi + (_Pi(1) / 40)
    Video(VF) = RoundText&("QB64 Phoenix call: Hello World!  ", 20 + Sin(Psi) * R, Angle)
    Angle = Angle + AngleStep
Next VF

'play video
Locate 1: Print "Press Esc to end."
Do Until K& = 27
    For PV = 1 To 40
        K& = _KeyHit
        _PutImage (512 - _Width(Video(PV)) / 2, 384 - _Height(Video(PV)) / 2), Video(PV)
        _Display
        _Limit 20
        Line (412, 284)-(612, 484), Black, BF
    Next
Loop

'free memory after end
For FM = 1 To 40
    _FreeImage Video(FM)
Next FM
End


Function RoundText& (text As String, InternalRadius As Integer, StartRadius As Single)
    D = _Dest: So = _Source
    VImg& = _NewImage(_PrintWidth(text) + 1, _FontHeight + 1, 32)
    Ob = (InternalRadius + _FontHeight)
    Ol = InternalRadius
    _Dest VImg&: _PrintString (0, 0), text$: _Dest D
    R& = _NewImage((InternalRadius + _FontHeight) * 2, (InternalRadius + _FontHeight) * 2, 32)
    U = _Width(R&) / 2
    Dim X(4), Y(4), sX(4), sY(4)
    S = 200
    PW = _PrintWidth(text)
    p2 = CInt(PW / S)
    For C = StartRadius To StartRadius + _Pi(2) Step (_Pi(2) / S) ' 200 steps
        'dest
        X(1) = U + Cos(C) * Ob
        Y(1) = U + Sin(C) * Ob
        X(2) = U + Cos(C) * Ol
        Y(2) = U + Sin(C) * Ol
        X(3) = U + Cos(C + _Pi(2) / S) * Ob
        Y(3) = U + Sin(C + _Pi(2) / S) * Ob
        X(4) = U + Cos(C + _Pi(2) / S) * Ol
        Y(4) = U + Sin(C + _Pi(2) / S) * Ol
        'source
        sX(1) = (PW / S) * n
        sY(1) = 0
        sX(2) = sX(1)
        sY(2) = _FontHeight
        sX(3) = sX(1) + PW / S
        sY(3) = 0
        sX(4) = sX(3)
        sY(4) = sY(2)

        n = n + p2
        If n > S Then Exit For
        _MapTriangle (sX(1), sY(1))-(sX(2), sY(2))-(sX(3), sY(3)), VImg& To(X(1), Y(1))-(X(2), Y(2))-(X(3), Y(3)), R&
        _MapTriangle (sX(2), sY(2))-(sX(3), sY(3))-(sX(4), sY(4)), VImg& To(X(2), Y(2))-(X(3), Y(3))-(X(4), Y(4)), R&
    Next
    RoundText& = R&
End Function

Wow, I like that one Petr! Nice job.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Reply


Messages In This Thread
Text in the form of a circle - by Petr - 02-25-2023, 02:09 PM
RE: Text in the form of a circle - by CharlieJV - 02-25-2023, 04:28 PM
RE: Text in the form of a circle - by Petr - 02-25-2023, 08:12 PM
RE: Text in the form of a circle - by PhilOfPerth - 02-26-2023, 01:12 AM
RE: Text in the form of a circle - by SMcNeill - 02-26-2023, 12:32 AM
RE: Text in the form of a circle - by PhilOfPerth - 02-26-2023, 01:09 AM



Users browsing this thread: 1 Guest(s)