TBGL-FontFromFile?

[ReneMiner]

Would there be a possibility to load .ttf-fonts from a file without to have them installed, so they can be used in TBGL?
Or could TB(GL) install such font temporary - just for the duration of script-execution somehow - maybe could have to "clean-up" manually after TBGL-window is destroyed?

Perhaps create some small Font-Module that can be included through Uses "Font" so both - UI and TBGL - could work with temporary installed fonts?

Would only need two or three functions:

String FontName = Font_Install(Filename)
If Font_Exists(FontName ) Then Font_Uninstall(FontName)

... I know this (http://msdn.microsoft.com/en-us/library/dd183326%28v=vs.85%29.aspx) could be helpful - but I don't get it together...

[Petr Schreiber]

Hi Rene,

interesting request. For which reason would you hesitate to install the font first?
If you have license for it, you can use it, if you don't, even this use would be illegal :)


Petr

[ReneMiner]

There are loads of free fonts available and I could create my own.
And the reason is: Not everyone has the same fonts installed I have- for a game or gui I might need a special/monospaced one that none else has installed by default. If user has to fear some copyright-problem so it's his own fault: Would be the same if I would use TBGL-FontCreator on some by copyright law protected font and ship it with my app - I would be responsible.

[Petr Schreiber]

I see,

most programs solve this by having installer - for example innoSetup is free and works good.
But I will think more about this, ability to drop user EXE without need for installing is comfortable.


Petr

[Petr Schreiber]

Hi Rene,

something to get you started in the attachement - it shows how to use AddFontResource/RemoveFontResource.
Maybe it could be added as native Font_Add, Font_Remove...

I am leaving outside to get lost in the woods for the rest of the day, my eyes are burning after PC weekend :D


Petr

[ReneMiner]

That works! But now I need to retrieve the Fonts name somehow - probably have to use UI-Function Font_List before and after install to compare and find out the new fonts name. I'm just not happy with that because means have to use "UI" just for this. Maybe is possible adapt Font_List-function from UI or create another? Or is there a way to retrieve the fonts name out of the file somehow? The modified script below uses UI anyway...(above attached version did not really uninstall since hFont was not static)... but what if use TBGL only?



Uses "UI"

' -- ID numbers of controls
Begin ControlID
%lFontDemo
%bClose
End ControlID

Begin Const
$FontFile = APP_SourcePath + "scrgunny\scrgunny.ttf"

%MAIN_WIDTH = 320
%MAIN_HEIGHT = 240
End Const

Declare Function AddFontResource Lib "GDI32.DLL" Alias "AddFontResourceA" (ByRef lpszFilename As Asciiz) As Long
Declare Function RemoveFontResource Lib "GDI32.DLL" Alias "RemoveFontResourceA" (ByRef lpFileName As Asciiz) As Long

' -- Create dialog here
Function TBMain()
Local hDlg As DWord

Dialog New Pixels, 0, "Testing font magic",-1,-1, %MAIN_WIDTH, %MAIN_HEIGHT, _
%WS_POPUP Or %WS_VISIBLE Or %WS_CAPTION Or %WS_SYSMENU Or %WS_MINIMIZEBOX To hDlg

' -- Place controls here
Control Add Label, hDlg, %lFontDemo, "Some text using default font", 10, 10, %MAIN_WIDTH-20, 40
Control Add Button, hDlg, %bClose, "Click to close", %MAIN_WIDTH-105, %MAIN_HEIGHT-30, 100, 25, Call cbCloseButton

Dialog Show Modal hDlg, Call cbDialog

End Function

' -- Callback for dialog
CallBack Function cbDialog()

Static hFont As DWord

' -- Test for messages
Select Case CBMSG

Case %WM_INITDIALOG
' -- Put code to be executed after dialog creation here
String sFontname = Font_Install($FontFile)

If sFontName = "" Then
MsgBox 0, "Failed to install"
Else
MsgBox 0, "Success installing the font"
SendMessage(CBHNDL, %WM_FONTCHANGE, 0, 0)

hFont = Font_Create(sFontname, 18)
Control Send CBHNDL, %lFontDemo, %WM_SETFONT, hFont, 0
Control Set Text CBHNDL, %lFontDemo, "Some text using new font"
Control Redraw CBHNDL, %lFontDemo
End If

Case %WM_CLOSE
If hFont Then
Win_DeleteObject(hFont)
If RemoveFontResource($FontFile) Then
MsgBox 0, "Success uninstalling the font"
Else
MsgBox 0, "Failed to uninstall"
EndIf
EndIf
End Select

End Function

' -- Callback for close button
CallBack Function cbCloseButton()

If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
' -- Closes the dialog
Dialog End CBHNDL
End If
End If

End Function
' -----------------------------
Function FONT_Install(ByVal sFile As String) As String

Local sList As String = Font_List
Local sOld(), sNew() As String
Local i As Long

If AddFontResource(sFile) Then
Parse sList, sOld, $TAB
sList = Font_List
Parse sList, sNew, $TAB

For i = 1 To UBound(sNew)
If Not Array Scan sOld, = sNew(i) Then Return sNew(i)
Next
EndIf

End Function

[Petr Schreiber]

I think we could build together font specific include file - this is nothing performance intensive, so module would not bring anything new.
I will check how to retrieve font name from TTF...


Petr

[Petr Schreiber]

Hi Rene,

this seems to work - font must be installed, but it is still better than going through the list:


Uses "Console"

Declare Function AddFontResource Lib "GDI32.DLL" Alias "AddFontResourceA" (ByRef lpszFilename As Asciiz) As Long
Declare Function RemoveFontResource Lib "GDI32.DLL" Alias "RemoveFontResourceA" (ByRef lpFileName As Asciiz) As Long

Declare Function GetFontResourceInfo Lib "GDI32.DLL" Alias "GetFontResourceInfoW"(ByVal lpszFilename As DWord, ' -- font file Name
ByRef cbBuffer As DWord, ' -- size of buffer for resouce information
ByVal lpBuffer As DWord, ' -- buffer for returned resouce information
ByVal dwQueryType As DWord ) As Long ' -- resouce information query type

Function TBMain()
Dim azFontFile As Asciiz * 256
azFontFile = APP_SourcePath + "scrgunny\" + "scrgunny.ttf"
Dim wFontFile As String = Ucode$(azFontFile)
Dim wBuffer As String = Repeat$(512, " ")

AddFontResource(azFontFile)

DWord sizeOfWBuffer = Len(wBuffer)
PrintL "Testing file: " + azFontFile
PrintL GetFontResourceInfo(StrPtr(wFontFile), sizeOfWBuffer, StrPtr(wBuffer), 1)
PrintL "Name is: " + Acode$(wBuffer), Len(wBuffer)


RemoveFontResource(azFontFile)
WaitKey

End Function


Petr

[ReneMiner]

OK. It works. I added a little to get the real string out of it- so truncate all $NUL-Chars


Uses "Console"

Declare Function AddFontResource Lib "GDI32.DLL" Alias "AddFontResourceA" (ByRef lpszFilename As Asciiz) As Long
Declare Function RemoveFontResource Lib "GDI32.DLL" Alias "RemoveFontResourceA" (ByRef lpFileName As Asciiz) As Long

Declare Function GetFontResourceInfo Lib "GDI32.DLL" Alias "GetFontResourceInfoW"(ByVal lpszFilename As DWord, ' -- font file Name
ByRef cbBuffer As DWord, ' -- size of buffer for resouce information
ByVal lpBuffer As DWord, ' -- buffer for returned resouce information
ByVal dwQueryType As DWord ) As Long ' -- resouce information query type

Function TBMain()
Dim azFontFile As Asciiz * 256
azFontFile = APP_SourcePath + "scrgunny\" + "scrgunny.ttf"
Dim wFontFile As String = Ucode$(azFontFile)
Dim wBuffer As String = Repeat$(512, " ")

AddFontResource(azFontFile)

DWord sizeOfWBuffer = 512 ' Len(wBuffer)
PrintL "Testing file: " + azFontFile
If GetFontResourceInfo(StrPtr(wFontFile), sizeOfWBuffer, StrPtr(wBuffer), 1) Then

PrintL "Name is: >" + Extract$(Acode$(wBuffer), $NUL) +"<"

EndIf
RemoveFontResource(azFontFile)
WaitKey

End Function

[ReneMiner]

I had to change a little- somehow the above did not really install - probably string-types mixed up. So this morning I made some slightly different - mixed of all we already got. 3 win-functions declared - and 2 tB-functions made from it - Font_Install + Font_Uninstall. Second is just alias.

This time test in TBGL


Uses "TBGL"


Declare Function AddFontResource Lib "GDI32.DLL" Alias "AddFontResourceA" (ByRef lpszFilename As Asciiz) As Long
Declare Function GetFontResourceInfo Lib "GDI32.DLL" Alias "GetFontResourceInfoW"(ByVal lpszFilename As DWord, ' -- font file Name
ByRef cbBuffer As DWord, ' -- size of buffer for resouce information
ByVal lpBuffer As DWord, ' -- buffer for returned resouce information
ByVal dwQueryType As DWord ) As Long ' -- resouce information query type
Declare Function Font_Uninstall Lib "GDI32.DLL" Alias "RemoveFontResourceA" (ByRef lpFileName As Asciiz) As Long

$FontFile = APP_SourcePath + "scrgunny\scrgunny.ttf"

Function TBMain()

Local fName As String
Local fInstalled As Boolean

' -- Create and show window
DWord hWnd = TBGL_CreateWindowEx("TBGL script - press ESC to quit", 320, 240, 32, _
%TBGL_WS_DONTSIZE _
Or %TBGL_WS_WINDOWED _
Or %TBGL_WS_CLOSEBOX)

TBGL_ShowWindow
fName = Font_Install($FontFile)

If fName = "" Then ' failed- setup some default font
fName = "Gabriola" ' hope this font is available on all systems
Else
fInstalled = TRUE
EndIf

TBGL_BuildFont TBGL_FontHandle(fName, 32, %TBGL_BOLD ), 1

' -- Resets status of all keys
TBGL_ResetKeyState()

TBGL_UseTexturing(FALSE) ' will just draw text
TBGL_RenderMatrix2D(0, 240, 320, 0) ' and just 2D

TBGL_SetActiveFont 1
TBGL_Color 255, 255, 127

' -- Main loop
While TBGL_IsWindow(hWnd)

TBGL_ClearFrame
TBGL_PrintFont("This is a font-test", 24, 64)

TBGL_DrawFrame

' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While

Wend

TBGL_DestroyWindow ' -- free graphics first
If fInstalled Then Font_Uninstall($FontFile) ' -- then remove font again

End Function

' #########################################################

Function FONT_Install(ByVal sFile As String) As String

' returns name of installed font or "" if fails

Local azFontFile As Asciiz * 256
azFontFile = sFile

Local wFontFile As String = Ucode$(azFontFile)
Local wBuffer As String = Repeat$(512, " ")
Local sizeOfWBuffer As DWord = 512

AddFontResource(sFile)

If GetFontResourceInfo(StrPtr(wFontFile), sizeOfWBuffer, StrPtr(wBuffer), 1) Then
Return Extract$(Acode$(wBuffer), $NUL)
EndIf

' installed but can not be identified
Font_Uninstall(sFile)

End Function


Because only temporary installs user-fonts the Uninstall-Procedure would need for full functionality some method to find out the filename of a font by its font-name. But I'm not in need of this right now. All the above serves to be temporarily used. I rechecked just by opening some new RTF-Doc while running it and thereafter. Install/Uninstall really works - but what will happen if the font is already installed on the users system? - I just ask myself... I hope won't be a problem since the font we install/uninstall is on a different path - so we don't uninstall the wrong one.

[ReneMiner]

...If your work gets used or not...

Why do you think I do this? Because I want to use it and I need this functionality. If others use it, is theirs business. But as you see- I asked a certain question at begin of the thread. And if anyone else seeks an answer to the same question then will find it hopefully within this thread or can use the bundled knowledge as a point to start from - when it comes to me: I hate it to read some thread-title where I don't find the promised or just incomplete information.
Especially if someone sets sail into unknown waters it might help to know what to take on board for the trip.

It's the advantage of a forum on the internet. You can check what hurdles others had to take and how they solved it. Maybe you are an advanced user and those "hurdles" seem to you just as dust-particles on your way - others still have to stress their brains to find a path and some others love to combine available functionalities to even better ones just because they followed an idea they just stumbled across...

No- the truth is, there's no rationale nor real explanatory statement - it's all just done for fun and when I'm in the mood to

[ReneMiner]

Usage-suggest:

How about improving TBGL-Font-Creator a little? Somewhat like an extra-button: Font from File + common dialog to browse and pick a fontfile...