FiveTech Support Forums

// More fonts samples

#include "FiveWin.ch"

static oWnd, aFonts

function Main()

local oBtn, oFont, oTxtFile, nLines, cLines, n, cFont, nSize

cFont := 'Courier'
nSize := -10
aFonts := {}

if file('FONT.INI')
   oTxtFile := TTxtFile():New('FONT.INI')
   nLines   := oTxtFile:RecCount()

	for n := 1 to nlines
	 cLines := oTxtFile:ReadLine()
	 if n = 6 .or. n = 7 .or. n = 8
		 aadd( aFonts , if(cLines='.T.',.T.,.F.) )
	 elseif n = 14
		 aadd( aFonts , cLines )
	 else
		 aadd( aFonts , val(cLines) )
	 end
	    oTxtFile:Skip()
	next
	oTxtFile:Close()

end

  // This is default for no Font.ini file
DEFINE FONT oFont NAME cFont SIZE 0,nSize

if !empty( aFonts )
  oFont:hFont := CreateFont( aFonts )
end

   DEFINE WINDOW oWnd TITLE "Testing ChooseFont"

	oWnd:SetFont( oFont )

   @ 2, 2 BUTTON oBtn PROMPT "&Choose" OF oWnd ;
		      ACTION (ChooseSysFont(@aFonts)) ;
		SIZE 80, 25

   ACTIVATE WINDOW oWnd

return nil

*--------------------*
Function uTrim( uVar )
local cVar
if valtype( uVar ) = 'N'
	cVar := ltrim(str(uVar))
elseif valtype( uVar ) = 'L'
	cVar := if(uVar,'.T.','.F.')
else
	cVar := alltrim(uVar)
end
return cVar

*-------------------------------*
Function ChooseSysFont( aFonts )
local hText, n
aFonts := ChooseFont()
if !empty(aFonts[14])
      hText := Fcreate('FONT.INI')
      for n := 1 to len(aFonts)
	 Fwrite(hText,utrim(aFonts[n])+CRLF)
      next
      Fclose(hText)
end
return nil