FBTrueType static Win/Lin 32/64-bit

[owen]

i see it is not necessary to copy fonts to the folder of the source code.
specifying the path is possible.
font = FontLoad("c:\windows\fonts\" & fontfilename)

[owen]

Code: Select all

#include once "FBTrueType.bi"
screenres 1000,400,32

Dim As String fontfile,fontfiles()
Dim As Integer font_c
Dim As Long font
fontfile=Dir("c:\windows\fonts\*.ttf")
Do
   If fontfile="" Then
      Exit Do
   Else
      font = FontLoad("c:\windows\fonts\" & fontfile)
      If font>0 Then
         font_c+=1
         ReDim Preserve fontfiles(font_c)
         fontfiles(font_c)=fontfile
         FontDestroy()
      EndIf
      fontfile=Dir()
   EndIf
Loop
For i As Integer = 1 To font_c
   fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
   font = FontLoad("c:\windows\fonts\" & fontfiles(i))
   TTPrint font,10,20*i-20, fontfile,rgb(255,255,255),20
   FontDestroy()
Next



Dim As Integer mr,mx,my,myp,mw,mwp,mb,mc
Dim As Integer wy
Dim As Integer selected_font,selected_font_p
Do
   Select Case InKey
      Case Chr(27),Chr(255)+"k"
         Exit Do
   End Select
   mr=GetMouse(mx,my,mw,mb,mc)
   If mr=0 And mw<>mwp Then
      If mw>mwp Then
         wy+=20
      Else
         wy-=20
      EndIf
      If wy>0 Then wy=0
      If wy<font_c*20*-1+400 Then wy=font_c*20*-1+400
      mwp=mw
   EndIf
   mw=0
   selected_font=(my+10)/20+Abs(wy)/20
   If selected_font<>selected_font_p Then
      selected_font_p=selected_font
      ScreenLock
      Cls
      For i As Integer = 1 To font_c
         Select Case 20*i-20+wy
            Case -20 To 400
               fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
               font = FontLoad("c:\windows\fonts\" & fontfiles(i))
               If i=selected_font Then
                  TTPrint font,10,20*i-20+wy, fontfile,rgb(255,0,255),20
               Else
                  TTPrint font,10,20*i-20+wy, fontfile,rgb(255,255,255),20
               EndIf
               
               FontDestroy()
         End Select
      Next
      font = FontLoad("c:\windows\fonts\" & fontfiles(selected_font))
      TTPrint font,500,20, "Hello World",rgb(255,255,255),80
      FontDestroy()
      ScreenUnLock
   End If
   Sleep 1
Loop


[owen]

this is really a great contribution to fb.

i never knew what was involved in ttf and now we have otf to look forward to.

fonts are all about kerning and white space and a whole lot more so i'm finding out.