Get system font name - or load the system font with a different size

[Lebostein]

If I want to use the default OS system font in an other size (for gadgets for example), I have to use LoadFont(id, name, size). But if I don't know the system font name I can't get any further. Is there is a trick to find out the name of the system font?

[infratec]

If you tell us your OS it would be much easier to provide a solution.

[infratec]

If you use windows, for example, you can use:

Code: Select all

;
; https://learn.microsoft.com/de-de/windows/win32/api/winuser/nf-winuser-systemparametersinfoa
; https://learn.microsoft.com/de-de/windows/win32/api/wingdi/ns-wingdi-logfonta
;
Define LogFont.LOGFONT

If SystemParametersInfo_(#SPI_GETICONTITLELOGFONT, SizeOf(LOGFONT), @LogFont, 0)
  Debug PeekS(@LogFont\lfFaceName[0])
Else
  Debug "NOk"
EndIf

[mk-soft]

Only windows

Code: Select all

;-TOP

; ----

;-TOP GetFontName by mk-soft, v1.01.0, 20.11.2023

Procedure.s GetFontName(fontHandle)
  Protected r1.s, hdc, size, *buffer.OUTLINETEXTMETRIC
  
  hdc = CreateCompatibleDC_(#Null);
  If hdc
    SelectObject_(hdc, fontHandle);
    size = GetOutlineTextMetrics_(hdc, 0, 0)
    If size > 0
      *buffer = AllocateMemory(size)
      If GetOutlineTextMetrics_(hdc, size, *buffer) = size
        If *buffer\otmpFaceName
          r1 = PeekS(*buffer + *buffer\otmpFaceName, -1)
        EndIf
      EndIf
      FreeMemory(*buffer)
    EndIf
    DeleteDC_(hdc);
  EndIf
  ProcedureReturn r1
EndProcedure

Procedure UpdateWindow()
  Protected dx, dy
  dx = WindowWidth(0)
  dy = WindowHeight(0) - StatusBarHeight(0) - MenuHeight()
  ; Resize Gadgets
EndProcedure

Procedure Main()
  Protected dx, dy
  
  #WinStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
  
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 600, 400, "Test Window", #WinStyle)
    ; MenuBar
    CreateMenu(0, WindowID(0))
    MenuTitle("File")
    
    ; StatusBar
    CreateStatusBar(0, WindowID(0))
    AddStatusBarField(#PB_Ignore)
    
    ; Gadgets
    dx = WindowWidth(0)
    dy = WindowHeight(0) - StatusBarHeight(0) - MenuHeight()
    ButtonGadget(0, 10, 10, 120, 40, "Button 0")
    ButtonGadget(1, 10, 60, 120, 40, "Button 1")
    
    ; Bind Events
    BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), 0)
    
    fontid = GetGadgetFont(#PB_Default)
    font.s = GetFontName(FontID)
    LoadFont(0, font, 15)
    SetGadgetFont(1, FontID(0))
    StatusBarText(0, 0, " Font: " + font)
    
    ; Main Loop
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case 0
              Break
          EndSelect
          
        Case #PB_Event_Menu
          Select EventMenu()
            
          EndSelect
          
        Case #PB_Event_Gadget
          Select EventGadget()
              
          EndSelect
          
      EndSelect
    ForEver
    
  EndIf
  
EndProcedure : Main()

[Shardik]

For MacOS you may use the following example to get the system font name and size. The size may differ between different Gadgets or in the ListIconGadget between header line and rows:

Code: Select all

EnableExplicit

Procedure.S GetFontNameAndSize(FontID.I)
  Protected FontName.S
  Protected FontSize.CGFloat

  If FontID
    FontName = PeekS(CocoaMessage(0, CocoaMessage(0, FontID, "displayName"),
      "UTF8String"), -1, #PB_UTF8)
    CocoaMessage(@FontSize, FontID, "pointSize")
  EndIf

  ProcedureReturn FontName + " " + Str(FontSize)
EndProcedure

Procedure.S GetGadgetFontNameAndSize(GadgetID.I)
  Protected ColumnObject.I
  Protected FontInfo.S

  If GadgetType(GadgetID) = #PB_GadgetType_ListIcon
    ColumnObject = CocoaMessage(0, CocoaMessage(0,
      GadgetID(GadgetID), "tableColumns"), "objectAtIndex:", 0)
    FontInfo = "- Header: " + GetFontNameAndSize(CocoaMessage(0,
      CocoaMessage(0, ColumnObject, "headerCell"), "font"))
    FontInfo + #CRLF$ + "- Rows: " + GetFontNameAndSize(CocoaMessage(0,
      CocoaMessage(0, ColumnObject, "dataCell"), "font"))
  Else
    FontInfo = GetFontNameAndSize(GetGadgetFont(GadgetID))
  EndIf

  ProcedureReturn FontInfo
EndProcedure

OpenWindow(0, 270, 100, 300, 170, "Get Gadget's font name and size")
TextGadget(0, 10, 10, WindowWidth(0) - 20, 25, "Default font", #PB_Text_Border)
TextGadget(1, 10, 45, WindowWidth(0) - 20, 25, "Apple Chancery 12",
  #PB_Text_Border)
SetGadgetFont(1, LoadFont(0, "Apple Chancery", 12))
ListIconGadget(2, 10, 80, WindowWidth(0) - 20, 80, "Column 1", 60)
AddGadgetItem(2, -1, "Line 1")
AddGadgetItem(2, -1, "Line 2")

Debug "Font of TextGadget 0: " + GetGadgetFontNameAndSize(0)
Debug "Font of TextGadget 1: " + GetGadgetFontNameAndSize(1)
Debug "Fonts of ListIconGadget:" + #CRLF$ + GetGadgetFontNameAndSize(2)

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

Danilo has posted here a lot of helpful font procedures.