Charger une font qui n'est pas dans Windows/Fonts
Publié : sam. 23/oct./2004 16:02
				
				Est il possible de charger une font qui n'est pas installé dans windows mais qui est dans le repertoire du jeu ?
			Forums PureBasic - Français
https://www.purebasic.fr/french/
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
EndIfCode : 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
  

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