FBTrueType static Win/Lin 32/64-bit

External libraries (GTK, GSL, SDL, Allegro, OpenGL, etc) questions.
Post Reply
owen
Posts: 552
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:
Contact owen

Re: FBTrueType static Win/Lin 32/64-bit

Postby owen » Jun 15, 2019 3:32

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)
Top
owen
Posts: 552
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:
Contact owen

Re: FBTrueType static Win/Lin 32/64-bit

Postby owen » Jun 15, 2019 8:09

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
Top
owen
Posts: 552
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:
Contact owen

Re: FBTrueType static Win/Lin 32/64-bit

Postby owen » Jun 16, 2019 10:24

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.
Top
jupe
Posts: 2
Joined: Oct 06, 2019 15:58

Re: FBTrueType static Win/Lin 32/64-bit

Postby jupe » Oct 06, 2019 16:17

any ideas how i can handle thing anyone knows someone dont have C in their boot partion drive label? more than likely my mother for example has E in such device.
Top
srvaldez
Posts: 2152
Joined: Sep 25, 2005 21:54

Re: FBTrueType static Win/Lin 32/64-bit

Postby srvaldez » Oct 06, 2019 17:12

@jupe
are you a BOT ?
Top
Knatterton
Posts: 165
Joined: Apr 19, 2019 19:03

Re: FBTrueType static Win/Lin 32/64-bit

Postby Knatterton » Oct 06, 2019 17:31

owen wrote:

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


Here is the linux version:

Code: Select all

' show_ttf_linux.bas

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

Dim As String fontfile,fontfiles()
Dim As Integer font_c
Dim As Long font
fontfile=dir("/usr/share/fonts/truetype/dejavu/*.ttf")
Do
   If fontfile="" Then
      Exit Do
   Else
      font = FontLoad("/usr/share/fonts/truetype/dejavu/" & 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("/usr/share/fonts/truetype/dejavu/" & 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("/usr/share/fonts/truetype/dejavu/" & 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("/usr/share/fonts/truetype/dejavu/" & fontfiles(selected_font))
      TTPrint font,500,20, "Hello World",rgb(255,255,255),80
      FontDestroy()
      ScreenUnLock
   End If
   Sleep 1
Loop


Drawback: in this folder all fonts are in separate subfolders...
Top
Post Reply

Return to “Libraries”

Who is online

Users browsing this forum: MSN [Bot] and 1 guest