DrawText draws Segoe UI font texts incorrectly - winapi

Question

I encountered one problem with drawing texts using the Windows API DrawText call for the Segoe UI font:
This image demonstrates the problem: the specified text is shifted a little bit to the right in the specified rectangle so the last character is clipped (the best example is the 0 digit).
Our drawing routine works well for other fonts, and the problem occurs only for Segoe UI.
What it could be and how to solve it?
Doing this in a VB6 OCX project on Windows 8 Pro 64-bit if it matters.
The corresponding code source snippet is the following:
' Only draws or measure text (if DT_CALCRECT is specified)
' using the native WinAPI flags:
Public Sub gpInternalDrawText( _
ByVal lHDC As Long, _
ByRef sText As String, _
ByRef tR As RECT, _
ByVal lFlags As Long _
)
' Allows Unicode rendering of text under NT/2000/XP
If (g_bIsNt) Then
' NT4 crashes with ptr = 0
If StrPtr(sText) <> 0 Then
DrawTextW lHDC, StrPtr(sText), -1, tR, lFlags
End If
Else
DrawTextA lHDC, sText, -1, tR, lFlags
End If
End Sub
' Draws the string in the specifed rectangle.
' Should not be called to calculate text size
' (with DT_CALCRECT flag - use gpInternalDrawText instead)
Public Sub DrawText( _
ByVal lHDC As Long, _
ByRef sText As String, _
ByRef rcText As RECT, _
ByVal lFlags As Long, _
Optional ByVal eAlignH As Long = 0, _
Optional ByVal eAlignV As Long = 0 _
)
' *** Automatically turns processing prefixes off (if required)
If (lFlags And &H200000) = 0 Then
lFlags = lFlags Or DT_NOPREFIX
Else
lFlags = lFlags Xor DT_PREFIXONLY
End If
' *** We can modify rcText below, so do it with its copy
Dim rcDrawText As RECT
LSet rcDrawText = rcText
' *** Getting the full set of API flags for our text
Select Case eAlignH
' in fact don't need that as DT_LEFT=0:
' Case igAlignHLeft
' lFlags = lFlags Or DT_LEFT
Case igAlignHCenter
lFlags = lFlags Or DT_CENTER
Case igAlignHRight
lFlags = lFlags Or DT_RIGHT
End Select
If (lFlags And DT_SINGLELINE) <> 0 Then
Select Case eAlignV
' in fact don't need that as DT_TOP=0:
' Case igAlignVTop
' lFlags = lFlags Or DT_TOP
Case igAlignVCenter
lFlags = lFlags Or DT_VCENTER
Case igAlignVBottom
lFlags = lFlags Or DT_BOTTOM
End Select
Else
If eAlignV <> igAlignVTop Then
Dim rcCalcRect As RECT
LSet rcCalcRect = rcText
gpInternalDrawText lHDC, sText, rcCalcRect, lFlags Or DT_CALCRECT
Dim lTextHeight As Long
lTextHeight = rcCalcRect.Bottom - rcCalcRect.Top
Select Case eAlignV
Case igAlignVCenter
' simplified (rcText.Top + rcText.Bottom) / 2 - lTextHeight / 2
' should be integer division because of rounding erros in the case of "/"
rcDrawText.Top = (rcDrawText.Top + rcDrawText.Bottom - lTextHeight) \ 2
Case igAlignVBottom
rcDrawText.Top = rcDrawText.Bottom - lTextHeight
End Select
End If
End If
' *** Finally draw the text
Const FIXED_PATH_ELLIPSIS_FLAGS As Long = DT_SINGLELINE Or DT_PATH_ELLIPSIS
If (lFlags And FIXED_PATH_ELLIPSIS_FLAGS) = FIXED_PATH_ELLIPSIS_FLAGS Then
DrawText_FixedPathEllipsis lHDC, sText, rcDrawText, lFlags
Else
gpInternalDrawText lHDC, sText, rcDrawText, lFlags
End If
End Sub
The font for the UserControl DC is set using this code:
Public Function FontHandle(fnt As IFont) As Long
FontHandle = fnt.hFont
End Function
Private Sub pApplyFont()
If (m_hFntDC <> 0) Then
If (m_hDC <> 0) Then
If (m_hFntOldDC <> 0) Then
SelectObject m_hDC, m_hFntOldDC
End If
End If
End If
m_hFntDC = FontHandle(UserControl.Font)
If (m_hDC <> 0) Then
m_hFntOldDC = SelectObject(m_hDC, m_hFntDC)
End If
End Sub
, where
m_hDC = CreateCompatibleDC(UserControl.hdc)

Answer 1

The problem is the output quality that you are using. You are using ANTIALIASED_QUALITY. Segoe UI has been designed for clear type. It looks great with clear type, but terrible with standard anti-aliasing. Switch to clear type (set lqQuality to CLEARTYPE_QUALITY) and you will get much better results.
This image demonstrates rendering of 10pt Segoe UI with the two quality options discussed above.

Answer 2

Yes, David Heffernan was right - I needed to turn the ClearType setting for the whole OS on: