Requires: Direct2D.lg32
Obtains an array of hit-test metrics describing the specified text range and returns the number of array entries.
HitTestCount = D2TL_HitTestTextRange(D2Layout, charpos, length, originx!, originy!, HitTestMetrics())
| HitTestCount | : integer |
| D2Layout | : Object |
| charpos, length | : integer expression |
| originx, originy | : float expression |
| HitTestMetrics() | : array of DWRITE_HIT_TEST_METRICS type |
D2TL_HitTestTextRange obtains an array with a set of hit-test metrics with rectangles corresponding to a range of text specified by charpos and length. 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 .. HitTestCount - 1.
One of the main usages is to implement highlight selection of the text string, see example.
The originx! and originy! arguments specify the pixel locations X and Y at the top-left of the layout box. This offset is added to the hit-test metrics returned.
'
' D2TL_HitTestTextRange (dpi-aware)
' Demonstrates how to draw a selected text.
'
$Library "direct2d"
$Library "gfawinx"
DpiAwareness()
OpenW 1, 0, 0, 300, 300, 48
SizeW 1, ScaleToDpi(300), ScaleToDpi(300)
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)"
' Set a base font for the TextLayout
D2SetFont "Gabriola", 18
' 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
' Define a selectionrange
Global Int SelStart = 5, SelLength = 10
Do
Sleep
Until Me Is Nothing
Sub Win_1_Paint
D2BeginDraw RT1, D2C_WhiteSmoke
DrawSelection()
D2TextLayout 10, 10, oTL1 //, D2T_CENTER
D2EndDraw ' resets current render target to nothing
EndSub
Proc DrawSelection()
Local htm() As DWRITE_HIT_TEST_METRICS, i As Long
' Obtain the array with rectangles for the range,
' returns the number of entries for the array.
If D2TL_HitTestTextRange(oTL1, SelStart, SelLength, 10, 10, htm())
D2DefFill D2C_LightBlue ' Fill with solid color brush
D2DefLine , 0
For i = 0 To UBound(htm())
D2PBox htm(i).left, htm(i).top, _
htm(i).left + htm(i).width, htm(i).top + htm(i).height
Next
EndIf
EndProc
Sub Win_1_ReSize
D2ResizeRT RT1, _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_HitTestTextRange is wrapper for the IDWriteTextLayout::HitTestTextRange method. The DWRITE_HIT_TEST_METRICS type is described here.
D2TL_HitTestPoint, D2TL_HitTestTextPos, D2TL_LineMetrics, D2TL_Metrics, D2Layout, D2TextLayout, D2DefLayout, D2RLayout
{Created by Sjouke Hamstra; Last updated: 03/03/2022 by James Gaite}