GetFontName, GetFontSize, GetFont...

[DarkDragon]

Hello,

Can we have a few methods for getting the fontname and fontsize and fontstyle from a FontID(#Font)?

I need it for saving the font of a gadget the user has changed.

It would be very useful. Otherwise you always have to workaround and it's annoying.

[gnozal]

...
I need it for saving the font of a gadget the user has changed.
...

I am not sure if you want some code, but this should work (windows only) :

Code: Select all

; get gadget font ID
FontID = SendMessage_(GadgetID(Gadget), #WM_GETFONT, 0, 0)
GetObject_(FontID, SizeOf(LOGFONT), @FInfo.LOGFONT)
; set font requester params
ChooseFont.CHOOSEFONT
ChooseFont\lStructSize = SizeOf(CHOOSEFONT) 
ChooseFont\lpLogFont = @FInfo
ChooseFont\flags = #CF_INITTOLOGFONTSTRUCT | #CF_SCREENFONTS
; font requester
If ChooseFont_(@ChooseFont)
  *FInfo.LOGFONT = ChooseFont\lpLogFont
  TmpFont.s = PeekS(@*FInfo\lfFaceName[0]) ; Font name
  TmpSize = ChooseFont\iPointSize / 10 ; Font size
  TmpFlags = 0 ; Font flags
  If *FInfo\lfWeight > 400
    TmpFlags | #PB_Font_Bold 
  EndIf 
  If *FInfo\lfItalic 
    TmpFlags | #PB_Font_Italic 
  EndIf 
  If *FInfo\lfUnderline 
    TmpFlags | #PB_Font_Underline 
  EndIf 
  If *FInfo\lfStrikeOut 
    TmpFlags | #PB_Font_StrikeOut 
  EndIf 
  If *FInfo\lfQuality <> #DEFAULT_QUALITY 
    TmpFlags | #PB_Font_HighQuality 
  EndIf      
EndIf

[DarkDragon]

Thanks gnozal for your help. Maybe it's the best to stay on windows for now, but maybe Fred will implement this for all OS if it's not too much work.

[akj]

Here is my slightly different way of doing it:

Code: Select all

Procedure.l GetScreenDPI(horiz.b=#False)
; Get screen dots per inch vertically (default) or horizontally
Protected hdc, dpi
hdc = GetDC_(0) ; Desktop device context
If horiz
  dpi = GetDeviceCaps_(hdc, #LOGPIXELSX)
Else
  dpi = GetDeviceCaps_(hdc, #LOGPIXELSY)
EndIf
ReleaseDC_(0, hdc)
ProcedureReturn dpi
EndProcedure

Procedure.l GetFontHeight(gadget)
; Get gadget font height in points (to the nearest integer)
Protected fontid, finfo.LOGFONT, height
fontid = SendMessage_(GadgetID(gadget), #WM_GETFONT, 0, 0)
GetObject_(fontid, SizeOf(LOGFONT), @finfo)
height = finfo\lfHeight: If height<0: height = -height: EndIf
; Must do floating point arithmetic on the next line to get the right result
height*72.0/GetScreenDPI() ; Possibly the 72.0 is wrong and should be 72.27
ProcedureReturn height ; Font size
EndProcedure

Procedure.s GetFontName(gadget)
; Get gadget font name
Protected fontid, finfo.LOGFONT
fontid = SendMessage_(GadgetID(gadget), #WM_GETFONT, 0, 0)
GetObject_(fontid, SizeOf(LOGFONT), @finfo)
ProcedureReturn PeekS(@finfo\lfFaceName[0]) ; Font name
EndProcedure

Procedure.s GetFontFlags(gadget)
; Get gadget font attributes as an uppercase text string
Protected fontid, finfo.LOGFONT, flags$
fontid = SendMessage_(GadgetID(gadget), #WM_GETFONT, 0, 0)
GetObject_(fontid, SizeOf(LOGFONT), @finfo)
flags$ = "" ; Font flags
If finfo\lfWeight > #FW_NORMAL: flags$ + "B": EndIf ; Bold
If finfo\lfItalic: flags$ + "I": EndIf ; Italic
If finfo\lfQuality <> #DEFAULT_QUALITY: flags$ + "Q": EndIf ; High Quality
If finfo\lfStrikeOut: flags$ + "S" : EndIf ; StrikeOut
If finfo\lfUnderline: flags$ + "U": EndIf ; Underline
ProcedureReturn flags$ ; Font attributes
EndProcedure