ok i found the main bug
Code: (Select All)
myfont$ = Environ$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
Dim Shared m_fnt(99, 199), m_trw(999), m_fntset(3), m_lasttext$
sc = _NewImage(350, 350 / 2, 32): Screen sc:
_ScreenMove _Middle
_DisplayOrder _Hardware
'make background
temp = _NewImage(_Width, _Height, 32): _Dest temp
For x = 0 To _Width: For y = 0 To _Height: t = 0: PSet (x, y), _RGB32(255, 255, 255): Next y, x
bground = _CopyImage(temp, 33): _FreeImage temp
m_fontsettings "<", ">", 33
m_fontadd 1, myfont$, _RGBA32(0, 0, 0, 190), _RGBA32(255, 255, 255, 0), 0, 400, .97, 1.26
_Dest sc
Do: _Limit 30
_PutImage , bground
m_printstring 40, 60, "<fi1><fh11>QB64 Hardware Text", 1, 0
'm_printstring_center 100, "<fi1><fh16>111", 0, 0 ' Unremark this line to get it to work.
_Display
Loop Until _KeyDown(27)
Sub m_fontsettings (a$, b$, x): m_fntset(0) = Asc(a$): m_fntset(1) = Asc(b$): m_fntset(2) = x: End Sub
Sub m_fontadd (i, f$, c As _Integer64, c2 As _Integer64, shmove, fs, xmulti, spfnt)
m_fnt(i, 0) = fs
m_fnt(i, 1) = _LoadFont(f$, fs)
m_fnt(i, 2) = _Red32(c)
m_fnt(i, 3) = _Green32(c)
m_fnt(i, 4) = _Blue32(c)
m_fnt(i, 5) = _Alpha32(c)
m_fnt(i, 6) = xmulti
m_fnt(i, 7) = 0
m_fnt(i, 10) = _Red32(c2)
m_fnt(i, 11) = _Green32(c2)
m_fnt(i, 12) = _Blue32(c2)
m_fnt(i, 13) = _Alpha32(c2)
m_fnt(i, 14) = shmove
m_fnt(i, 15) = spfnt
End Sub
Sub m_fontaddpic (i, f$, pic_handle, pic_alpha, pic_multi, c2 As _Integer64, shmove, fs, xmulti, spfnt)
m_fnt(i, 0) = fs
m_fnt(i, 1) = _LoadFont(f$, fs)
m_fnt(i, 2) = pic_handle
m_fnt(i, 3) = -1
m_fnt(i, 4) = pic_alpha
m_fnt(i, 5) = pic_multi
m_fnt(i, 6) = xmulti
m_fnt(i, 7) = 0
m_fnt(i, 10) = _Red32(c2)
m_fnt(i, 11) = _Green32(c2)
m_fnt(i, 12) = _Blue32(c2)
m_fnt(i, 13) = _Alpha32(c2)
m_fnt(i, 14) = shmove
m_fnt(i, 15) = spfnt
End Sub
Function m_printwidth (t$): concatenation (t$): m_printwidth = m_trw(1): End Function
Function m_printheight (t$): concatenation (t$): m_printheight = m_trw(2): End Function
Sub m_printstring_center (py, t$, r1, r2): concatenation (t$): ps (_Width - m_trw(1)) / 2 + 1, py, r1, r2: End Sub
Sub m_printstring_right (py, t$, marg, r1, r2): concatenation (t$): ps _Width - marg - m_trw(1), py, r1, r2: End Sub
Sub rotate_2d (x, y, ang): x1 = x * Cos(ang) - y * Sin(ang): y1 = x * Sin(ang) + y * Cos(ang): x = x1: y = y1: End Sub
Sub m_printstring (px, py, t$, r1, r2): concatenation (t$): ps px, py, r1, r2: End Sub
Sub ps (sx, sy, r1, r2)
ReDim r(1), t(4, 1)
t(4, 0) = sx: t(4, 1) = sy
r(0) = m_trw(1) / 2 * r1
r(1) = -m_trw(2) / 2
For t = 0 To m_trw(0) - 1
si = 20 + t * 6
t(0, 0) = m_trw(si + 1): t(0, 1) = m_trw(si + 2): t(1, 0) = m_trw(si + 3): t(1, 1) = m_trw(si + 2)
t(2, 0) = m_trw(si + 1): t(2, 1) = m_trw(si + 4): t(3, 0) = m_trw(si + 3): t(3, 1) = m_trw(si + 4)
If Sgn(r2) Then
For t1 = 0 To 3: t(t1, 0) = t(t1, 0) - r(0): t(t1, 1) = t(t1, 1) - r(1): rotate_2d t(t1, 0), t(t1, 1), r2
t(t1, 0) = t(t1, 0) + r(0): t(t1, 1) = t(t1, 1) + r(1): Next t1
End If
For t1 = 0 To 7: t2 = Int(t1 * .5): t3 = t1 And 1: t(t2, t3) = t(t2, t3) + t(4, t3): Next t1
w = _Width(m_trw(si)) - 1: h = _Height(m_trw(si)) - 1
_MapTriangle (0, 0)-(w, 0)-(0, h), m_trw(si) To(t(0, 0), t(0, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))
_MapTriangle (w, h)-(w, 0)-(0, h), m_trw(si) To(t(3, 0), t(3, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))
Next t
End Sub
Sub concatenation (t$)
If t$ = m_lasttext$ Then Exit Sub
m_lasttext$ = t$
m_trw(0) = 0
ind = 0: tr_c = 0: f_size = 10
Do Until ac >= Len(t$): ac = ac + 1: ac$ = Mid$(t$, ac, 1)
If ac$ = Chr$(m_fntset(0)) Then
vh = InStr(ac + 1, t$, Chr$(m_fntset(1))): If vh = 0 Then Print "syntax error in text command": End
v = Val(Mid$(t$, ac + 3, vh - ac - 3))
Select Case LCase$(Mid$(t$, ac + 1, 2))
Case "fi": ind = v
Case "fh": f_size = v
End Select
ac = vh
Else
find = -1
If Sgn(m_fnt(ind, 7)) Then
For t = 20 To 20 + m_fnt(ind, 7) * 5
If Asc(ac$) = m_fnt(ind, t) Then find = t: Exit For
Next t
End If
If find = -1 Then
find = 20 + m_fnt(ind, 7) * 5
savedest = _Dest
_Font m_fnt(ind, 1)
sh = m_fnt(ind, 14)
pwac = _PrintWidth(ac$)
temp2 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)
m_fnt(ind, find + 2) = 1 / (m_fnt(ind, 0) + sh) * (pwac + sh) * m_fnt(ind, 6) 'accel
m_fnt(ind, find + 3) = 1 / m_fnt(ind, 0) * (m_fnt(ind, 0) + sh) * 1.2 'accel
m_fnt(ind, find + 4) = 1 / m_fnt(ind, 0) * pwac * m_fnt(ind, 6) * m_fnt(ind, 15) 'accel
_Dest temp2: Cls , 0
_Font m_fnt(ind, 1)
Color _RGBA32(m_fnt(ind, 10), m_fnt(ind, 11), m_fnt(ind, 12), m_fnt(ind, 13)), 0
_PrintString (sh, sh), ac$
If m_fnt(ind, 3) = -1 Then
temp11 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)
_Dest temp11
sy = m_fnt(ind, 5) * _Width(m_fnt(ind, 2))
sx = sy / _Height * _Width
_MapTriangle (0, 0)-(sx, 0)-(0, sy), m_fnt(ind, 2) To(0, 0)-(_Width, 0)-(0, _Height)
_MapTriangle (sx, sy)-(sx, 0)-(0, sy), m_fnt(ind, 2) To(_Width, _Height)-(_Width, 0)-(0, _Height)
_SetAlpha m_fnt(ind, 4)
temp10 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)
_Dest temp10
Cls , _RGB32(0, 0, 0)
_Font m_fnt(ind, 1)
Color _RGB32(255, 255, 255)
_PrintString (0, 0), ac$
_SetAlpha 0, _RGB32(255, 255, 255) To _RGB32(1, 1, 1)
_Dest temp11
_PutImage , temp10
_ClearColor _RGB32(0, 0, 0)
_Dest temp2
_PutImage , temp11
_FreeImage temp10
_FreeImage temp11
Else
Color _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4)), 0
_PrintString (0, 0), ac$
_SetAlpha m_fnt(ind, 5), _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4))
End If
m_fnt(ind, find + 1) = _CopyImage(temp2, m_fntset(2))
_FreeImage temp2
m_fnt(ind, find) = Asc(ac$)
_Dest savedest
m_fnt(ind, 7) = m_fnt(ind, 7) + 1
End If
si = m_trw(0) * 6 + 20
m_trw(si) = m_fnt(ind, find + 1) 'text
m_trw(si + 1) = actual_x
m_trw(si + 2) = -f_size
m_trw(si + 3) = m_trw(si + 1) + f_size * m_fnt(ind, find + 2)
m_trw(si + 4) = m_trw(si + 2) + f_size * m_fnt(ind, find + 3)
m_trw(si + 5) = ac$ = " "
actual_x = m_trw(si + 1) + f_size * m_fnt(ind, find + 4)
m_trw(0) = m_trw(0) + 1
End If
If f_size > f_sizemax Then f_sizemax = f_size
Loop
m_trw(1) = actual_x
m_trw(2) = f_sizemax
End Sub