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)
FBTrueType static Win/Lin 32/64-bit
Re: FBTrueType static Win/Lin 32/64-bit
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
Re: FBTrueType static Win/Lin 32/64-bit
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.
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.
Re: FBTrueType static Win/Lin 32/64-bit
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.
Re: FBTrueType static Win/Lin 32/64-bit
@jupe
are you a BOT ?
are you a BOT ?
-
- Posts: 165
- Joined: Apr 19, 2019 19:03
Re: FBTrueType static Win/Lin 32/64-bit
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...
Who is online
Users browsing this forum: MSN [Bot] and 1 guest