Установка шрифтов из 1С, управляемые формы

При разворачивании своей конфигурации (специализированной) потребовалось автоматически установить необходимые шрифты.
Быстрый поиск привел на статью https://infostart.ru/public/355315/ но у меня шрифты устанавливались неправильно — в реестре информация не обновлялась, да и в списке шрифтов данные так же не обновились (Проверял на Windows 10). Пришлось писать свой код.

Здесь я не буду расписывать весь функционал своей обработки, а только опишу сам процесс установки.

В обработке имеется макет "Шрифты", в котором в двоичных данных лежит массив необходимых шрифтов.

На форме обработки информационная строка о текущем состоянии, прогресс и список установленных/неустановленных шрифтов. При щелчке мышкой по ссылке "Установить" запускается стандартный диалог Windows с предварительным просмотром шрифта и кнопкой "Установить". По кнопке "Установить все шрифты вручную" — такой диалог запускается для всех неустановленных шрифтов.

Проверка, установлен шрифт или нет, у меня производится через реестр Windows — так как простая проверка наличия файла в каталоге Fonts не гарантирует, что шрифт действительно установлен и может быть использован. В этом есть небольшая загвоздка — надо либо знать название шрифта, либо искать в реестре по имени файла что более муторно. Я пошел по первому пути.

Отличается от варианта в статье infostart.ru/public/355315/ :

1. Шрифт устанавливается штатными средствами Windows с выводом диалога "Установка шрифта"

2. Если 1С запущена без прав администратора Windows запросит разрешение на внесение изменений для 1С автоматически

3. Проверяется установлен шрифт уже или нет

4. Шрифты устанавливаются из архива по списку

Итак код:
 

&НаСервере
Функция ПоместитьШрифтыВоВременноеХранилище()
// Помещаем архив со шрифтами во временной хранилище, для извлечения из архива на клиенте
ОбъектФормы = РеквизитФормыВЗначение("Объект");
Возврат ПоместитьВоВременноеХранилище(ОбъектФормы.ПолучитьМакет("Шрифты"), УникальныйИдентификатор);
КонецФункции

&НаКлиенте
Процедура УстановитьШрифты(Команда)
// Создадим временный каталог для шрифтов, он будет удален автоматически по завершению работы 1С
НачатьСозданиеКаталога(Новый ОписаниеОповещения("УстановкаШрифтовНачалоИзвлеченияИзАрхива", ЭтотОбъект), ПолучитьИмяВременногоФайла());
КонецПроцедуры

&НаКлиенте
Функция ПолучитьИмяШрифтаИзИмениФайла(ИмяФайла)
// У меня имя шрифта формируется из имени файла
// Код не указываю, так как все зависит от конкретного случая, так как файл может называться как угодно
// Здесь вы можете просто сделать проверку вроде:
// Если ИмяФала="имя.ttf" Тогда
//    Возврат "Имя шрифта";
// ИначеЕсли ...
//    ...
// КонецЕсли;
КонецФункции

&НаКлиенте
Функция ШрифтУстановлен(ИмяШрифта, Shell)
// Пытаемся прочитать параметр с именем шрифта, если не удалось - значит шрифт не установлен
Попытка
Результат = Shell.RegRead("HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindows NTCurrentVersionFonts"+ИмяШрифта);
Возврат Истина;
Исключение
Возврат Ложь;
КонецПопытки;
КонецФункции

&НаКлиенте
Процедура УстановкаШрифтовНачалоИзвлеченияИзАрхива(Каталог, ДопПараметры) Экспорт
Shell         = Новый COMОбъект("WScript.Shell");
appShell    = Новый COMОбъект("Shell.Application");
ВремКаталог    = appShell.Namespace(Каталог);
// Поместим архив во временное хранилище и получим ссылку на него
СсылкаНаАрхив = ПоместитьШрифтыВоВременноеХранилище();
// Поместим данные в буфер двоичных данных
БуферДанных = ПолучитьБуферДвоичныхДанныхИзДвоичныхДанных(ПолучитьИзВременногоХранилища(СсылкаНаАрхив));
// Удалим архив из временного хранилища
УдалитьИзВременногоХранилища(СсылкаНаАрхив);
// Создадим поток в памяти со ссылкой на буфер двоичных данных
Поток = Новый ПотокВПамяти(БуферДанных);
// Начнем чтение архива в памятим
Архив = Новый ЧтениеZipФайла(Поток);
// Пробежим по всем файлам в архиве
Для Каждого Эл Из Архив.Элементы Цикл
// Имя шрифта как он будет записан в реестре Windows. У меня формируется из имени файла
ИмяШрифта = ПолучитьИмяШрифтаИзИмениФайла(Эл.Имя);
// Проверяем установлен шрифт или еще нет
Если НЕ ШрифтУстановлен(ИмяШрифта, Shell) Тогда
// Извлекаем архив во временный каталог
Архив.Извлечь(Эл, Каталог, РежимВосстановленияПутейФайловZIP.НеВосстанавливать);
Попытка
// Устанавливаем шрифт
ФайлШрифта = ВремКаталог.ParseName(Эл.Имя);
ФайлШрифта.InvokeVerb("Install");
ФайлШрифта = Неопределено;
Сообщить("Шрифт """+ИмяШрифта+""" успешно установлен!");
Исключение
Сообщить(КраткоеПредставлениеОшибки(ИнформацияОбОшибке()));
КонецПопытки;
КонецЕсли;
КонецЦикла;
Архив.Закрыть();
Архив = Неопределено;
// Закрываем поток. Может делать это и не обязательно, если 1С корректно чистить память. Но делаю на всякий случай
Поток.НачатьЗакрытие(Новый ОписаниеОповещения("ЗакрытиеПотока", ЭтотОбъект));
БуферДанных = Неопределено;
КонецПроцедуры

&НаКлиенте
Процедура ЗакрытиеПотока(ДопПараметр) Экспорт
// Обработка закрытия потока, если необходимо
КонецПроцедуры

Надеюсь, кому-нибудь пригодится.

Leave a Comment

Ваш адрес email не будет опубликован. Обязательные поля помечены *