Handling of many used fonts

Share your advanced PureBasic knowledge/code with the community.
infratec
Always Here
Always Here
Posts: 6824
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Handling of many used fonts

Post by infratec »

Hi,

I wrote an own gadget which loads a font depending on the used size of the gadget.
This gadget is used many times in the code.
Also other sizes of the same font are loaded.

I wanted a better solution than always loading and freeing maybe the same fonts.
(And sometimes they can not freed)

So I wrote a small code to handle the used fonts.
Unfortunalely I had to write it as module, because I wanted it also from inside of an other module.

Maybe it is useful for others too.
It reduces the RAM usage of my code by 500k :wink:

Best: save it as FontList.pbi

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf


DeclareModule FontList
  
  Structure FontListStructure
    Font$
    Font.i
    InUse.i
  EndStructure
  
  Global NewList FontList.FontListStructure()
  
  Declare.i LoadToFontList(Font.i, Name$, Height.i, Flags=0)
  Declare FreeFromFontList(Font.i)
  
EndDeclareModule


Module FontList
  
  Procedure.i LoadToFontList(Font.i, Name$, Height.i, Flags=0)
    
    Protected Font$, FontAlreadyLoaded.i
    
    
    Font$ = Name$ + "_" + Str(Height) + "_" + Str(Flags)
    
    ForEach FontList()
      If FontList()\Font$ = Font$
        FontList()\InUse + 1
        FontAlreadyLoaded = #True
        Break
      EndIf
    Next
    
    If Not FontAlreadyLoaded
      AddElement(FontList())
      FontList()\Font = LoadFont(Font, Name$, Height, Flags)
      FontList()\InUse = 1
      FontList()\Font$ = Font$
    EndIf
    
    ProcedureReturn FontList()\Font
    
  EndProcedure
  
  
  Procedure FreeFromFontList(Font.i)
    
    ForEach FontList()
      If FontList()\Font = Font
        FontList()\InUse - 1
        If FontList()\InUse = 0
          FreeFont(Font)
          DeleteElement(FontList())
        EndIf
        Break
      EndIf
    Next
    
  EndProcedure
EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  Define Font1.i, Font2.i, Font3.i, Font4.i, Font5.i
  
  Font1 = FontList::LoadToFontList(#PB_Any, "Arial", 12)
  Debug Font1
  Debug ListSize(FontList::FontList())
  Debug "----"
  
  Font2 = FontList::LoadToFontList(#PB_Any, "Arial", 12)
  Debug Font2
  Debug ListSize(FontList::FontList())
  Debug "----"
  
  Font3 = FontList::LoadToFontList(#PB_Any, "Arial", 12)
  Debug Font3
  Debug ListSize(FontList::FontList())
  Debug "----"
  
  Font4 = FontList::LoadToFontList(#PB_Any, "Arial", 14)
  Debug Font4
  Debug ListSize(FontList::FontList())
  Debug "----"
  
  Font5 = FontList::LoadToFontList(#PB_Any, "Arial", 14, #PB_Font_Bold)
  Debug Font5
  Debug ListSize(FontList::FontList())
  Debug "----"
  
  ForEach FontList::FontList()
    Debug FontList::FontList()\Font$ + " in use: " + Str(FontList::FontList()\InUse)
  Next
  Debug "----"
  
  FontList::FreeFromFontList(Font2)
  Debug ListSize(FontList::FontList())
  Debug "----"
  
  FontList::FreeFromFontList(Font1)
  Debug ListSize(FontList::FontList())
  Debug "----"
  
  FontList::FreeFromFontList(Font3)
  Debug ListSize(FontList::FontList())
  Debug "----"
  
CompilerEndIf
Bernd
User avatar
mk-soft
Always Here
Always Here
Posts: 5338
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Handling of many used fonts

Post by mk-soft »

Thanks :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Post Reply