Requires: Direct2D.lg32
Returns the pixel coordinates for a given textposition.
D2TL_HitTestTextPos D2Layout, charpos, Pointx!, Pointy!, HitTestMetrics [,isTrailingHit]
| D2Layout | : Object |
| charpos | : integer |
| PointX!, PointY! | : float variables |
| HitTestMetrics | : variable of type DWRITE_HIT_TEST_METRICS |
Returns in PointX and PointY the pixel location relative to the top-left of the layout box given the text position charpos. The output geometry fully enclosing the specified text position is returned in a variable of type DWRITE_HIT_TEST_METRICS. Optionally specify the logical side of the position by setting isTrailing to True. When True indicates whether the pixel location is of the trailing side of the specified text position. By default, the coordinates obtained are at the leading side of the text position.
This function is normally used as part of caret positioning of text where the caret is drawn at the location corresponding to the current text editing position.
'
' D2TL_HitTestTextPos (dpi-aware)
' Position the caret using the mouse.
'
$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_MouseDown(Button&, Shift&, x!, y!)
' x!, y! in ScaleWidth/ScaleHeight units (96 dpi, same as D2)
Local chpos As Long
' Inspect textlayout at coordinates relative to (10, 10)
' Only when hit inside string, do not handle IsTrailing.
chpos = D2TL_HitTestPoint(oTL1, x! - 10, y! - 10)
If chpos >= 0 ' Toggle underlining of char
charpos = chpos
UpdateCaretPos
' Call _Paint event sub directly rather than using the Invaldate method.
' This prevents a flash when GB clears the window as part of the WM_PAINT processing.
Win_1_Paint
EndIf
EndSub
Sub Win_1_ReSize
D2ResizeRT RT1, _X, _Y
UpdateCaretPos
Proc UpdateCaretPos()
Dim caretMetrics As DWRITE_HIT_TEST_METRICS
D2TL_HitTestTextPos oTL1, charpos, caretX!, caretY!, caretMetrics
caretH! = D2DIPsToPixel(caretMetrics.height)
~CreateCaret(Me.hWnd, Null, 0, caretH!)
~SetCaretPos(D2DIPsToPixel(10 + caretX!), D2DIPsToPixel(10 + caretY!))
~ShowCaret(Me.hWnd)
EndProc
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_HitTestTextPos is a wrapper for the IDWriteTextLayout::HitTestTextPosition method. The DWRITE_HIT_TEST_METRICS type is described here.
D2TL_HitTestPoint, D2TL_HitTestTextRange, D2TL_LineMetrics, D2TL_Metrics, D2Layout, D2TextLayout, D2DefLayout, D2RLayout
{Created by Sjouke Hamstra; Last updated: 03/03/2022 by James Gaite}