Requires: Direct2D.lg32
Obtains an array of line metrics describing each line in a D2Layout object and returns the number of array entries read.
LineCount = D2TL_LineMetrics(D2Layout, LineMetrics())
| LineCount | : integer |
| D2Layout | : Object |
| LineMetrics() | : array of DWRITE_LINE_METRICS type |
The function fills the specified array of DWRITE_LINE_METRICS with various calculated length values of individual text lines. The function returns the number of lines found in the D2Layout object, the number also specifies the total number of entries for the array. The array is dimmed from 0 .. LineCount - 1.
'
' D2TL_LineMetrics (dpi-aware)
' Obtain caret's position, line and column number
'
$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)
' Show current line and column
Local Long LineNo, ColNo
GetColumnLine ColNo, LineNo
Me.Caption = "Line/Col:" + Dec(LineNo) + ", " + Dec(ColNo)
EndSub
Proc GetColumnLine(ByRef iCol As Long, ByRef iLine As Long)
Local lineMetrics() As DWRITE_LINE_METRICS, lineCnt As Long, _
iPos As Long, iStartLine As Long
lineCnt = D2TL_LineMetrics(oTL1, lineMetrics())
While iLine < lineCnt ' find line from charpos
iStartLine = iPos ' TxtPos of start-of-line
iPos += lineMetrics(iLine).length
Exit Do If iPos > charpos
iLine++
Wend
iCol = charpos - iStartLine ' column # in line
EndProc
Sub Win_1_MouseDown(Button&, Shift&, x!, y!)
' x!, y! in ScaleWidth/ScaleHeight units (96 dpi coord space, same as D2)
Local chpos As Long
' Inspect textlayout at coordinates relative to (10, 10)
' Only when hit is inside string, do not handle IsTrailing.
chpos = D2TL_HitTestPoint(oTL1, x! - 10, y! - 10)
If chpos >= 0 ' Toggle underlining of char
charpos = chpos
UpdateCaretPos
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
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_LineMetrics is wrapper for the IDWriteTextLayout::GetLineMetrics method. The DWRITE_LINE_METRICS is described here.
D2TL_HitTestPoint, D2TL_HitTestTextPos, D2TL_HitTestTextRange, D2TL_Metrics, D2Layout, D2TextLayout, D2DefLayout, D2RLayout
{Created by Sjouke Hamstra; Last updated: 03/03/2022 by James Gaite}