Page 1 of 1
GetFontName, GetFontSize, GetFont...
Posted: Tue Aug 26, 2008 8:50 am
by 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.
Posted: Tue Aug 26, 2008 2:21 pm
by gnozal
DarkDragon wrote:...
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
Posted: Tue Aug 26, 2008 2:36 pm
by 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.
Posted: Wed Aug 27, 2008 10:45 am
by 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