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