[RESOLVED] [GDI+] Draw Text With Outline Not Lining Up

[mms_]

Hello

I am trying to outline GDI+ text with a path, but the two are not lining up.



Any ideas as to why not?

It will be important as I will be doing hittesting on path.

Option Explicit


Dim gdiplusToken As Long


Private Sub Form_Load()

    Form1.Caption = "GDI+"
    Form1.Width = Screen.TwipsPerPixelX * 600
    Form1.Height = Screen.TwipsPerPixelY * 465
    Form1.BackColor = &H8000000F
    Form1.ScaleMode = vbPixels

    Picture1.Appearance = 0
    Picture1.Left = 16
    Picture1.Top = 16
    Picture1.Height = 366
    Picture1.Width = 552
    'Picture1.Font = "courier new"
    Picture1.AutoRedraw = True
    
    Command1.Width = Picture1.Width
    Command1.Height = 25
    Command1.Left = Picture1.Left
    Command1.Top = Picture1.Top + Picture1.Height + 10
    Command1.Caption = "Draw Text"
    
    ' Initialize Windows GDI+
    Dim GdiplusStartupInput As GdiplusStartupInput
    GdiplusStartupInput.GdiplusVersion = 1
    GdiplusStartupInput.DebugEventCallback = 0
    GdiplusStartupInput.SuppressBackgroundThread = False
    GdiplusStartupInput.SuppressExternalCodecs = False
    Dim status As GpStatus
    status = GdiplusStartup(gdiplusToken, GdiplusStartupInput, 0)
    If status <> Ok Then
        MsgBox "Error loading GDI+!", vbCritical
        Call GdiplusShutdown(gdiplusToken)
    End If

End Sub


Private Sub Form_Unload(Cancel As Integer)
    
    ' Clean up resources used by Windows GDI+
    Call GdiplusShutdown(gdiplusToken)
    
End Sub


Private Sub Command1_Click()

    Picture1.Cls
    Call DrawTextOutline(Picture1.hdc, "My Text", 75, 125, 400, 200)
    Picture1.Refresh
    
End Sub


Function DrawTextOutline(ByVal hdc As Long, _
                         ByVal sText As String, _
                         ByVal x As Single, ByVal y As Single, _
                         ByVal Width As Single, ByVal Height As Single) As Boolean
    
    Dim graphics As Long
    Dim brushBlack As Long
    Dim penRed As Long
    Dim fontFamily As Long
    Dim font As Long
    Dim fontSize As Long
    Dim StringFormat As Long
    Dim path As Long
    Dim rect As RECTF

    Dim stat As Long
    
    fontSize = 96
 
    stat = GdipCreateFromHDC(hdc, graphics)
    stat = GdipCreateSolidFill(&HFF000000, brushBlack)
    stat = GdipCreatePen1(&HFFFF0000, 1, UnitPixel, penRed)
    stat = GdipCreateFontFamilyFromName(StrPtr("Calibri"), 0, fontFamily)
    stat = GdipCreateFont(fontFamily, fontSize, 0&, 0, font)
    stat = GdipCreateStringFormat(0, 0, StringFormat)
    stat = GdipCreatePath(FillModeAlternate, path)
    
    stat = GdipSetStringFormatAlign(StringFormat, StringAlignmentCenter)
    stat = GdipSetTextRenderingHint(graphics, TextRenderingHintAntiAlias)

    rect.Left = x
    rect.Top = y
    rect.Bottom = Height
    rect.Right = Width

    stat = GdipAddPathString(path, _
                StrPtr(sText), -1, fontFamily, FontStyleRegular, fontSize, rect, StringFormat)
                
    stat = GdipDrawString(graphics, StrPtr(sText), -1, font, rect, StringFormat, brushBlack)
    stat = GdipDrawPath(graphics, penRed, path)

    stat = GdipDeletePath(path)
    stat = GdipDeleteStringFormat(StringFormat)
    stat = GdipDeleteFont(font)
    stat = GdipDeleteFontFamily(fontFamily)
    stat = GdipDeletePen(penRed)
    stat = GdipDeleteBrush(brushBlack)
    stat = GdipDeleteGraphics(graphics)
    
End Function

[SomeYguy]

The text string can be drawn as a filled path rather than drawing an outline and then drawing again to fill. Thus they will align correctly. Try this: (untested here):

Private Declare Function GdipFillPath Lib "GDIPlus" (ByVal graphics As Long, ByVal brush As Long, ByVal path As Long) As Long




Function DrawTextOutline(ByVal hdc As Long, _
                         ByVal sText As String, _
                         ByVal x As Single, ByVal y As Single, _
                         ByVal Width As Single, ByVal Height As Single) As Boolean
    
    Dim graphics As Long
    Dim brushBlack As Long
    Dim penRed As Long
    Dim fontFamily As Long
    Dim font As Long
    Dim fontSize As Long
    Dim StringFormat As Long
    Dim path As Long
    Dim rect As RECTF

    Dim stat As Long
    
    fontSize = 96
 
    stat = GdipCreateFromHDC(hdc, graphics)
    stat = GdipCreateSolidFill(&HFF000000, brushBlack)
    stat = GdipCreatePen1(&HFFFF0000, 1, UnitPixel, penRed)
    stat = GdipCreateFontFamilyFromName(StrPtr("Calibri"), 0, fontFamily)
    stat = GdipCreateFont(fontFamily, fontSize, 0&, 0, font)
    stat = GdipCreateStringFormat(0, 0, StringFormat)
    stat = GdipCreatePath(FillModeAlternate, path)
    
    stat = GdipSetStringFormatAlign(StringFormat, StringAlignmentCenter)
    stat = GdipSetTextRenderingHint(graphics, TextRenderingHintAntiAlias)

    rect.Left = x
    rect.Top = y
    rect.Bottom = Height
    rect.Right = Width

    stat = GdipAddPathString(path, _
                StrPtr(sText), -1, fontFamily, FontStyleRegular, fontSize, rect, StringFormat)
    
    stat = GdipFillPath (graphics, brushBlack, path)    
              
    'stat = GdipDrawString(graphics, StrPtr(sText), -1, font, rect, StringFormat, brushBlack)
    stat = GdipDrawPath(graphics, penRed, path)

    stat = GdipDeletePath(path)
    stat = GdipDeleteStringFormat(StringFormat)
    stat = GdipDeleteFont(font)
    stat = GdipDeleteFontFamily(fontFamily)
    stat = GdipDeletePen(penRed)
    stat = GdipDeleteBrush(brushBlack)
    stat = GdipDeleteGraphics(graphics)
    
End Function

Note the GDIPFillPath function.....

[mms_]

Thank you SomeYguy
Your solution works and I will use it.

I think however it is a workaround to some kerning problem.
Te is a "kerning pair" that certain fonts (all fonts?) address.

The red outline to the left of "T" renders to the right of the black letters,
and the red outline to the right of the "T" renders to the left side of the black letters.

In any event your solution works, and I will use it.
Thank you again!!