Informations sur une police de caractère (Windows)
Publié : jeu. 14/oct./2010 18:12
Pure Basic à ma connaissance ne retourne pas encore le Nom, la taille et le style d'une police de caractère.
Il est necessaire de passer par les API Windows pour récupérer les informations de la police à partir du handle de ton gadget dans une structure LOGFONT
3 procédures :
GetGadgetFontName(Gadget.l) Retourne le nom de la police utilisée dans un gadget.
GetgadgetFontHeight(Gadget.l) Retourne la taille de la police utilisée dans un gadget
GetGadgetFontStyles(Gadget) Retourne le style de la police utilisée dans un gadget sous la forme d'un flag combinant les valeurs suivantes.
#PB_Font_Bold (Valeur 256)
#PB_Font_Italic (Valeur 512)
#PB_Font_Underline (Valeur 4)
#PB_Font_StrikeOut (Valeur
#PB_Font_HighQuality (Valeur 16)
Exemple #PB_Font_Bold et #PB_Font_Italic donnera la valeur 768
GetGadgetFontName(Gadget.l) Retourne le nom de la police utilisée dans un gadget.
GetgadgetFontHeight(Gadget.l) Retourne la taille de la police utilisée dans un gadget
GetGadgetFontStyles(Gadget) Retourne le style de la police utilisée dans un gadget
On place ces trois procédures dans un fichier qu'on nommera par exemple fontinfo.pbi
Et maintenant un exemple de code pour illustrer ces trois procedures.
Il est necessaire de passer par les API Windows pour récupérer les informations de la police à partir du handle de ton gadget dans une structure LOGFONT
3 procédures :
GetGadgetFontName(Gadget.l) Retourne le nom de la police utilisée dans un gadget.
GetgadgetFontHeight(Gadget.l) Retourne la taille de la police utilisée dans un gadget
GetGadgetFontStyles(Gadget) Retourne le style de la police utilisée dans un gadget sous la forme d'un flag combinant les valeurs suivantes.
#PB_Font_Bold (Valeur 256)
#PB_Font_Italic (Valeur 512)
#PB_Font_Underline (Valeur 4)
#PB_Font_StrikeOut (Valeur
#PB_Font_HighQuality (Valeur 16)
Exemple #PB_Font_Bold et #PB_Font_Italic donnera la valeur 768
GetGadgetFontName(Gadget.l) Retourne le nom de la police utilisée dans un gadget.
Code : Tout sélectionner
;Retoune la police de caractére du gadget
Procedure.s GetGadgetFontName(Gadget.l)
Protected FontInfo.LOGFONT
GetObject_(GetGadgetFont(Gadget), SizeOf(LOGFONT), @FontInfo)
ProcedureReturn PeekS(@FontInfo\lfFaceName[0])
EndProcedure
Code : Tout sélectionner
;Retounr la taille de la police de caracatere d'un gadget.
Procedure.l GetgadgetFontHeight(Gadget.l)
Protected dpi.l, FontInfo.LOGFONT, FontHeight.l
dpi=GetDeviceCaps_(GetDC_(GetActiveWindow()), #LOGPIXELSY)
ReleaseDC_(0, (GetDC_(GetActiveWindow())))
GetObject_(GetGadgetFont(Gadget), SizeOf(LOGFONT), @FontInfo)
FontHeight = FontInfo\lfHeight
If FontHeight<0
FontHeight = -FontHeight
EndIf
FontHeight*(72.0/dpi)
ProcedureReturn FontHeight
EndProcedureCode : Tout sélectionner
;Retourne le style de la police de caractere du gadget (Gras, Italic, ........)
Procedure.l GetGadgetFontStyles(Gadget)
Protected FontInfo.LOGFONT, FontStyles.l
GetObject_(GetGadgetFont(Gadget), SizeOf(LOGFONT), @FontInfo)
FontStyles = 0
If FontInfo\lfWeight > #FW_NORMAL ;(Couvre les valeurs de FW_REGULAR à FW_BLACK)
FontStyles = #PB_Font_Bold
EndIf
If FontInfo\lfItalic ;(True si Vrai)
FontStyles + #PB_Font_Italic
EndIf
If FontInfo\lfQuality <> #DEFAULT_QUALITY
FontStyles + #PB_Font_HighQuality
EndIf
If FontInfo\lfStrikeOut ;(True si Vrai)
FontStyles + #PB_Font_StrikeOut
EndIf
If FontInfo\lfUnderline ;(True si Vrai)
FontStyles + #PB_Font_Underline
EndIf
ProcedureReturn FontStyles
EndProcedure
Et maintenant un exemple de code pour illustrer ces trois procedures.
Code : Tout sélectionner
IncludeFile "fontinfo.pbi"
Enumeration
#MainForm
#Edit
#FontApp
EndEnumeration
Procedure MainFormShow()
font1=LoadFont(#FontApp,"Arial",11,#PB_Font_Bold | #PB_Font_Italic)
SetGadgetFont(#PB_Default,FontID(#FontApp))
OpenWindow(#MainForm,0,0,400,300,"Police information")
StringGadget(#Edit, 20,20,100,24,"Abandon")
SetGadgetColor(#edit,#PB_Gadget_FrontColor,$0D2CF2)
EndProcedure
MainFormShow()
Debug "Police " + GetgadgetFontName(#edit)
Debug "Taille " + Str(GetGadgetFontHeight(#edit))
Debug "Styles "+ Str(GetGadgetFontStyles(#edit))
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
