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