PT Forum

indi Joined: 26th Aug 2002
Location: Earth, Brisbane, Australia

Posted: 28th May 2003 12:19

this snippet wil look for the master and two substitute fonts as well as store each font name in an array if usage is required.

+ Code Snippet

sync on : sync rate 60
disable escapekey
ink rgb(255,255,255),1 : set text size 13
make object cube 1,1 : hide object 1

Perform checklist for fonts
maxfonts = checklist quantity()

dim CurrentSysFonts$(maxfonts)

MasterFont$ = "Arial"
SubstituteA$ = "Verdana"
SubstituteB$ = "Hillbilly"
MasterFontCheck = 0
SubACheck = 0
SubBCheck = 0

for i = 1 to maxfonts
CurrentSysFonts$(i) = CHECKLIST STRING$(i)
next i

for i = 1 to maxfonts
if CurrentSysFonts$(i) = MasterFont$
MasterFontCheck = 1
endif
if CurrentSysFonts$(i) = SubstituteA$
SubACheck = 1
endif
if CurrentSysFonts$(i) = SubstituteB$
SubBCheck = 1
endif
next i

for i = 1 to maxfonts
CurrentSysFonts$(i) = CHECKLIST STRING$(i)
center text screen width()/2,screen height()/2-24,"font : "+STR$(i)+" of "+STR$(maxfonts)
center text screen width()/2,screen height()/2,CurrentSysFonts$(i)
center text screen width()/2,screen height()/2+40,"master font : "+STR$(MasterFontCheck) + " " + MasterFont$
center text screen width()/2,screen height()/2+60,"subA font : "+STR$(SubACheck) + " " + SubstituteA$
center text screen width()/2,screen height()/2+80,"subB font : "+STR$(SubBCheck) + " " + SubstituteB$
sync
next i

suspend for key
undim CurrentSysFonts$(maxfonts)
delete object 1
end

Kentaree Joined: 5th Oct 2002
Location: Clonmel, Ireland

Posted: 28th May 2003 13:49

Cool, handy little snippet

Just a bit of advice, you can put 2 or more of those for...next loops together to make it faster. If you put all of them together everything is checked at once and you only have to run the loop once, and it gives real-time checking to see if the master fonts are available.
Also, instead of using make object etc to create the backdrop, just use backdrop on.

Cheers,
Kentaree

indi Joined: 26th Aug 2002
Location: Earth, Brisbane, Australia

Posted: 11th Jun 2003 7:41

hi mate heres an improvement again as its a series of functions now.

+ Code Snippet

sync on : sync rate 60 : disable escapekey
ink rgb(255,255,255),1 : set text size 13
backdrop on

MasterFont$ = "Arial"
SubstituteA$ = "Verdana"
SubstituteB$ = "Hillbilly"

maxfonts = find_max_fonts()

dim MasterFontCheck(1) : MasterFontCheck(1) = 0
dim SubACheck(1) : SubACheck(1) = 0
dim SubBCheck(1) : SubBCheck(1) = 0
dim CurrentSysFonts$(maxfonts)

catch_all_fontnames(maxfonts)

check_for_fonts(maxfonts,MasterFont$,SubstituteA$,SubstituteB$)

for i = 1 to maxfonts
   CurrentSysFonts$(i) = CHECKLIST STRING$(i)
   center text screen width()/2,screen height()/2-24,"font : "+STR$(i)+" of "+STR$(maxfonts)
   center text screen width()/2,screen height()/2,CurrentSysFonts$(i)
   center text screen width()/2,screen height()/2+40,"master font : "+STR$(MasterFontCheck(1)) + " " + MasterFont$
   center text screen width()/2,screen height()/2+60,"subA font : "+STR$(SubACheck(1)) + " " + SubstituteA$
   center text screen width()/2,screen height()/2+80,"subB font : "+STR$(SubBCheck(1)) + " " + SubstituteB$
   sync
next i

suspend for key

undim CurrentSysFonts$(maxfonts)
undim MasterFontCheck(1)
undim SubACheck(1)
undim SubBCheck(1)

end

function find_max_fonts()
Perform checklist for fonts
maxfonts = checklist quantity()
endfunction maxfonts

function catch_all_fontnames(maxfonts)
for i = 1 to maxfonts
   CurrentSysFonts$(i) = CHECKLIST STRING$(i)
next i
endfunction

function check_for_fonts(maxfonts,MasterFont$,SubstituteA$,SubstituteB$)
for i = 1 to maxfonts
   if CurrentSysFonts$(i) = MasterFont$
      MasterFontCheck(1) = 1
   endif
   if CurrentSysFonts$(i) = SubstituteA$
      SubACheck(1) = 1
   endif
   if CurrentSysFonts$(i) = SubstituteB$
      SubBCheck(1) = 1
   endif
next i
endfunction

Andy Igoe Joined: 6th Oct 2002
Location: United Kingdom

Posted: 11th Jun 2003 17:37

Just lil' tip for DBPro usage (although i've not tried either in DBC) that saves a lil' typing and I think makes code easier to read.

instead of:

dim SubACheck(1) : SubACheck(1) = 0
dim SubBCheck(1) : SubBCheck(1) = 0

Perhaps?:

dim subACheck() ; SubACheck()=0

global subACheck as integer : subACheck=0

indi Joined: 26th Aug 2002
Location: Earth, Brisbane, Australia

Posted: 12th Jun 2003 4:35

Id be more inclined to use the last method, The first sounds like a dodgy array declaration.

<1 >

Sign In