Windows

Code:

//Saving and restoring font properties in the registry

Uses typInfo, Registry;

Function GetFontProp( anObj: TObject) : TFont;

Var

PInfo: PPropInfo;

Begin

{ try to get a pointer to the property information for a property with the

name 'Font'. TObject.ClassInfo returns a pointer to the RTTI table,

which

we need to pass to GetPropInfo }

PInfo := GetPropInfo( anObj.ClassInfo, 'font' );

Result := Nil;

If PInfo <> Nil Then

{ found a property with this name, check if it has the correct type }

If (PInfo^.Proptype^.Kind = tkClass) and

GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(TFont)

Then

Result := TFont(GetOrdProp( anObj, PInfo ));

End; { GetfontProp }

Function StyleToString( styles: TFontStyles ): String;

var

style: TFontStyle;

Begin

Result := '[';

For style := Low(style) To High(style) Do Begin

If style IN styles Then Begin

If Length(result) > 1 Then

result := result + ',';

result := result + GetEnumname( typeInfo(TFontStyle), Ord(style));

End; { If }

End; { For }

Result := Result + ']';

End; { StyleToString }

Function StringToStyle( S: String ): TFontStyles;

Var

sl : TStringlist;

style: TfontStyle;

i : Integer;

Begin

Result := [];

If Length(S) < 2 Then Exit;

If S[1] = '[' Then

Delete(S, 1, 1);

If S[Length(S)] = ']' Then

Delete(S, Length(S), 1);

If Length(S) = 0 Then Exit;

sl:= TStringlist.Create;

try

sl.commatext := S;

For i := 0 To sl.Count-1 Do Begin

try

style := TFontStyle( GetEnumValue( Typeinfo(TFontStyle), sl[i] ));

Include( Result, style );

except

end;

End; { For }

finally

sl.free

end;

End; { StringToStyle }

Procedure SaveFontProperties( forControl: TControl;

toIni: TRegInifile;

const section: String );

Var

font: TFont;

basename: String;

Begin

Assert( Assigned( toIni ));

font := GetFontProp( forControl );

If not Assigned( font ) Then Exit;

basename := forControl.Name+'.Font.';

toIni.WriteInteger( Section, basename+'Charset', font.charset );

toIni.WriteString ( Section, basename+'Name', font.Name );

toIni.WriteInteger( Section, basename+'Size', font.size );

toIni.WriteString ( Section, basename+'Color',

'$'+IntToHex(font.color,8));

toIni.WriteString ( Section, basename+'Style',

StyleToString( font.Style ));

End; { SaveFontProperties }

Procedure RestoreFontProperties( forControl: TControl;

toIni: TRegInifile;

const section: String );

Var

font: TFont;

basename: String;

Begin

Assert( Assigned( toIni ));

font := GetFontProp( forControl );

If not Assigned( font ) Then Exit;

basename := forControl.Name+'.Font.';

font.Charset :=

toIni.ReadInteger( Section, basename+'Charset', font.charset );

font.Name :=

toIni.ReadString ( Section, basename+'Name', font.Name );

font.Size :=

toIni.ReadInteger( Section, basename+'Size', font.size );

font.Color := TColor( StrToInt(

toIni.ReadString ( Section, basename+'Color',

'$'+IntToHex(font.color,8))

));

font.Style := StringToStyle(

toIni.ReadString ( Section, basename+'Style',

StyleToString( font.Style ))

);

End; { RestoreFontProperties }

Подробнее: Сохранение свойств... Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Работа с TFont

Данный код изменяет стиль шрифта поля редактирования, если оно выбрано. Может быть адаприрован для управления шрифтами в других объектах.

Подробнее: Управление настройками... Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Работа с TFont

Чтобы установить шрифт в систему, необходимо скопировать файл шрифта в 'Windows\Fonts' и добавить ключ в реестр:

'Software\Microsoft\Windows\CurrentVersion\Fonts'

Этот ключ указывает на файл шрифта. Далее запускаем API функцию 'AddFontRecource'. В заключении нужно уведомить систему широковещательным сообщением.

Подробнее: Как добавить True Type... Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Как мне сохранить свойство шрифта Style, ведь он же набор?

Вы можете получать и устанавливать FontStyle через его преобразование к типу byte.

Для примера:

Подробнее: Хранение стилей шрифта Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Работа с TFont

Зарегистрировать шрифт:

AddFontResource('путь к фонту\\Algerian.ttf');

Объект.Font.Name:="Algerian";

Удалить -

RemoveFontResource('путь к фонту\\Algerian.ttf');

Автор Alex101

Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Code:

unit Fontlist;

interface

uses

Windows, Classes, Graphics, Forms, Controls, StdCtrls;

type

TForm1 = class(TForm)

ListBox1: TListBox;

Label1: TLabel;

FontLabel: TLabel;

procedure FormCreate(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure DrawItem(Control: TWinControl; index: Integer; Rect: TRect;

State: TOwnerDrawState);

procedure ListBox1MeasureItem(Control: TWinControl; index: Integer;

var Height: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

Listbox1.Items := Screen.Fonts;

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

FontLabel.Caption := ListBox1.Items[ListBox1.ItemIndex];

end;

procedure TForm1.DrawItem(Control: TWinControl; index: Integer;

Rect: TRect; State: TOwnerDrawState);

begin

with ListBox1.Canvas do

begin

FillRect(Rect);

Font.name := ListBox1.Items[index];

Font.Size := 0; // use font's preferred size

TextOut(Rect.Left+1, Rect.Top+1, ListBox1.Items[index]);

end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; index: Integer;

var Height: Integer);

begin

with ListBox1.Canvas do

begin

Font.name := Listbox1.Items[index];

Font.Size := 0; // use font's preferred size

Height := TextHeight('Wg') + 2; // measure ascenders and descenders

end;

end.

Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Может ли кто-нибудь подсказать или решить такую проблему: мне нужно убедиться, что мое приложение использует доступные, а не ближайшие шрифты, установленные пользователем в системе? Я пробовал копировать файл #.ttf в директорию пользователя windows\system, но мое приложение так и не смогло их увидеть и выбрать для дальнейшего использования.

Ниже приведен код для Delphi, который динамически устанавливает шрифты, загружаемые только во время работы приложения. Вы можете расположить файл(ы) шрифтов в каталоге приложения. Они будут инсталлированы при загрузке формы и выгружены при ее разрушении. Вам возможно придется модифицировать код для работы с Delphi 2, поскольку он использует вызовы Windows API, которые могут как измениться, так и нет. Если в коде вы видите "...", то значит в этом месте может располагаться какой-либо код, не относящийся к существу вопроса.

Подробнее: Как приложению... Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Вы когда-нибудь проверяли как будет выглядеть написанная вами с такой любовью программа с системе с крупными шрифтами? Согласитесь, это неприглядное зрелище. Наползающие друг на друга метки и поля редактирования, надписи, которые заканчиваются где то за пределами формы и т.п. После этого появляется неконтролируемая неприязнь к пользователям, которые предпочитают режим крупных шрифтов. Но это их право. И ваша проблема.

Подробнее: Защита приложений от... Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Как определить, какой шрифт установлен в системе, большой или маленький

Следующуя функция возвращает true, если маленькие шрифты установлены в системе. Так же можно заменить строку 'Result := (GetDeviceCaps(DC, logpixelsx) = 96);' на 'Result := (GetDeviceCaps(DC, logpixelsx) = 120);' чтобы определять - установлены ли в системе крупные шрифты.

Подробнее: Как узнать размеры... Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Code:

function IsTrueTypeInstalled: bool;

var

{$IFDEF WIN32}

rs : TRasterizerStatus;

{$ELSE}

rs : TRasterizer_Status;

{$ENDIF}

begin

result := false;

if not GetRasterizerCaps(rs, sizeof(rs)) then

exit;

if rs.WFlags and TT_AVAILABLE <> TT_AVAILABLE then

exit;

if rs.WFlags and TT_ENABLED <> TT_ENABLED then

exit;

result := true;

end;

Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Code:

function SmallFonts: Boolean;

{Значение функции TRUE если мелкий шрифт}

var

DC: HDC;

begin

DC := GetDC(0);

Result := (GetDeviceCaps(DC, LOGPIXELSX) = 96);

{ В случае крупного шрифта будет 120}

ReleaseDC(0, DC);

end;

Добавить комментарий

Подробности: Родительская категория: Шрифты, языки, кодировки, регионарные стандарты; Категория: Шрифты и файлы шрифтов

Windows

Системные функции и WinAPI

Вопросы по Delphi

VCL

Язык Дельфи

Облако тегов

Карта сайта