Charger et utiliser une Fonte(Police) sans l'installer

' Panoramic 0.9.26
'
'
' Charger et utiliser une Fonte sans l'installer
'
'
' V1.0
'
' Silverman, décembre 2015


' Info sur la fonction:
' https://msdn.microsoft.com/fr-fr/library/windows/desktop/dd183326%28v=vs.85%29.aspx

'
' Format reconnu :fon, fnt, ttf, ttc, fot, otf, mmm, pfb, pfm
'

dim Fonte$,FonteFile$
dim root$

' Pour tester, il faut utiliser une Fonte persnnelle ou
' la télécharger, et l'ouvrir pour regarder son nom.
' root$=dir_current$+"\"
Fonte$="lcdd":FonteFile$=root$+"lcdd.ttf"

' charge la Fonte en mémoire
 Fonte_LOAD(FonteFile$ , Fonte$)

' affichage
Font_name 0,Fonte$ : Font_size 0,24
print Fonte$
print_locate 0,100 : print "Voix ambigue d'un coeur..."
print_locate 0,200 : print "1234567890"


END
sub Fonte_LOAD(FonteFileName$ , FonteName$)
dim_local obj,i,found,ptr%,result%

   if file_exists(FonteFileName$)=0 then message "fichier Fonte pas trouvé!" : exit_sub
   ptr%=0

   ' verifie si la Fonte existe
   obj=0
   repeat
      obj=obj+1
   until object_exists(obj)=0
   DLIST obj : Font_NAMES_LOAD obj
   i=0 : found=0
   repeat
      i=i+1
      if lower$(item_read$(obj,i))=lower$(FonteName$) then found=1
   until found=1 or i=count(obj)
   delete obj

   ' Installe la nouvelle Fonte
   if found=0
      dll_on "Gdi32"
      poke adr(ptr%),peek(adr(FonteFileName$))
      poke adr(ptr%)+1,peek(adr(FonteFileName$)+1)
      poke adr(ptr%)+2,peek(adr(FonteFileName$)+2)
      poke adr(ptr%)+3,peek(adr(FonteFileName$)+3)
      result% = dll_call1("AddFontResourceA",ptr%)
      dll_off
   else
      ' si elle existe déjà, on informe
      ' message "la Fonte existe déjà!"
   end_if
end_sub