Page 1 sur 1

Charger une font qui n'est pas dans Windows/Fonts

Publié : sam. 23/oct./2004 16:02
par Thyphoon
Est il possible de charger une font qui n'est pas installé dans windows mais qui est dans le repertoire du jeu ?

Publié : sam. 23/oct./2004 23:07
par Chris
Tiens, j'avais pas vu ce post :oops:

Tu peux utiliser AddFontRessource_(), pour utiliser des polices sans les copier dans le répertoire Windows\Fonts\.

Pour l'exemple, j'ai utilisé deux polices gratuites que tu peux télécharger à cette adresse : http://www.fontesgratis.com.br/
(Je vais mettre ce site dans les liens utiles).

Tu les extrait dans le dossier de ton application, ou alors, tu en récupères ailleurs, en changeant les noms dans le code.

Les polices s'appellent "WALSHES.TTF" et "DIGITEK_.TTF"

Exemple:

Code : Tout sélectionner

;/Constantes Window
Enumeration
  #Window_0
EndEnumeration

;/Constantes Gadget
Enumeration
  #Btn_Test
  #Btn_Quit
EndEnumeration


AddFontResource_("WALSHES.TTF;DIGITEK_.TTF")
Font1 = LoadFont(#PB_Any,"WALSHES",24)
Font2 = LoadFont(#PB_Any,"DIGITEK",34)

If OpenWindow(#Window_0, 300, 300, 300, 300, #PB_Window_SystemMenu, "Fenêtre 1",0)
  
  If CreateGadgetList(WindowID(#Window_0))
    ButtonGadget(#Btn_Quit, 50, 10, 200, 100, "Quitter")
    ButtonGadget(#Btn_Test, 50, 120, 200, 100, "Test")
  EndIf
  
  If Font1
    SetGadgetFont(#Btn_Quit,UseFont(Font1))
  EndIf
  If Font2
    SetGadgetFont(#Btn_Test,UseFont(Font2))
  EndIf
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_EventGadget
        Select EventGadgetID()
          
          Case #Btn_Quit : quit = 1
        EndSelect
        
      Case #PB_EventCloseWindow : quit = 1
    EndSelect
  Until quit = 1
  RemoveFontResource_("WALSHES.TTF;DIGITEK_.TTF")
  End
EndIf

Publié : dim. 24/oct./2004 8:48
par Thyphoon
Merci Chris c'est génial !!! :D

Re: Charger une font qui n'est pas dans Windows/Fonts

Publié : jeu. 16/sept./2010 17:05
par Dionyzos
Bonjour,

Je me permets de remonter ce sujet car d'une part la solution m'intéresse aussi, mais surtout que le code proposé par Chris ne fonctionne pas (ou plus)

J'ai téléchargé et copié les fonts dans le même dossier que le code.
J'ai corrigé les qqs erreurs de bugs dû aux changements des nouvelles versions de PB (!) pour que l'appli démarre.
J'ai bien la fenêtre qui s'ouvre avec les deux gros boutons, mais les polices ne sont pas celles que j'ai copié dans le dossier mais une standard genre Arial ou Tahoma.

Qq'un aurait-il une solution qui fonctionne ?

Merci :)

Re: Charger une font qui n'est pas dans Windows/Fonts

Publié : jeu. 16/sept./2010 20:27
par Ar-S
Voilà une version qui marche en PB 4.50

Code : Tout sélectionner

;Ajouter font Externe by Ar-S 
;Adaptation d'un code de Chris pour PB 4.50 et + 

Enumeration 
  #Window_0 
  #Btn_Test 
  #Btn_Quit 
EndEnumeration 
 
AddFontResource_("neural2.ttf;nash-tuc.ttf")

Font1 = LoadFont(#PB_Any,"neuralnomicon",14) 
Font2 = LoadFont(#PB_Any,"Nash",14)

debug Font1
debug Font2

If OpenWindow(#Window_0, 300, 300, 203, 210, "Fenêtre 1",#PB_Window_SystemMenu,0) 
  
  ButtonGadget(#Btn_Quit, 1, 1, 200, 100, "Quitter") 
  ButtonGadget(#Btn_Test, 1, 108, 200, 100, "Test") 
  
  SetGadgetFont(#Btn_Quit,fontID(Font1))
  SetGadgetFont(#Btn_Test,FontID(Font2))
endif

  
Repeat 
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()  
        Case #Btn_Quit 
          quit = 1 
      EndSelect 
      
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #Window_0
          quit = 1
          
      EndSelect
  EndSelect
until quit=1
RemoveFontResource_("neural2.ttf;nash-tuc.ttf") 
CloseWindow(#Window_0)
end
  
J'attire votre attention sur le fait de bien noter le nom de la font tel qu'il apparait lorsque vous double cliquez sur celui-ci dans windows.

Dans mon exemple, le fichier de la Font1 est bien neural2.ttf mais son vrai nom est neuralnomicon lorsque je double clique dessus.

Image

Voilou.

Re: Charger une font qui n'est pas dans Windows/Fonts

Publié : ven. 17/sept./2010 9:15
par Dionyzos
En effet, ça marche impec
Merci Ar-S :-)

Re: Charger une font qui n'est pas dans Windows/Fonts

Publié : lun. 04/oct./2010 0:16
par charvista
Bizarrement, chez moi, quand je mets deux polices sur la même ligne séparées par un point virgule, ça ne marche pas...
De toute façon, c'est plus Pro en utilisant des procédures, et c'est plus clair d'ajouter/enlever les polices un par un.
Et comme je suis nul en API, mais je consulte quand même un peu le MSDN, il me semble qu'il est nécessaire d'ajouter un SendMessage_(#HWND_BROADCAST,#WM_FONTCHANGE, #Null, #Null) pour que les autres applications soient au courant du changement mais je ne comprends pas trop bien... En tout cas voici ce que dit le message officiel de MSDN en anglais: Any application that adds or removes fonts from the system font table should notify other applications of the change by sending a WM_FONTCHANGE message to all top-level windows in the operating system (OS). The application should send this message by calling the SendMessage function and setting the hwnd parameter to HWND_BROADCAST.
Je crois donc que c'est obligatoire (peut-on le confirmer?), alors on suit la règle d'or :mrgreen:

Code : Tout sélectionner

;Ajouté Police Externe by Ar-S
;Adaptation d'un code de Chris pour PB 4.50 et +

;Transformé en Procédures + ajouté SendMessage_() par charvista

Procedure zAjoutPolice(Police.s)
    AddFontResource_(Police.s)
    SendMessage_(#HWND_BROADCAST,#WM_FONTCHANGE, #Null, #Null)
EndProcedure

Procedure zSuppressionPolice(Police.s)
    RemoveFontResource_(Police.s)
    SendMessage_(#HWND_BROADCAST,#WM_FONTCHANGE, #Null, #Null)
EndProcedure

Enumeration
  #Window_0
  #Btn_Test
  #Btn_Quit
EndEnumeration

zAjoutPolice("E:\Polices\123Marker.ttf")
zAjoutPolice("E:\Polices\7days.ttf")

Font1 = LoadFont(#PB_Any,"123Marker",24)
Font2 = LoadFont(#PB_Any,"7 days",24)

Debug Font1
Debug Font2

If OpenWindow(#Window_0, 300, 300, 203, 210, "Fenêtre 1",#PB_Window_SystemMenu)
 
  ButtonGadget(#Btn_Quit, 1, 1, 200, 100, "Quitter")
  ButtonGadget(#Btn_Test, 1, 108, 200, 100, "Test")
 
  SetGadgetFont(#Btn_Quit,FontID(Font1))
  SetGadgetFont(#Btn_Test,FontID(Font2))
EndIf

 
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget() 
        Case #Btn_Quit
          quit = 1
      EndSelect
     
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #Window_0
          quit = 1
         
      EndSelect
  EndSelect
Until quit=1
zSuppressionPolice("E:\Polices\123Marker.ttf")
zSuppressionPolice("E:\Polices\7days.ttf")
CloseWindow(#Window_0)
End