Home
Page
About
ToolBook
ToolBook
Tips
ToolBook
Projects
ToolBook
Links
Guest
Book


How to add and remove True Type and Screen fonts
If you add True Type font in resources it will be added in system automatically.
The first problem is that this font will remain in system after closing of your application.
In many cases it is not bad but sometimes it is necessary to remove font after finishing of application.
The second problem is more serious: you can't add Screen font (*.fon) in system.
Here you can see how to add any font to system if it is not installed yet and how to remove it.

-- Initialization script (I usually put it in FirstIdle script on first page of book - empty and black)
to handle firstIdle
        system string myFontName, myFontFile
        system string myPath, winPath
        system pFileName[]
        local string myFonts,curFont,myTTF
        
        linkDLL "KERNEL"
                WORD    GlobalAlloc(WORD,DWORD)
                WORD    GlobalFree(WORD)
                WORD    GlobalHandle(WORD)
                POINTER GlobalLock(WORD)        
                WORD    GlobalUnlock(WORD)
                WORD    GetWindowsDirectory(POINTER,INT)
        end linkDLL
        linkDll "GDI"
                INT CreateScalableFontResource(INT,STRING,STRING,STRING)
                INT AddFontResource(POINTER)
                INT RemoveFontResource(POINTER)
        end linkDLL
        linkDLL "USER"
                INT SendMessage(WORD,WORD,WORD,DWORD)
        end linkDLL

-- Determine current path
        myPath = name of this book
        while last char of myPath <> "\"
                clear last char of myPath
        end while

-- Link ToolBook DLLs from current path (names of this files are different in different versions of ToolBook)
        linkDLL myPath & "tb40dos.dll"
                INT RemoveFile(STRING)
        end linkDLL
        linkDLL myPath & "tb40win.dll"
                STRING displayFonts(STRING)
        end linkDLL
        

-- Determine Windows path
        myDir = getWinPointer(144) of this book
        wReturn = GetWindowsDirectory(myDir, 144)
        winPath = pointerstring(0, myDir)
        get freeWinPointer(myDir) of this book
        put "\" after winPath

-- Fonts to install
        myFontName = "CBook # 2,Compact Book #1" -- List of font faces
        myFontFile = "cbook2.fon,cbook1r.fot"    -- List of font files

-- Install fonts that were not installed before
        myFonts = displayFonts()
        step i from 1 to itemCount(myFontName)
                curFont = item i of myFontFile
                if item i of myFontName is not in myFonts
                        CC = CharCount(curFont) 
                        if chars CC-2 to CC of curFont = "fon"
                                pFileName[i] = getwinPointer(128) of this book
                                get pointerstring(0, pFileName[i], myPath & item i of myFontFile)
                                get AddFontResource(pFileName[i])
                                if It <> 0
                                        get sendMessage(65535,29,0,0)
                                end if
                        else                      -- TTF
                                myTTF = curFont
                                clear chars CC-2 to CC of myTTF
                                put "ttf" after myTTF
                                get CreateScalableFontResource(0, winPath & "system\" & curFont, myPath & myTTF, null)
                                pFileName[i] = getwinPointer(128) of this book
                                get pointerstring(0, pFileName[i], winPath & "system\" & curFont)
                                get AddFontResource(pFileName[i])
                                if It <> 0
                                        get sendMessage(65535,29,0,0)
                                end if
                        end if
                end if
        end step
end


-- Script of book
to handle Exit
        system string myPath,winPath, userPath
        system pFileName[]
        system string myFontName, myFontFile

-- Remove fonts that were installed
        step i from 1 to itemCount(myFontName)
                if pFileName[i] <> null
                        get RemoveFontResource(pFileName[i])
                        if It <> 0
                                get sendMessage(65535,29,0,0)
                        end if   
                        get freeWinPointer(pFileName[i]) of this book
                        curFont = item i of myFontFile
                        CC = CharCount(curFont) 
                        if chars CC-2 to CC of curFont = "fot"
                                get removeFile(winPath & "system\" & curFont)
                        end if
                end if
        end step

        unlinkDLL myPath & "tb40dos.dll"
        unlinkDll "GDI"
        unlinkDll "USER"
        unlinkDLL "KERNEL"
        forward
end

to get getWinPointer nSize      
        local word hMem
        local retValue
        hMem = GlobalAlloc(66,nSize)
        return GlobalLock(hMem)
end

to get freeWinPointer pMem
        local word hMem, retValue
        sysSuspend = false
        hMem = GlobalHandle(item 1 of pMem)
        retValue = GlobalUnlock(hMem)
        sysSuspend = true
        return GlobalFree(hMem)
end

Back to Tips Menu