|
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
|