Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Text in the form of a circle
#1
Code: (Select All)
_Title "Round text"
Screen _NewImage(1024, 768, 32)
R = 75
ct& = RoundText&("QB64 Phoenix call: Hello World!  ", R, _Pi(1.5))
_PutImage (512 - R, 384 - R), ct&
_Display


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


Attached Files Image(s)
   


Reply
#2
(02-25-2023, 02:09 PM)Petr Wrote:
Code: (Select All)
_Title "Round text"
Screen _NewImage(1024, 768, 32)
R = 75
ct& = RoundText&("QB64 Phoenix call: Hello World!  ", R, _Pi(1.5))
_PutImage (512 - R, 384 - R), ct&
_Display


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

Very good stuff !
Reply
#3
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


Reply
#4
I've got one that works similar to this, that's been in my toolbox forever:

Code: (Select All)
_Define A-Z As _FLOAT
Dim BlendedScreen As Long

ViewScreen = _NewImage(800, 800, 32): Screen ViewScreen


CreateBlendedScreen 'Create a blended screen of colors
Screen BlendedScreen 'Display that  screen
Sleep 'Pause so folks can view that screen

'For fun, add some fontage to the screen also
Color &HFF000000, 0 'Black with transparent background
f = _LoadFont("cour.ttf", 48)
If f > 0 Then
    _Font f
    w = _PrintWidth("Hello World! We love STEVE! He's Sooo AWESOME!")
    sw = _Width: sh = _Height
    _PrintString ((sw - w) \ 2 + 1, 0), "Hello World! We love STEVE! He's Sooo AWESOME!"
End If

Sleep 'Give the user the time to see our nice screen pattern which we're going to "warp" to our circle.


Screen ViewScreen 'Swap back over to our main screen
CreateCircle 400, 400, 400, 100 'Use that blended screen as reference so we can plot/color our circle in that same pattern
Sleep 'Pause to show the circle before ending the demo
System


Sub CreateCircle (Xcenter, YCenter, radius As Long, width As Long)
    Shared BlendedScreen As Long
    p = _Pi(2) * radius
    tempimage = _NewImage(p, width, 32)
    _PutImage , BlendedScreen, tempimage
    _Source tempimage
    For i = 0 To p - 1 Step .25
        For w = 0 To width - 1
            ai = 360 / p
            a = _D2R(ai * i)
            x = Xcenter - Sin(a) * (radius - w)
            y = YCenter + Cos(a) * (radius - w)
            PSet (x, y), Point(i, w)
        Next
    Next
    _Source 0
    _FreeImage tempimage
End Sub


Sub CreateBlendedScreen
    Shared BlendedScreen As Long
    If BlendedScreen = 0 Then BlendedScreen = _NewImage(1536, 50, 32) Else Exit Sub
    'step from red to green
    Dim kolor As _Float, i As _Float
    _Dest BlendedScreen
    For i = 0 To 255
        kolor = kolor + 1
        Line (i, 0)-Step(0, 99), _RGB32(255, kolor, 0)
    Next
    For i = 256 To 511
        kolor = kolor - 1
        Line (i, 0)-Step(0, 99), _RGB32(kolor, 255, 0)
    Next
    For i = 512 To 767
        kolor = kolor + 1
        Line (i, 0)-Step(0, 99), _RGB32(0, 255, kolor)
    Next
    For i = 768 To 1023
        kolor = kolor - 1
        Line (i, 0)-Step(0, 99), _RGB32(0, kolor, 255)
    Next
    For i = 1024 To 1279
        kolor = kolor + 1
        Line (i, 0)-Step(0, 99), _RGB32(kolor, 0, 255)
    Next
    For i = 1280 To 1535
        kolor = kolor - 1
        Line (i, 0)-Step(0, 99), _RGB32(255, 0, kolor)
    Next
    _Dest ViewScreen
End Sub


   
Reply
#5
Yes, very similar... two discs, with text between ! Big Grin
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#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
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply




Users browsing this thread: 2 Guest(s)