Home Page |
About ToolBook |
ToolBook Tips |
ToolBook Projects |
ToolBook Links |
Guest Book |
How to add and remove True Type and Screen fontsIf 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 |