Default Font Name

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
oryaaaaa
Addict
Addict
Posts: 825
Joined: Mon Jan 12, 2004 11:40 pm
Location: Okazaki, JAPAN

Default Font Name

Post by oryaaaaa »

Code: Select all

; Reference Code
; PureBasic :: View topic - Windows defautl font
; http://www.purebasic.fr/english/viewtopic.php?t=2913

Procedure.s GetDefaultFontName()
  fnt.l=GetStockObject_(#DEFAULT_GUI_FONT)
  If fnt
    finfo.LOGFONT
    GetObject_(fnt,SizeOf(LOGFONT),@finfo)
    systemfontname.s=PeekS(@finfo\lfFaceName[0])
    ProcedureReturn PeekS(@finfo\lfFaceName[0])
  EndIf
  ProcedureReturn "System"
EndProcedure

Procedure.l GetDefaultFontSize()
  fnt.l=GetStockObject_(#DEFAULT_GUI_FONT)
  If fnt
    finfo.LOGFONT
    GetObject_(fnt,SizeOf(LOGFONT),@finfo)
    systemfontsize=finfo\lfHeight
    ProcedureReturn finfo\lfHeight
  EndIf
  ProcedureReturn 12
EndProcedure 

Debug GetDefaultFontName()
Debug GetDefaultFontSize()
Top
User avatar
oryaaaaa
Addict
Addict
Posts: 825
Joined: Mon Jan 12, 2004 11:40 pm
Location: Okazaki, JAPAN

Re: Default Font Name

Post by oryaaaaa »

Code: Select all

Procedure.s OSlocale()
  localedata.s=Space(256)
  RETlocale= GetLocaleInfo_($400, $1001, localedata, len(localedata))
  localedata=Left(localedata, RETlocale-1)
  ProcedureReturn localedata
EndProcedure
Japanese,English, etc
Top
kvitaliy
Enthusiast
Enthusiast
Posts: 162
Joined: Mon May 10, 2010 4:02 pm

Re: Default Font Name

Post by kvitaliy »

Debug GetDefaultFontName() = MS Shell Dlg
Debug GetDefaultFontSize() = -11
Agree, very small font! :D
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Default Font Name

Post by Kwai chang caine »

Debug GetDefaultFontName() = MS Shell Dlg
Debug GetDefaultFontSize() = -11
Me too :wink:
ImageThe happiness is a road...
Not a destination
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Re: Default Font Name

Post by rsts »

MSDN says
It is not recommended that you employ this method to obtain the current font used by dialogs and windows. Instead, use the SystemParametersInfo function with the SPI_GETNONCLIENTMETRICS parameter to retrieve the current font. SystemParametersInfo will take into account the current theme and provides font information for captions, menus, and message dialogs.
Top
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Default Font Name

Post by mestnyi »

So all the same as the name of the font to get cross-platform solution?
Top
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Default Font Name

Post by mestnyi »

As always I found a windows here. http://www.purebasic.fr/english/viewtop ... 75#p419494
But the other Os is nervously smoking in aside.

Code: Select all

Procedure.S FontName( FontID )
    CompilerSelect #PB_Compiler_OS 
      CompilerCase #PB_OS_Windows 
        Protected sysFont.LOGFONT
        GetObject_(FontID, SizeOf(LOGFONT), @sysFont)
        ProcedureReturn PeekS(@sysFont\lfFaceName[0])
        
    CompilerEndSelect
  EndProcedure
  
  Procedure FontSize( FontID )
    CompilerSelect #PB_Compiler_OS 
      CompilerCase #PB_OS_Windows 
        Protected sysFont.LOGFONT
        GetObject_(FontID, SizeOf(LOGFONT), @sysFont)
        ProcedureReturn MulDiv_(-sysFont\lfHeight, 72, GetDeviceCaps_(GetDC_(#NUL), #LOGPIXELSY))
        
    CompilerEndSelect
  EndProcedure
Top
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: Default Font Name

Post by Thunder93 »

As already stated, you should be using SystemParametersInfo function
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
Top
User avatar
RSBasic
Moderator
Moderator
Posts: 1228
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:
Contact RSBasic

Re: Default Font Name

Post by RSBasic »

For Windows: http://www.rsbasic.de/aktualisierung/wi ... mitteln.pb
For Linux: http://www.chabba.de/Linux/Misc/System_GetGtkFont.pb or http://www.chabba.de/Linux/Misc/System_ ... ontName.pb
For MacOS: I don't know.
Image
Image
Top
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Default Font Name

Post by mestnyi »

As already stated, you should be using SystemParametersInfo function
This is what I need. The window works as expected.

Code: Select all


CompilerSelect #PB_Compiler_OS 
    CompilerCase #PB_OS_Linux
      
      #G_TYPE_STRING = 64
      
      ImportC ""
        g_object_get_property(*widget.GtkWidget, property.p-utf8, *gval)
      EndImport
  CompilerEndSelect

  Procedure.S FontName( FontID )
    CompilerSelect #PB_Compiler_OS 
      CompilerCase #PB_OS_Windows 
        Protected sysFont.LOGFONT
        GetObject_(FontID, SizeOf(LOGFONT), @sysFont)
        ProcedureReturn PeekS(@sysFont\lfFaceName[0])
        
      CompilerCase #PB_OS_Linux
        Protected gVal.GValue
        Protected.s StdFnt
        g_value_init_( @gval, #G_TYPE_STRING )
        g_object_get_property( gtk_settings_get_default_(), "gtk-font-name", @gval )
        StdFnt = PeekS( g_value_get_string_( @gval ), -1, #PB_UTF8 )
        g_value_unset_( @gval )
        ProcedureReturn StdFnt 
        
    CompilerEndSelect
  EndProcedure
  
Procedure FontSize( FontID )
    CompilerSelect #PB_Compiler_OS 
      CompilerCase #PB_OS_Windows 
        Protected sysFont.LOGFONT
        GetObject_(FontID, SizeOf(LOGFONT), @sysFont)
        ProcedureReturn MulDiv_(-sysFont\lfHeight, 72, GetDeviceCaps_(GetDC_(#NUL), #LOGPIXELSY))
        
      CompilerCase #PB_OS_Linux
        Protected   gVal.GValue
        Protected.s StdFnt
        g_value_init_(@gval, #G_TYPE_STRING)
        g_object_get_property( gtk_settings_get_default_(), "gtk-font-name", @gval)
        StdFnt= PeekS(g_value_get_string_(@gval), -1, #PB_UTF8)
        g_value_unset_(@gval)
        ProcedureReturn Val(StringField((StdFnt), 2, " "))
        
    CompilerEndSelect
  EndProcedure
  
  
OpenWindow(1,100,100,450,420,"Test",#PB_Window_SystemMenu)
LoadFont(1,"Monaco",13)
SetGadgetFont(#PB_Default,FontID(1))
TextGadget(1,20,10,800,50,"default font monaco for all gadgets")

Debug "font from all gadgets default "
Debug FontName( GetGadgetFont(#PB_Default) )
Debug FontSize( GetGadgetFont(#PB_Default) )

LoadFont(2,"Courier New",21)
TextGadget(10,20,300,800,50,"font requiring pixels")
SetGadgetFont(10,FontID(2))

Debug ""
Debug "font from gadget 10 "
Debug FontName( GetGadgetFont(10) )
Debug FontSize( GetGadgetFont(10) )

LoadFont(3,"Arial",35)
TextGadget(11,20,350,800,50,"font requiring pixels")
SetGadgetFont(11,FontID(3))

Debug ""
Debug "font from gadget 11 "
Debug FontName( GetGadgetFont(11) )
Debug FontSize( GetGadgetFont(11) )


Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
Top
Post Reply

Return to “Tricks 'n' Tips”