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