Как программно установить шрифт в систему?

Поделиться112.08.2010 18:21:59

Автор: haav
Активный участник
Зарегистрирован: 20.12.2009
Приглашений: 0
Сообщений: 440
Уважение: [+1/-0]
Позитив: [+1/-0]
Пол: Мужской
Провел на форуме:
6 дней 22 часа
Последний визит:
02.12.2012 09:07:36

Собственно вопрос озвучен в заголовке темы. Добавлю только что у меня windows7
Попробовал так, не выходит:

Код:

AddFontResource_("files\Isabella-Decor.ttf")
SendMessage_(#HWND_BROADCAST,#WM_FONTCHANGE,0,0)

0

Поделиться213.08.2010 09:34:54

Автор: mirashic
Активный участник
Зарегистрирован: 02.02.2010
Приглашений: 0
Сообщений: 306
Уважение: [+1/-0]
Позитив: [+0/-0]
Провел на форуме:
9 дней 5 часов
Последний визит:
27.04.2013 21:06:20

Выкладывали на сайте такой вариант кода, но он не всегда работает (в семёрке - нет)

Код:

Enumeration 
#IncludeFile     
EndEnumeration


Procedure CreateIncludeFile(Name.s, *StartFile, *EndFile) 
  If CreateFile(#IncludeFile, Name) 
    WriteData(#IncludeFile,*StartFile, *EndFile - *StartFile) 
    CloseFile(#IncludeFile) 
    ProcedureReturn #True 
  EndIf 
  ProcedureReturn #False 
EndProcedure 


If CreateIncludeFile(GetWindowsDirectory() + "\FONTS\andlso.TTF", ?StartFont2, ?EndFont2)
 AddFontResource_(GetWindowsDirectory() + "\andlso.TTF")   
EndIf

DataSection 
 StartFont2: 
  IncludeBinary "andlso.TTF" 
 EndFont2:
EndDataSection

0

Поделиться313.08.2010 09:36:29

Автор: mirashic
Активный участник
Зарегистрирован: 02.02.2010
Приглашений: 0
Сообщений: 306
Уважение: [+1/-0]
Позитив: [+0/-0]
Провел на форуме:
9 дней 5 часов
Последний визит:
27.04.2013 21:06:20

Как в семёрке - тоже интересно... Этот не работает...

0

Поделиться409.09.2010 12:14:44

Автор: mosqh
Новичок
Зарегистрирован: 09.09.2010
Приглашений: 0
Сообщений: 2
Уважение: [+0/-0]
Позитив: [+0/-0]
Провел на форуме:
43 минуты
Последний визит:
12.09.2010 19:06:32

У меня на Windows 7 x64 работает такой код:

Код:

; Компилятор : Pure Basic 4.50
If(OpenLibrary(0, "GDI32.DLL"))
CallFunction(0, "AddFontMemResourceEx", ?fs, (?fe -?fs), 0, @i +1) : CloseLibrary(0)
Else : MessageRequester("E.R.R.O.R.","font problem...") : End : EndIf


OpenWindow(0, 0, 0, 400, 200, "T.E.S.T.",#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))

LoadFont(1, "Karnac Two", 16):SetGadgetFont(#PB_Default, FontID(1))
TextGadget(0, 10, 50, 400, 40,"Тест, TEST -- WORKS? YES.")

Repeat : Delay(5) : Until(WaitWindowEvent() = #WM_CLOSE)

DataSection
fs:
IncludeBinary("F:\Karnac Two.ttf")
fe:
EndDataSection

;Спасибо буржуям!

0