Requires: Direct2D.lg32
Returns the index of the character at the specified pixel coordinate. Optionally obtains information about the correspondent hit-test metrics of the text string where the hit-test has occurred.
charpos = D2TL_HitTestPoint(D2Layout, x!, y! [, pHitTestMetrics])
| charpos | : integer |
| D2Layout | : Object variable referencing a text layout object |
| x!, y! | : float expression |
| pHitTestMetrics | : address of a DWRITE_HIT_TEST_METRICS type |
The coordinates x and y must be relative to the display position of the D2TextLayout object. If the hittest for the coordinates have an underlying character the function returns the index of the character (base 0). More information about the hittest result is provided in a DWRITE_HIT_TEST_METRICS type. The program can access this information if it passes the address of a variable of this type, like this:
Dim hitTest As DWRITE_HIT_TEST_METRICS
charpos = D2TL_HitTestPoint(D2Layout, x!, y!, V:hitTest)
'
' D2TL_HitTestPoint (dpi-aware)
'
' Click a character to toggle underlining.
'
$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
D2EndDraw ' resets current render target to nothing
EndSub
Sub Win_1_MouseDown(Button&, Shift&, x!, y!)
' x!, y! in ScaleWidth/ScaleHeight units (96 dpi coord space, same ad D2)
' _HitTestPos requires DIPs as well, so convert x!, y! to DIPS
Local charpos As Long, fUnderLine As Bool
' Inspect textlayout at coordinates relative to (10, 10)
' Only when hit is inside string, do not handle IsTrailing.
charpos = D2TL_HitTestPoint(oTL1, x! - 10, y! - 10)
If charpos >= 0 ' Toggle underlining of char
fUnderLine = D2RLayout(oTL1, D2TL_UNDERLINE, charpos)
D2DefLayout oTL1, charpos, 1, D2TL_UNDERLINE, !fUnderLine
Win_1.Invalidate
EndIf
EndSub
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_HitTestPoint is wrapper for the IDWriteTextLayout::HitTestPoint method.
For more information see here.
The DWRITE_HIT_TEST_METRICS type is described here.
D2TL_HitTestTextPos, D2TL_LineMetrics, D2TL_Metrics, D2TL_HitTestTextRange, D2Layout, D2TextLayout, D2DefLayout, D2RLayout
{Created by Sjouke Hamstra; Last updated: 03/03/2022 by James Gaite}