Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Установка шрифта программно / 4 сообщений из 4, страница 1 из 1
26.06.2016, 13:56
    #39262530
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Установка шрифта программно
Покажите, кто знает, как программно, из VB6 установить шрифт?
Система Windows
Шрифт UPC-A.ttf
--------------------------------------------------------------------------
СПС
...
Рейтинг: 0 / 0
26.06.2016, 19:58
    #39262603
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Установка шрифта программно
Код получился вот такой.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Public Function FUN_FONT_IN_SYSTEM()

Dim GLB_PATCH_Windows
'==========================================================================
'установка шрифта в систему.
'==========================================================================

Set FSO = New Scripting.FileSystemObject
    Dim WSH
    Set WSH = CreateObject("WScript.Shell")
    'Копирование файла шрифта в системную папку шрифтов
    GLB_PATCH_Windows = Environ("windir") ' путь к Windows
  FSO.CopyFile App.Path & "\OKZ\FONT\UPC-A.ttf", GLB_PATCH_Windows & "\Fonts\UPC-A.ttf"
    'Установка шрифта вызовом API
    WSH.Run "RunDll32.exe gdi32.dll, AddFontResourceA " & GLB_PATCH_Windows & "\Fonts\UPC-A.ttf"

End Function



Но шрифт в папке Font системой не распознаётся.
А потому не устанавливается.
В чём проблема?
Что я делаю не так?
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
21.09.2017, 17:34
    #39524473
Nik_Kurta
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Установка шрифта программно
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
Option Explicit

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

'--------------------------------------------------------------------------------
'Function: {fnIsFont}
'--------------------------------------------------------------------------------
Public Function fnIsFont(strPatchNameFont As String) As Boolean
    Dim fso As New FileSystemObject
    Dim i As Long
    If fso.FileExists(strPatchNameFont) = True Then
        i = RemoveFontResource(strPatchNameFont) '- DELETE
        i = AddFontResource(strPatchNameFont)    '- ADD
        If i > 0 Then
            fnIsFont = True
        Else
            fnIsFont = False
        End If
    Else
        fnIsFont = False
    End If
    Set fso = Nothing
End Function
...
Рейтинг: 0 / 0
21.09.2017, 18:26
    #39524493
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Установка шрифта программно
Nik_Kurta,

Спасибо за ответ.
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Установка шрифта программно / 4 сообщений из 4, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]