Text sub, any place, any size, any color

[bplus]

Here is a demo of Text sub

Code: (Select All)

_Title "Demo Text Sub" ' b+ 2022-05-15
Const w = 1024, h = 600, wd2 = 512, hd2 = 300
Screen _NewImage(w, h, 32)
_ScreenMove 80, 0
txt$ = "Hello World"
For textHeight = 1 To hd2 / 2
    Cls
    r = 255 * textHeight / (hd2 / 2)
    Text wd2 - .5 * (textHeight / 16) * 8 * Len(txt$), hd2 - textHeight / 2, textHeight, _RGB32(r, 0, 255 - r), txt$
    _Display
    _Limit 30
Next

Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
    Dim fg As _Unsigned Long, cur&, I&, multi, xlen
    fg = _DefaultColor
    cur& = _Dest
    I& = _NewImage(8 * Len(txt$), 16, 32)
    _Dest I&
    Color K, _RGBA32(0, 0, 0, 0)
    _PrintString (0, 0), txt$
    multi = textHeight / 16
    xlen = Len(txt$) * 8 * multi
    _PutImage (x, y)-Step(xlen, textHeight), I&, cur&
    Color fg
    _FreeImage I&
End Sub

[OldMoses]

I like this one. Nice and modular, can be used anywhere. That inspires me to post one of my image subs, once I get some demo code to wrap around it.

[bplus]

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