Code : Tout sélectionner
; Code de srod
Procedure.l GetTextDimensions(hWndHDC, text$, *sz.SIZE, blnIsHDC = 1)
Protected result, hdc, tm.TEXTMETRIC, abc.ABC, overhang, oldFont, char
If text$ And *sz
If blnIsHDC = 0 ; si 0 => hWndHDC= gadgetid()
hdc = GetDC_(hWndHDC) ; alors on obtient le hdc
If hdc = 0
ProcedureReturn #False
EndIf
oldFont = SelectObject_(hdc, SendMessage_(hWndHDC, #WM_GETFONT, 0, 0))
Else
hdc = hWndHDC ; sinon on a déjà le hdc
EndIf
; dimensions. Equivalent à TextWidth() et TextHeight().
GetTextExtentPoint32_(hdc, @text$, Len(text$), *sz)
; @text$=GetGadgetText(numb), Len(text$)=Len(GetGadgetText(numb))
;Ajustement qui depend du type de font; raster ou true/open type.
GetTextMetrics_(hdc, tm)
;*sz\cy=tm\tmHeight-tm\tmInternalLeading ;on peut enlever le internal leading height
;Debug *sz\cy
;Debug tm\tmHeight
;Debug tm\tmInternalLeading
;Debug tm\tmOverhang
;Debug tm\tmExternalLeading
If tm\tmOverhang ;Raster font.
*sz\cx + tm\tmOverhang
Else
char = Asc(Right(text$,1))
GetCharABCWidths_(hdc, char, char, abc)
overhang = abc\abcC
If overHang < 0
*sz\cx - overHang
EndIf
EndIf
;Tidy up.
If blnIsHDC = 0
SelectObject_(hdc, oldFont)
ReleaseDC_(hWndHDC, hdc)
EndIf
EndIf
ProcedureReturn #True
EndProcedure
;Test.
;=====
selectedFont.s = "Arial"
selectedFontSize = 24
text$ = "Heyho tiddly dee tiddly doo!"
If OpenWindow(0,10,10,600,600,"Test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
hWnd = TextGadget(1, 0, 0, 0, 0, text$, #WS_BORDER)
LoadFont(1, selectedFont, selectedFontSize, SelectedFontStyle)
SetGadgetFont(1, FontID(1))
ButtonGadget(2, 500,560, 80, 20, "Choose font")
GetTextDimensions(hWnd, text$, sz.SIZE, 0) ;0 informs the function that we are passing a hWnd as opposed to a HDC.
;GetTextDimensions(GadgetID(1), text$, sz.SIZE,0)
;Add on border widths etc.
sz\cx + 2*GetSystemMetrics_(#SM_CXBORDER)
sz\cy + 2*GetSystemMetrics_(#SM_CYBORDER)
ResizeGadget(1, (WindowWidth(0)-sz\cx)>>1, (WindowHeight(0)-sz\cy)>>1, sz\cx, sz\cy)
Repeat
Event=WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 2
If FontRequester(selectedFont, selectedFontSize, 0)
FreeFont(1)
selectedFont = SelectedFontName() : selectedFontSize = SelectedFontSize()
LoadFont(1, selectedFont, selectedFontSize, SelectedFontStyle())
SetGadgetFont(1, FontID(1))
GetTextDimensions(hWnd, text$, sz.SIZE, 0) ;0 informs the function that we are passing a hWnd as opposed to a HDC.
;Add on border widths etc.
sz\cx + 2*GetSystemMetrics_(#SM_CXBORDER)
sz\cy + 2*GetSystemMetrics_(#SM_CYBORDER)
ResizeGadget(1, (WindowWidth(0)-sz\cx)>>1, (WindowHeight(0)-sz\cy)>>1, sz\cx, sz\cy)
EndIf
EndSelect
EndSelect
Until Event=#PB_Event_CloseWindow
EndIf
