LoadFont () how to check if font exists?

[einander]

@Dige: You are welcome!

I've found that the procedures CreateFont() and DeleteFont() on the previous example are redundant, because there are functions "CreateFontA" and "DeleteObject" in Gdi32.dll to do the same work.

Here is another twist, tested with the new PB 4.60 beta:

Code: Select all

EnableExplicit
#G32=1
#Font1="E:\Buffer\FUENTES\Hand\AbrazoScriptSSK-Bold.ttf"   ; <<<<<<<<<   your font paths here
Global _Img,_Imgad
Define Ev,Cx,Cy,OldCx,OldCy
Define FName1$="abrazoscriptssk",Fontheight1=80 ,Fontwidth1=34 ; <<<<<<<<<   your font Name, font Height and font Width here
;
; wildcard prototypes to use on any procedure with same parameter types; define more when needed
Prototype Pi1(A)        ; 1 int
Prototype Pi4(A,B,C,D)  ; 4 int 
Prototype Pi13S1(A,B,C,D,E,F,G,H,I,J,K,L,M,N$) ; 13 int + 1 string
;
If OpenLibrary(#G32, "Gdi32.dll") 
  Define CatchFont.Pi4     = GetFunction(#G32, "AddFontMemResourceEx")
  Global CreateFont.Pi13S1 = GetFunction(#G32, "CreateFontA") 
  Global DeleteFont.Pi1    = GetFunction(#G32, "DeleteObject")
  CloseLibrary(#G32)
EndIf 
;
CatchFont(?Catch1,?Endcatch1-?Catch1,0,@"1")
;
Procedure Lim(A,B,C)
  If A<B      :ProcedureReturn B
  ElseIf A>C  :ProcedureReturn C
  EndIf
  ProcedureReturn A
EndProcedure     
;
Procedure SetFontSize(Fon,Fname$,Fheight.L,Fwidth.L)
  Deletefont(Fon)  
  Fon= CreateFont(FHeight,FWidth,0,0,0,0,0,0,0,0,0,0,0,FName$)
  ProcedureReturn Fon  
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 100, 100,800,600 ,"",  #PB_Window_SystemMenu |#PB_Window_Maximize) 
Define Wi=WindowWidth(0),He=WindowHeight(0)
_Img=CreateImage(-1,Wi,He)
_IMgad=ImageGadget(-1,0,0,0,0,ImageID(_Img)) 
StartDrawing(ImageOutput(_Img))
Define MyFont1=CreateFont(FontHeight1,FontWidth1,0,0,0,0,0,0,0,0,0,0,0,FName1$)
;
DrawingFont(Myfont1)
DrawText(10,10,"12345678 abcdefgh",#Yellow,0)
;
StopDrawing()
SetGadgetState(_Imgad,ImageID(_Img))
;
Define T$="Pure Basic 1234567890"
Define Le=Len(T$)*1.24
;
Repeat
  If GetAsyncKeyState_(27)&$8000 :  End : EndIf
  Ev=WaitWindowEvent(1)  
  Cx=Lim(WindowMouseX(0)/Le,1,Wi)
  Cy=Lim(WindowMouseY(0)*0.95,1,He)
  If Cx<>OldCx Or Cy <> OldCy
    Deletefont(Myfont1)
    StartDrawing(ImageOutput(_Img))
    FontHeight1=WindowMouseY(0)
    Box(0,0,Wi,He,0)
    Box(0,0,WindowMouseX(0),WindowMouseY(0),$55)
    Myfont1=Setfontsize(Myfont1,Fname1$,Cy,Cx)  ; beware, for fonts the height parameter goes first <<<<<<<<<<<
    DrawingFont(Myfont1)
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(10,10,T$,#Yellow,0)
    StopDrawing()
    SetGadgetState(_Imgad,ImageID(_Img))
  EndIf
  OldCx=Cx:OldCy=Cy
Until Ev=16 
;
DeleteFont(MyFont1)  ; free the font resource, equivalent to FreeFont()
End
;
DataSection
  Catch1:
  IncludeBinary #Font1
  Endcatch1:
EndDataSection

[dige]

@einander: great! thank you again