Taille des gadgets adapté à la taille du texte
Publié : mer. 18/janv./2012 16:12
Ce code permet de changer la taille en longueur et en hauteur d'un gadget pour l'adapter à la police en cours.
Changer le texte du premier StringGadget et appuyer sur les boutons...
Les boutons change la police et ses attributs.
Il y a un petit bug sur le 2è StringGadget avec peu de caractères et en gras (bouton 10 G)
A part le bug, merci de me dire s'il fonctionne sous 7 et sous vista.
Mesa.
Changer le texte du premier StringGadget et appuyer sur les boutons...
Les boutons change la police et ses attributs.
Il y a un petit bug sur le 2è StringGadget avec peu de caractères et en gras (bouton 10 G)
A part le bug, merci de me dire s'il fonctionne sous 7 et sous vista.
Mesa.
Code : Tout sélectionner
Enumeration
#Window_0
EndEnumeration
Enumeration
#String_0
#String_1
#Editor_Gadget_0
#CheckBox_Gadget_0
#Bouton_0
#Bouton_1
#Bouton_2
#Bouton_3
#Text_0
#Text_1
EndEnumeration
Procedure.l LoadWindowFont(Bold = -1, Italic = -1, UnderLine = -1, Size.f = -1)
Protected ncm.NONCLIENTMETRICS
ncm\cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
If Bold = 0
ncm\lfMessageFont\lfWeight = 0
ElseIf Bold = 1
ncm\lfMessageFont\lfWeight = 700
EndIf
If Italic = 0
ncm\lfMessageFont\lfItalic = 0
ElseIf Italic = 1
ncm\lfMessageFont\lfItalic = 1
EndIf
If UnderLine = 0
ncm\lfMessageFont\lfUnderline = 0
ElseIf UnderLine = 1
ncm\lfMessageFont\lfUnderline = 1
EndIf
If Size > 0
ncm\lfMessageFont\lfheight * Size
EndIf
; Debug PeekS(@ncm\lfMessageFont\lfFaceName, 32)
; CompilerIf #PB_Compiler_Debugger
; DC = GetDC_(0)
; Debug Round(Abs(ncm\lfMessageFont\lfheight) * 72 / GetDeviceCaps_(DC, #LOGPIXELSY), #PB_Round_Nearest)
; ReleaseDC_(0, DC)
; CompilerEndIf
;
ProcedureReturn CreateFontIndirect_(@ncm\lfMessageFont)
EndProcedure
Procedure.l GetTextWidthPix(numb, espace=1)
;espace : null-terminated + pour la checkbox par exemple, il faut ajouter la largeur d'un espace au texte
hDC = GetDC_(GadgetID(numb))
hFont = SendMessage_(GadgetID(numb),#WM_GETFONT,0,0)
If hFont And hDC
SelectObject_(hDC,hFont)
EndIf
GetTextExtentPoint32_(hDC, GetGadgetText(numb), Len(GetGadgetText(numb)) + espace, lpSize.SIZE)
result=lpSize\cx
ReleaseDC_(#Window_0, hDC)
ProcedureReturn result
EndProcedure
Procedure.l GetTextHeightPix(numb, espace=8)
; pourquoi 8 ?????
hDC = GetDC_(GadgetID(numb))
hFont = SendMessage_(GadgetID(numb),#WM_GETFONT,0,0)
If hFont And hDC
SelectObject_(hDC,hFont)
EndIf
GetTextExtentPoint32_(hDC, GetGadgetText(numb), Len(GetGadgetText(numb)), lpSize.SIZE)
result=lpSize\cy + espace
ReleaseDC_(#Window_0, hDC)
ProcedureReturn result
EndProcedure
LoadFont(1, "Arial", 10,#PB_Font_Bold )
LoadFont(2, "Arial", 10)
LoadFont(3, "Arial", 20,#PB_Font_Italic)
;SetGadgetFont(#PB_Default, FontID(2))
FontID = LoadWindowFont(); police par défaut
;SetGadgetFont(#PB_Default, FontID)
OpenWindow(#Window_0, 0, 0, 900, 450, "Taille du texte", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget )
;CreateGadgetList(WindowID(#Window_0))
StringGadget(#String_0, 10, 10, 380, 25, "Cliquez-moi et entrez du texte svp.");)
SetGadgetFont(#String_0, FontID)
StringGadget(#String_1, 10, 100, 10, 25, "")
SetGadgetText(#String_1, GetGadgetText(#String_0))
EditorGadget(#Editor_Gadget_0, 10, 170, 380, 100)
SetGadgetText(#Editor_Gadget_0, GetGadgetText(#String_0))
CheckBoxGadget(#CheckBox_Gadget_0, 10, 300, 380, 25, GetGadgetText(#String_0))
TextGadget(#Text_1, 10, 360, 600, 40, "Police de caractère : cliquez sur les boutons")
ButtonGadget(#Bouton_0,10,400,60,30,"10 G")
ButtonGadget(#Bouton_1,100,400,60,30,"10")
ButtonGadget(#Bouton_2,200,400,60,30,"20 I")
ButtonGadget(#Bouton_3,300,400,60,30,"Défaut")
string$=Str(GetTextWidthPix(#String_0))+"/"+Str(GetTextHeightPix(#String_0))+" pix"
TextGadget(#Text_0, 10, 40, 600, 20, string$)
SetActiveGadget(#String_0)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #String_0
string$="w/h= "+Str(GetTextWidthPix(#String_0))+"/"+Str(GetTextHeightPix(#String_0))+" pix, il est normal que ce stringGadget ne soit pas ReDim"
SetGadgetText(#Text_0, string$)
ResizeGadget(#String_1, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), GetTextHeightPix(#String_0))
SetGadgetText(#String_1, GetGadgetText(#String_0))
ResizeGadget(#Editor_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), #PB_Ignore)
SetGadgetText(#Editor_Gadget_0, GetGadgetText(#String_0))
ResizeGadget(#CheckBox_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0,3), GetTextHeightPix(#String_0))
SetGadgetText(#CheckBox_Gadget_0, GetGadgetText(#String_0))
Case #Bouton_0
SetGadgetFont(#String_0, FontID(1))
SetGadgetFont(#String_1, FontID(1))
SetGadgetFont(#Editor_Gadget_0, FontID(1))
SetGadgetFont(#CheckBox_Gadget_0, FontID(1))
ResizeGadget(#String_1, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), GetTextHeightPix(#String_0))
ResizeGadget(#Editor_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), #PB_Ignore)
ResizeGadget(#CheckBox_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0,3), GetTextHeightPix(#String_0))
SetWindowTitle(#Window_0, "ARIAL 10 + Gras")
SetActiveGadget(#String_0)
Case #Bouton_1
SetGadgetFont(#String_0, FontID(2))
SetGadgetFont(#String_1, FontID(2))
SetGadgetFont(#Editor_Gadget_0, FontID(2))
SetGadgetFont(#CheckBox_Gadget_0, FontID(2))
ResizeGadget(#String_1, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), GetTextHeightPix(#String_0))
ResizeGadget(#Editor_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), #PB_Ignore)
ResizeGadget(#CheckBox_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0,3), GetTextHeightPix(#String_0))
SetWindowTitle(#Window_0, "ARIAL 10")
SetActiveGadget(#String_0)
Case #Bouton_2
SetGadgetFont(#String_0, FontID(3))
SetGadgetFont(#String_1, FontID(3))
SetGadgetFont(#Editor_Gadget_0, FontID(3))
SetGadgetFont(#CheckBox_Gadget_0, FontID(3))
ResizeGadget(#String_1, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), GetTextHeightPix(#String_0))
ResizeGadget(#Editor_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), #PB_Ignore)
ResizeGadget(#CheckBox_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0,3), GetTextHeightPix(#String_0))
SetWindowTitle(#Window_0, "ARIAL 20 + Italic")
SetActiveGadget(#String_0)
Case #Bouton_3
SetGadgetFont(#String_0, FontID)
SetGadgetFont(#String_1, FontID)
SetGadgetFont(#Editor_Gadget_0, FontID)
SetGadgetFont(#CheckBox_Gadget_0, FontID)
ResizeGadget(#String_1, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), GetTextHeightPix(#String_0))
ResizeGadget(#Editor_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0), #PB_Ignore)
ResizeGadget(#CheckBox_Gadget_0, #PB_Ignore, #PB_Ignore, GetTextWidthPix(#String_0,3), GetTextHeightPix(#String_0))
SetWindowTitle(#Window_0, "Par défaut")
SetActiveGadget(#String_0)
Select EventType()
EndSelect
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
End
