Text sub, any place, any size, any color
#3
Actually this might be a better system if you need to show a font and every angle and axis scale:
Code: (Select All)
_Title "Scale rotate font text strings." 'B+ started

' The following CONSTants or TYPES are for the demo and NOT needed for the 2 main subs

Randomize Timer
Const xmax = 1200
Const ymax = 700
Const x0 = 600
Const y0 = 350
Const radius = 240
Const r2 = 20
Dim Shared fv72& ' testing verdanab.ttf
fv72& = _LoadFont("verdanab.ttf", 72)

Screen _NewImage(xmax, ymax, 32)
_Delay .25
_ScreenMove _Middle
''test font load
'_FONT fv72&
'S$ = "helloworld pdq"
'PRINT S$, _PRINTWIDTH(S$), _FONTHEIGHT(fv72&)
'LINE (0, 0)-STEP(_PRINTWIDTH(S$), _FONTHEIGHT(fv72&)), , B
'END

a = 1: dir = 1: dir2 = 1: runner = 0
ca = _Pi(2 / 20)
t$ = "Scale and rotate text strings"
While _KeyDown(27) = 0
    Color , _RGB32(runner Mod 255, runner Mod 255, 128)
    Cls

    ''this demos stretching and shrinking the xScale while the text string is turned + and - Pi/2 or 90 degrees
    'left side red
    drwString t$, &HFF992200, 300, ymax / 2, 10 * Abs(rot), .5, _Pi(-.5)
    ''right side green
    drwString t$, &HFF008800, xmax - 300, ymax / 2, 10 * Abs(rot), .5, _Pi(.5)

    ''this demos rotaing a text string about the x axis at 3 times default font scale, rot range -1 to 1
    drwString t$, &HFF0000FF, xmax / 2, 32, 1, 1 * rot, 0

    ''this demos rotaing a text string about the y axis at 3 times default font scale, rot range -1 to 1
    drwString t$, &HFF00FF00, xmax / 2, ymax - 32, 1 * rot, 1, 0

    ''this demos rotating a text string from 0 to 2 Pi radians and reverse 0 to -2 Pi
    ''and shrinking both the xScale and yScale at same time and amount
    drwString t$, &HFFFF0066, xmax / 2, ymax / 2, Abs(rot) * 2, Abs(rot) * 2, a

    'this demos moving .5 sized numbers around a circle angled so the circle is the bottom of number
    Circle (x0, y0), radius
    For i = 0 To 19
        x = x0 + (radius + 18) * Cos(ca * i - 4.5 * ca)
        y = y0 + (radius + 18) * Sin(ca * i - 4.5 * ca)
        s = (i + runner) Mod 20
        drwString _Trim$(Str$(s)), &HFFFFFFFF, x, y, .5, .5, ca * i - 4.5 * ca + _Pi(.5)
    Next
    Print "Hello Default Font."

    runner = runner + 1
    rot = rot + .025 * dir
    If rot > 1 Then dir = -dir: rot = 1
    If rot < -1 Then dir = -dir: rot = -1
    a = a + _Pi(1 / 45) * dir2
    If a > _Pi(2) Then dir2 = -dir2: a = _Pi(2)
    If a < _Pi(-2) Then dir2 = -dir2: a = _Pi(-2)

    _Display
    _Limit 5
Wend

'drwString needs sub RotoZoom2, intended for graphics screens using the default font.
'S$ is the string to display
'c is the color (will have a transparent background)
'midX and midY is the center of where you want to display the string
'xScale would multiply 8 pixel width of default font
'yScale would multiply the 16 pixel height of the default font
'Rotation is in Radian units, use _D2R to convert Degree units to Radian units
Sub drwString (S$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation)
    storeFont& = _Font
    storeDest& = _Dest
    _Font fv72& ' loadfont at start and share handle
    I& = _NewImage(_PrintWidth(S$), _FontHeight(fv72&), 32)
    _Dest I&
    _Font fv72&
    Color c, _RGBA32(0, 0, 0, 0)
    _PrintString (0, 0), S$
    _Dest storeDest&
    RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
    _FreeImage I&
    _Font storeFont&
End Sub

'This sub gives really nice control over displaying an Image.
Sub RotoZoom2 (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
    Dim px(3) As Single: Dim py(3) As Single
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
    For i& = 0 To 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub

   
b = b + ...
Reply


Messages In This Thread
RE: Text sub, any place, any size, any color - by bplus - 05-15-2022, 06:57 PM



Users browsing this thread: 4 Guest(s)