Requires: Direct2D.lg32
Retrieves overall metrics for the D2Layout object.
D2TL_Metrics D2Layout, Metrics
D2Layout | : Object |
Metrics | : variable of DWRITE_TEXT_METRICS type |
The command fills the specified variable of DWRITE_TEXT_METRICS with various calculated values of the D2Layout object.
'
' D2TL_Metrics (dpi-aware)
' Draws a rectangle around the text
'
$Library "direct2d"
$Library "gfawinx"
DpiAwareness()
OpenW 1, 0, 0, 300, 300, 48
FormScaleForDpi(Me)
Global Object RT1
Set RT1 = D2GetRT()
' Build a Text Layout object for a given text
Global Txt1$ = "Hello DirectX" #10 "This is GB" #10 "(GFABASIC 32)"
D2SetFont "Gabriola", 18 ' set a base font for TextLayout
' Obtain TextLayout for text with current font.
' If Txt1 or dimension changes recreate the TextLayout object.
Global oTL1 As Object
Set oTL1 = D2Layout(Txt1$, 100, 60)
' Set font data for text ranges
D2DefLayout oTL1, 0, 5, D2TL_FONTNAME, "Courier New"
D2DefLayout oTL1, 0, 5, D2TL_UNDERLINE, True
D2DefLayout oTL1, 0, 5, D2TL_FONTSIZE, 12
Do
Sleep
Until Me Is Nothing
Sub Win_1_Paint
D2BeginDraw RT1, D2C_WhiteSmoke
D2TextLayout 10, 10, oTL1, D2T_CENTER
' Get metrics after centering the layout
Local metrics As DWRITE_TEXT_METRICS, Width!, Height!
D2TL_Metrics oTL1, metrics
Width! = metrics.widthIncludingTrailingWhitespace
Height! = metrics.height
D2Box 10 + metrics.left, 10, 10 + metrics.left + Width!, 10 + Height!
D2EndDraw ' resets current render target to nothing
EndSub
Sub Win_1_ReSize
D2ResizeRT RT1, WorkWidth(), WorkHeight() ' _X, _Y
Sub Win_1_MessageProc(hWnd%, Mess%, wParam%, lParam%, retval%, ValidRet?)
If Mess == WM_DPICHANGED
If FormScaleForDpi(Me, wParam%, lParam%)
D2SetDpiRT RT1, LoWord(wParam%) ' Set DPI of the RT of Win1
EndIf
retval = 0, ValidRet? = True
EndIf
EndSub
Function FormScaleForDpi(ByVal frm As Form, Optional newdpi As Int, Optional lParam As Int) As Bool
Local i As Int, c As Control, rc As RECT, prevDpi As Int, newrc As Pointer To RECT, _
tb As Tab, w As Int, h As Int
With frm
' Set initial newdpi for the form and the scale factors for a LoadForm
If .WhatsThisHelpID == 0
If Exist(":{" + .Name) ' a Form-Editor form
.WhatsThisHelpID = WinDpi(0) ' initial dpi is system newdpi
.ScaleWidth = .ScaleWidth * 96 / .WhatsThisHelpID ' set initial scale factors
.ScaleHeight = .ScaleHeight * 96 / .WhatsThisHelpID
Else ' created by OpenW or Form command
.WhatsThisHelpID = 96 ' coord space is 96
EndIf
EndIf
prevDpi = .WhatsThisHelpID
newdpi = LoWord(newdpi)
If newdpi == 0 Then newdpi = WinDpi(.hWnd)
Exit Func If newdpi == prevDpi ' don't continue if equal
' Size the form, except if it is a child window
If !(GetWindowLong(.hWnd, GWL_STYLE) %& WS_CHILD)
If lParam ' size to the OS suggested size
Pointer newrc = lParam ' ptr to RECT in lParam
SizeW .hWnd, newrc.Right - newrc.Left, newrc.Bottom - newrc.Top
Else ' scale based on the current client size
GetClientSize .hWnd, w, h ' can't use _X _Y, they are for ME only
AdjustW .hWnd, Scale(w, newdpi, prevDpi), Scale(h, newdpi, prevDpi)
EndIf
EndIf
.FontSize = .FontSize * newdpi / prevDpi
.ScaleWidth = .ScaleWidth * prevDpi / newdpi
.ScaleHeight = .ScaleHeight * prevDpi / newdpi
' Scale position and size of the Ocx windowed controls
For Each c In frm.Controls
If !(TypeOf(c) Is ImageList || TypeOf(c) Is Timer || _
TypeOf(c) Is CommDlg || TypeOf(c) Is TrayIcon) ' not the windowless OCX-es
' First set fontsize, but not all OCX-es have a Font property
If !(TypeOf(c) Is ProgressBar || TypeOf(c) Is Slider || TypeOf(c) Is Image || TypeOf(c) Is RichEdit)
c.fontsize = c.fontsize * newdpi / prevDpi
ElseIf TypeOf(c) Is RichEdit ' Requires LoadRichEdit50W!
SendMessage c.hwnd, WM_DPICHANGED, MakeLong(newdpi, newdpi), 0
EndIf
' Set new position and size for OCX-controls
GetWinPos(c.hwnd, rc) ' relative to parent
~SetWindowPos(c.hwnd, 0, _
Scale(rc.Left, newdpi, prevDpi), Scale(rc.Top, newdpi, prevDpi), _
Scale(rc.Right - rc.Left, newdpi, prevDpi), _
Scale(rc.Bottom - rc.Top, newdpi, prevDpi), SWP_NOZORDER) ' new pos and size
If TypeOf(c) Is Form ' Scale OCX-es of a child Form Ocx
c.WhatsThisHelpID = prevDpi
~FormScaleForDpi(c, newdpi)
ElseIf TypeOf(c) Is TabStrip ' Scale TabStrip's attached forms
For Each tb In c.Tabs
If TypeOf(tb.Ocx) Is Form
tb.Ocx.WhatsThisHelpID = prevDpi
~FormScaleForDpi(tb.Ocx, newdpi)
EndIf
Next
EndIf
EndIf
Next
.WhatsThisHelpID = newdpi ' store new newdpi
EndWith
FormScaleForDpi = True
EndFunc
D2TL_Metrics is wrapper for the IDWriteTextLayout::GetMetrics method. The DWRITE_TEXT_METRICS is described here.
D2TL_HitTestPoint, D2TL_HitTestTextPos, D2TL_HitTestTextRange, D2TL_LineMetrics, D2Layout, D2TextLayout, D2DefLayout, D2RLayout.
{Created by Sjouke Hamstra; Last updated: 03/03/2022 by James Gaite}