Использование своих шрифтов из приложения :: Статьи по Delphi -

Поиск по базе статей [/articles/?PHPSESSID=c01d9128e50d63837f375281b560b9eb] : 18.08.2006 Изменено разрешение сайта Изменено минимальное разрешение сайта на 1024x768 Подробнее... 02.08.2006 Выгружена игра "Digger Remastered" Вспоминаем старый добрый DOS и времена 80-х! ;) Подробнее... Рекомендуем книгу! MS Agent и Speech API в Delphi +CD Рассмотрено программирование нестандартных пользовательских интерфейсов в среде Delphi с применением технологий Microsoft Agent и Microsoft Speech API для операционных систем Windows 98/2000/XP. Представлены способы внедрения анимированных персонажей в пр ... Использование своих шрифтов из приложения :: Статьи по Delphi Ниже приведен код, который динамически устанавливает шрифты, загружаемые только во время работы приложения. Вы можете расположить файл(ы) шрифтов в каталоге приложения. Они будут инсталлированы при загрузке формы и выгружены при ее разрушении. Вам возможно придется модифицировать код, поскольку он использует вызовы Windows API функций, которые могут как измениться, так и нет. Если в коде вы видите " ... ", то значит в этом месте может располагаться какой-либо код, не относящийся к существу вопроса. Ну и, конечно, вы должны заменить "MYFONT" на реальное имя файла вашего шрифта. type TForm1= class (TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); ... private { Private declarations } bLoadedFont: boolean; public { Public declarations } end ; procedure TForm1.FormCreate(Sender: TObject); var sAppDir: string ; sFontRes: string ; begin sAppDir := Application.ExeName; sAppDir := copy(sAppDir, 1 , rpos( '\' , sAppDir )); sFontRes := sAppDir + 'MYFONT.FOT' ; if not FileExists( sFontRes ) then begin sFontRes := sFontRes + #0 ; sFont := sAppDir + 'MYFONT.TTF' + #0 ; CreateScalableFontResource( 0 , @sFontRes[ 1 ], @sFont[ 1 ], nil ); end ; sFontRes := sAppDir + 'MYFONT.FOT' ; if FileExists(sFontRes) then begin sFontRes := sFontRes + #0 ; if AddFontResource( @sFontRes[ 1 ]) = 0 then bLoadedFont := false else begin bLoadedFont := true; SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0 , 0 ); end ; end ; ... end ; procedure TForm1.FormDestroy(Sender: TObject); var sFontRes: string ; begin if bLoadedFont then begin sFontRes := sAppDir + 'MYFONT.FOT' + #0 ; RemoveFontResource( @sFontRes[ 1 ] ); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0 , 0 ); end ; end ; Электронная справка по продукту InstallShield показывает, что в системах Win95 и WinNT FOT-файл не нужен. Вам нужен только TTF-файл. В результате процедура FormCreate стала выглядеть так: var sAppDir, sFontRes: string ; begin {...другой код...} sAppDir := extractfilepath(Application.ExeName); sFontRes := sAppDir + 'MYFONT.TTF' ; if FileExists(sFontRes) then begin sFontRes := sFontRes + #0 ; if AddFontResource(@sFontRes[ 1 ]) = 0 then bLoadedFont := false else begin bLoadedFont := true; SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0 , 0 ); end ; end ; {...} end ; {FormCreate} А FormDestroy так: var sFontRes, sAppDir: string ; begin {...другой код...} if bLoadedFont then begin sAppDir := extractfilepath(Application.ExeName); sFontRes := sAppDir + 'MYFONT.TTF' + #0 ; RemoveFontResource(@sFontRes[ 1 ]); SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0 , 0 ); end ; {...другой код...} end ; {FormDestroy} Для упрощения этого я сделал простую функцию, совмещающую обе этих задачи. Она возвращает логическое значение, говорящая об успехе, или наоборот, о неудаче операции загрузки или выгрузки шрифта. function LoadFont(sFontFileName: string ; bLoadIt: boolean): boolean; var sFont, sAppDir, sFontRes: string ; begin result := TRUE; if bLoadIt then begin {Загрузка шрифта} if FileExists(sFontFileName) then begin sFontRes := sFontFileName + #0 ; if AddFontResource(@sFontRes[ 1 ]) = 0 then result := FALSE else SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0 , 0 ); end ; end else begin {Выгрузка шрифта} sFontRes := sFontFileName + #0 ; result := RemoveFontResource(@sFontRes[ 1 ]); SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0 , 0 ); end ; end ; {LoadFont} Copyright 2001-2007 © "Iguana Software" . О компании | Продукты | Усуги | Заявление о приватности | Правила использования | Обратная связь IGP Delphi Forum | Библиотека VCL | Увлекательные знакомства, Украина