Requires: Direct2D.lg32
Obtains an array of cluster metrics with the information for each cluster (word) and returns the number of array entries.
ClusterCount = D2TL_ClusterMetrics(D2Layout, ClusterMetrics())
| HitTestCount, ClusterCount | : integer |
| D2Layout | : Object |
| ClusterMetrics() | : array of DWRITECLUSTERMETRICS type |
D2TL_ClusterMetrics obtains an array with logical properties and measurements of each glyph cluster (word). The function returns the number of array entries actually obtained. When the function returns 0 the array is not filled and not (re-)dimensioned, otherwise the array is dimensioned to the number of entries required to store the hit-test metrics information. The array is dimmed from 0 .. ClusterCount - 1.
One of the main usages is to implement caret movement from word to word, see example.
Type DWRITECLUSTERMETRICS
- Float width
- Card length
canWrapLineAfter As Bits 1
isWhitespace As Bits 1
isNewline As Bits 1
isSoftHyphen As Bits 1
isRightToLeft As Bits 1
padding As Bits 11
EndType
'
' D2TL_ClusterMetrics (dpi-aware)
'
' Move arrow keys Left/Right to move caret from word to word.
'
$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
Global charpos As Long, caretX!, caretY!, caretH!
UpdateCaretPos
Do
Sleep
Until Me Is Nothing
Sub Win_1_Paint
~HideCaret(0)
D2BeginDraw RT1, D2C_WhiteSmoke
D2TextLayout 10, 10, oTL1 //, D2T_CENTER
D2EndDraw ' resets current render target to nothing
~ShowCaret(0)
EndSub
Sub Win_1_KeyDown(Code&, Shift&)
Local clusterMetrics() As DWRITE_CLUSTER_METRICS, cluster As Long, clusterpos As Long
Local clusterCnt As Long, clusterlength As Long, oldcharpos As Long
Switch Code&
Case VK_RIGHT
clusterCnt = D2TL_ClusterMetrics(oTL1, clusterMetrics())
oldcharpos = charpos, charpos = 0
While cluster < clusterCnt
clusterlength = clusterMetrics(cluster).length
If clusterpos + clusterlength > oldcharpos && clusterMetrics(cluster).canWrapLineAfter
charpos = clusterpos + clusterlength
Exit Do
EndIf
clusterpos += clusterlength
charpos = clusterpos
cluster++
Wend
UpdateCaretPos
Win_1_Paint
Case VK_LEFT
clusterCnt = D2TL_ClusterMetrics(oTL1, clusterMetrics())
oldcharpos = charpos, charpos = 0
While cluster < clusterCnt
clusterpos += clusterMetrics(cluster).length
If clusterMetrics(cluster).canWrapLineAfter
Exit Do If clusterpos >= oldcharpos
charpos = clusterpos
EndIf
cluster++
Wend
UpdateCaretPos
Win_1_Paint
EndSwitch
EndSub
Proc UpdateCaretPos()
Dim caretMetrics As DWRITE_HIT_TEST_METRICS
D2TL_HitTestTextPos oTL1, charpos, caretX!, caretY!, caretMetrics
caretH! = D2DIPsToPixel(caretMetrics.height)
~CreateCaret(Me.hWnd, Null, 2, caretH!)
~SetCaretPos(D2DIPsToPixel(10 + caretX!), D2DIPsToPixel(10 + caretY!))
~ShowCaret(Me.hWnd)
EndProc
Sub Win_1_ReSize
D2ResizeRT RT1, _X, _Y
UpdateCaretPos
Sub Win_1_MessageProc(hWnd%, Mess%, wParam%, lParam%, retval%, ValidRet?)
If Mess == WM_DPICHANGED
If FormScaleForDpi(Me, wParam%, lParam%)
UpdateCaretPos
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
D2TLClusterMetrics is a wrapper for the IDWriteTextLayout::GetClusterMetrics method. The DWRITECLUSTERMETRICS type is described at https://docs.microsoft.com/en-us/windows/win32/api/dwrite/ns-dwrite-dwriteclustermetrics.
D2TL_HitTestPoint, D2TL_HitTestTextPos, D2TL_HitTestTextRange, D2TL_LineMetrics, D2TL_Metrics, D2Layout, D2TextLayout, D2DefLayout, D2RLayout
{Created by Sjouke Hamstra; Last updated: 03/03/2022 by James Gaite}