Как в Windows установить новый шрифт с помощью функций API?

[Алексей Смирнов]

Как в Windows установить новый шрифт с помощью функций API?

[hCORe]

Используй APIшку AddFontResource:

Код: Выделить всё

Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long

Private Sub Command1_Click()
On Error Resume Next
    Dim lResult as Long
    lResult = AddFontResource ("путь к файлу шрифта")
End Sub

[Алексей Смирнов]

Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long

Private Sub Command1_Click()
On Error Resume Next
Dim lResult as Long
lResult = AddFontResource ("путь к файлу шрифта")
End Sub

Спасибо, я это попробую.
А как теперь узнать, что шрифт установлен (чтобы два раза не установить один).

[RayShade]

А я так мыслю, что ты это автоматом узнаешь - функция нверняка тебе ошибку в этом случае вернет.

[Алексей Смирнов]

Нет, всегда возаращает 1
Но я нашёл функцию RemoveFontResource.
При запуске программы сначала удаляю шрифт, затем заного ставлю. Быстродействие это не снижает.
Выяснил:
1) функция AddFontResource прописывает шрифт несколько раз, поэтому столько раз его надо и удалить;
2) функция RemoveFontResource возвращает 0, если копий шрифтов больше не установлено и возвращает 1, если шрифт был установлен;
3) установленный с помощью AddFontResource шрифт не отображается в папке "ПАНЕЛЬ УПРАВЛЕНИЯ"->"ШРИФТЫ", даже если его перед установкой туда скопировать.

Тем не менее всё нормально работает, я уже задействовал это в своём проекте. Очень благодарен за помошь!