Компилятор: Visual Basic

Для того, чтобы сделать желаемый шрифт, используется API функция CreateFont. Необходимо использовать TrueType шрифт. При помощи функции CustomFont это делается немного проще.

' Создаём шрифт и возвращаем его дескриптор.
Private Function CustomFont(ByVal hgt As Long, ByVal wid As _
    Long, ByVal escapement As Long, ByVal orientation As _
    Long, ByVal wgt As Long, ByVal is_italic As Long, ByVal _
    is_underscored As Long, ByVal is_striken_out As Long, _
    ByVal face As String) As Long
Const CLIP_LH_ANGLES = 16   ' Необходимо для наклонных шрифтов.
 
    CustomFont = CreateFont( _
        hgt, wid, escapement, orientation, wgt, _
        is_italic, is_underscored, is_striken_out, _
        0, 0, CLIP_LH_ANGLES, 0, 0, face)
End Function

После того, как шрифт создан, прикрепляем его к форме или PictureBox, взависимости от того, где мы будем рисовать API функцией SelectObject.

Далее, для вывода текста вызывается BeginPath, а затем EndPath для конвертации текста в графику. Потом вызываем SetWindowRgn, чтобы обрезать Форму/PictureBox по заданному региону. Теперь, чтобы Вы не рисовали, будет рисоваться в в пределах региона. Поэтому просто рисуем линии, плавно изменяя цвет.

Чтобы восстановить изначальный шрифт, используется функция SelectObject, а для удаления нового шрифта - функция DeleteObject, освобождая тем самым ресурсы. Если этого не сделать, то произойдёт утечка памяти.

Private Sub ShapePicture()
Const TEXT1 = "FLOWERS"
 
Dim new_font As Long
Dim old_font As Long
Dim hRgn As Long
Dim Y As Single
Dim g As Single
Dim dg As Single
 
    ' Подготавливаем PictureBox.
    ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    Picture1.ScaleMode = vbPixels
    Picture1.BorderStyle = vbBSNone
    Picture1.BackColor = vbBlue
    Picture1.ForeColor = vbBlack
    Picture1.DrawWidth = 1
 
    ' Делаем большой шрифт.
    new_font = CustomFont(250, 65, 0, 0, _
        FW_BOLD, False, False, False, _
        "Times New Roman")
    old_font = SelectObject(Picture1.hdc, new_font)
 
    ' Создаём регион.
    SelectObject Picture1.hdc, new_font
    BeginPath Picture1.hdc
    Picture1.CurrentX = (ScaleWidth - _
        Picture1.TextWidth(TEXT1)) / 2
    Picture1.CurrentY = -40
    Picture1.Print TEXT1
    EndPath Picture1.hdc
    hRgn = PathToRegion(Picture1.hdc)
 
    ' Прикрепляем PictureBox к региону.
    SetWindowRgn Picture1.hWnd, hRgn, False
 
    ' Восстанавливаем изначальный шрифт.
    SelectObject hdc, old_font
 
    ' Освобождаем ресурсы, занятые шрифтом (важно!)
    DeleteObject new_font
 
    ' Рисуем линии через PictureBox.
    dg = -255 / Picture1.ScaleHeight
    g = 255
    For Y = 0 To Picture1.ScaleHeight
        Picture1.Line (0, Y)-Step(Picture1.ScaleWidth, 0), _
            RGB(0, g, 0)
        g = g + dg
    Next Y
End Sub

Скачать исходник