LoadFont () how to check if font exists?

[dige]

Under windows a font will always "found" with LoadFont(), even if it does not exist.
How to check if a font really exists?

Or in other words, how can you load/use a font which was not installed?
Something like LoadLocalFont (#PB_Any, "C:\Temp\SpecialFont.ttf")

Anyone can help?

[C64]

How to check if a font really exists?

http://www.purebasic.fr/english/viewtopic.php?p=233557

[dige]

@c64: Thank you for the FontName check link. Its very useful - thx!

If the fontname check fails ( the font is'nt installed already),
how to load a font from a special folder?

[ts-soft]

Code: Select all

AddFontResource_(font.s)

http://msdn.microsoft.com/en-us/library ... 85%29.aspx

Code: Select all

RemoveFontResource_(font.s)

Code: Select all

SendMessage_(#HWND_BROADCAST, #WM_FONTCHANGE, 0, 0)

[eesau]

You can also load a font directly from memory by using AddFontMemResourceEx_().

[dige]

Thank you ppl!

@eesau: Interesting. But I'm afraid that the returned Font handle is not compatible with the PB functions, is it?

[eesau]

Thank you ppl!

@eesau: Interesting. But I'm afraid that the returned Font handle is not compatible with the PB functions, is it?

It is. Or, to be precise, you load a font using AddFontMemResourceEx_() and then use native PB's LoadFont() with the font's name. The font shows only for your own process and it's freed when the process ends.

[dige]

Sounds great! thx

[dige]

Yeah, works as expected

Code: Select all

Procedure.i FreeFontEx (hFontRes.i)
  ProcedureReturn RemoveFontMemResourceEx_ (hFontRes)
EndProcedure
Procedure.i LoadFontEx (FontName.s, file.s, FontID.i, YSize.i, style.i = #Null);- Return hFontRes if success
  FileID = OpenFile(#PB_Any, file)
  If FileID
    *mem = AllocateMemory(Lof(FileID))
    If *mem
      ReadData(FileID, *mem, Lof(FileID))
      Result = AddFontMemResourceEx_(*mem, Lof(FileID), #Null, @pcFonts )
      If Result
        If Not LoadFont(FontID, FontName, YSize, style)
          FreeFontEx(Result)
          Result = #Null
        EndIf
      EndIf
      FreeMemory(*mem)
    EndIf
    CloseFile(FileID)
  EndIf
  
  ProcedureReturn Result
EndProcedure

; Tested with "Mom´sTypewriter" Font from http://www.dafont.com/moms-typewriter.font
#FONTID = 1
hFontRes = LoadFontEx( "Mom´sTypewriter", "C:\Temp\Scratch\Mom®t___.ttf", #FONTID, 60, #PB_Font_HighQuality )

If hFontRes
  OpenWindow(#Null, 0, 0, 800, 600, "FontTest", #WS_OVERLAPPEDWINDOW)
  If StartDrawing(WindowOutput(#Null))
    DrawingMode(#PB_2DDrawing_Transparent)  
    DrawingFont(FontID(#FONTID))
    DrawText( 10, 10, "ABCDEFGH abcdefg", #Black )
    StopDrawing()
  EndIf
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
  FreeFontEx(hFontRes)
EndIf

[eesau]

You can even embed the font inside a datasection so that you won't need a load the font from a separate file. Very handy for distributing fonts with your program

[nco2k]

i wonder why there is no CatchFont()

c ya,
nco2k

[Rings]

i wonder why there is no CatchFont()

crossplattform perhaps ...

[ts-soft]

@dige
If you don't load from memory (DataSection) AddFontResource_(font.s) is much easier.

[einander]

@Dige:
You can try AddFontMemResourceEx

I've searched the forums for FontWidth but only found examples to get the font width; none for set it.

This example allows to set the loaded font width, and also to load fonts inside StartDrawing/StopDrawing section.

Code: Select all

EnableExplicit
#FontPath$="E:\Buffer\FUENTES\Hand\AbrazoScriptSSK-Bold.ttf"   ; <<<<<<<<<   your font path here
Define FontName$="abrazoscriptssk",Fontheight=80 ,Fontwidth=20 ; <<<<<<<<<   your font Name, font Height and font Width here
Global _Img,_Imgad
;
Prototype P4P(L1,L2,L3,L4) ; "wildcard" prototype with four params
If OpenLibrary(0, "gdi32.dll") 
  Define CatchFont.P4P = GetFunction(0, "AddFontMemResourceEx")
  CloseLibrary(0)
EndIf 
Define Fontid=CatchFont(?Catch,?Endcatch-?Catch,0,@"1"),Myfont
;
Macro DeleteFont(Fon)
  If Fon: DeleteObject_(Fon) :EndIf
EndMacro
;
Procedure CreateFont(FontName$,FontHeight.L,FontWidth.L)  ; experiment with more params (14 in all!), or with CreateFontIndirect_()
  ; don forget to free the font with DeleteFont() <<<<<<<<<
  ;ProcedureReturn CreateFont_(FontHeight,FontWidth,Escapement,Orientation,Weight,Italic,Underline,Strikeout,Charset,OutputPrecision,ClipPrecision,Quality,PitchAndFamily,FontName$) 
  ProcedureReturn CreateFont_(FontHeight,FontWidth,0,0,0,0,0,0,0,0,0,0,0,FontName$) 
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 100, 100,700,500 ,"",  #WS_OVERLAPPEDWINDOW | 1) 
_Img=CreateImage(-1,WindowWidth(0),WindowHeight(0))
_IMgad=ImageGadget(-1,0,0,0,0,ImageID(_Img)) 
StartDrawing(ImageOutput(_Img))
MyFont=Createfont(Fontname$,Fontheight,Fontwidth)  ; bonus: you can create the font inside StartDrawing/StopDrawing section
;
DrawingFont(Myfont)
DrawText(10,10,"12345678 abcdefgh",#Yellow,0)
StopDrawing()
SetGadgetState(_Imgad,ImageID(_Img))
;
Repeat:Until WaitWindowEvent()=16 
DeleteFont(MyFont)
End
;
DataSection
  Catch:
  IncludeBinary #FontPath$
  Endcatch:
EndDataSection

[dige]

@einander: thank you. Especially the fontwidth feature is very handy.