PHP DM Gate v0.9 » AddFontResource

azl (18.01.15 17:46) [0]

Доброго времени суток, уважаемые мастера.
Столкнулся с такой бедой. У человека не запускается моя программа. Начали выяснять причину, дело оказалось в загрузке шрифта при создании главной формы. Запускает программу, ничего не происходит. Процесс висит (в диспетчере задач это видно), а программа не запускается.
Чтобы отбросить все вопросы, я создал новый проект, поместил на него Label. Проблема не ушла. http://s020.radikal.ru/i703/1501/f8/0392434074a6.png

Код такой:
procedure TStartForm.FormCreate(Sender: TObject);
begin
AddFontResource(PChar(ExtractFileDir(Application.ExeName) + '\CyrillicGoth.ttf'));
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

procedure TStartForm.FormDestroy(Sender: TObject);
begin
RemoveFontResource(PChar(ExtractFileDir(Application.ExeName) + '\CyrillicGoth.ttf'));
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

Попробовал загружать шрифт не при создании формы, а при нажатии кнопки:

procedure TStartForm.Button1Click(Sender: TObject);
begin
AddFontResource(PChar(ExtractFileDir(Application.ExeName) + '\CyrillicGoth.ttf'));
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
Label1.Font.Name := 'CyrillicGoth';
end;

Приложение запускается, но при нажатии на кнопку, программа зависает.
Под виртуалкой у него все запускается. На другом ПК с такой же виндой (7 Ultimate) и таким же антивирусом, запускается. Антивирус отключал, не помогает. Запускал от имени администратора, безрезультатно. Я сам ни разу с таким не сталкивался. Поэтому не могу дать каких-то рекомендаций.
На подобную проблему жалуется не первый человек.
У одного оказалась проблема в установленном ПО для мыши Logitech, которой он уже не пользовался. Удалил ПО, все пошло. Какая взаимосвязь?

В чем может быть проблема?

Получается, подобный способ загрузки шрифта нежелателен? Лучше устанавливать шрифт вручную? Нигде не нашел информации, что может возникнуть беда подобного рода.

<Цитата>
p © (18.01.15 18:43) [1]

Попробуй
AddFontResourceEx

This function allows a process to use fonts without allowing other processes access to the fonts.

<Цитата>
azl (18.01.15 20:34) [2]

Спасибо, но AddFontResourceEx - не помогло.

Однако проблему решил. Начал гуглить AddFontResourceEx и нашел нужные темы.
Все дело оказалось в SendMessage. Заменил SendMessage на PostMessage и приложение запустилось.

<Цитата>
Германн © (19.01.15 02:19) [3]

> Все дело оказалось в SendMessage

Ну да. Кто же будет отвечать на сообщение адресованное всем и никому в частности? А раз никто не ответил, то программа висит.

<Цитата>
azl (19.01.15 19:29) [4]

Попробовал без SendMessage/PostMessage
AddFontResourceEx(PChar(ExtractFileDir(Application.ExeName) + '\CyrillicGoth.ttf'), FR_PRIVATE, nil);
Работает, шрифт подключается.
Я так понимаю, SendMessage нужно использовать, когда устанавливаешь шрифт в систему.
А когда подключаешь его на время работы приложения, особенно, если нужно чтобы этот шрифт был использован только приложением, которое его вызвало, то SendMessage не нужно использовать.
Поправьте, если я не прав.

> Кто же будет отвечать на сообщение адресованное всем и никому
> в частности?

В Интернете только такие примеры и приводят. Вы имеете в виду, что нужно писать примерно так:

procedure TForm1.FormShow(Sender: TObject);
var
H : HWND;
begin
H := FindWindow ('TForm1', 'Form1');
AddFontResource(PChar(ExtractFileDir(Application.ExeName) + '\CyrillicGoth.ttf'));
SendMessage(H, WM_FONTCHANGE, 0, 0);
end;

> А раз никто не ответил, то программа висит.

Но почему приложение не ответило? Ведь сообщение было послано всем, в том числе и ему. Что характерно, у одних работает, у других нет.

<Цитата>