Показать полную графическую версию : [решено] Возможно ли в свойствах ярлыка поменять размер шрифта посредством cmd/vbs?
Возможно ли в свойствах ярлыка поменять размер шрифта посредством cmd/vbs?
Например после установки "Far manager" появляется ярлык на рабочем столе, но по умолчанию там стоит 20 размер шрифта, а хочется (для примера) 28.
Интересует, в основном, решение на cmd, но на vbs то же пойдёт.
Например, так:
Option Explicit
Const SSFMOpenReadWrite = 1
Const strConsoleDataBlockSignature = "CC000000020000A0"
Const lngFontSizePosition = 24
Dim objFSO
Dim objSpeechFileStream
Dim strLnkFileName
Dim lngConsoleDataBlockPosition
Dim arrContent
'strLnkFileName = "E:\Песочница\0063\Far2.lnk"
strLnkFileName = WScript.Arguments.Item(0)
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objSpeechFileStream = WScript.CreateObject("SAPI.spFileStream")
With objFSO
If .FileExists(strLnkFileName) Then
If UCase(.GetExtensionName(strLnkFileName)) = UCase("lnk") Then
.GetFile(strLnkFileName).Copy strLnkFileName & ".bak", True
With objSpeechFileStream
.Open strLnkFileName, SSFMOpenReadWrite
.Read arrContent, objFSO.GetFile(strLnkFileName).Size
lngConsoleDataBlockPosition = InStr(ConvertByteArray2HexString(arrContent), strConsoleDataBlockSignature)
If lngConsoleDataBlockPosition <> 0 Then
.Seek lngConsoleDataBlockPosition \ 2 + Len(strConsoleDataBlockSignature) / 2 + lngFontSizePosition + 2
.Write 28
Else
WScript.Echo "Can't find ConsoleDataBlock section in [" & strLnkFileName & "]"
End If
.Close()
End With
Else
WScript.Echo "File [" & strLnkFileName & "] is not *.lnk file"
End If
Else
WScript.Echo "File [" & strLnkFileName & "] not found"
End If
End With
Set objSpeechFileStream = Nothing
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
Function ConvertByteArray2HexString(arrByteArray)
Dim i
Dim strValue
strValue = ""
For i = 1 To LenB(arrByteArray)
strValue = strValue & Right("00" & Hex(AscB(MidB(arrByteArray, i, 1))), 2)
Next
ConvertByteArray2HexString = strValue
End Function
'=============================================================================
Подразумевается, что в ярлыке задан TrueType шрифт.
Для cmd, ежели кто восхочет реализовать:
1. Найти в файле ярлыка сигнатуру из восьми байт «CC 00 00 00 02 00 00 A0». Если она найдена — значит в ярлыке наличествует секция «ConsoleDataBlock».
2. От начала найденной сигнатуры отсчитать (8+24+3) байта: размер самой сигнатуры (8 байт) плюс смещение внутри секции поля «FontSize» после сигнатуры (24 байта) плюс смещение нужного байта внутри поля; размер самого поля «FontSize» — четыре байта, нас, для TrueType шрифта, интересует 2-й байт (вообще-то, правильно — 3-й и 2-й байты [именно в таком, обратном, порядке; 1-й и 0-й байты используются, совместно с 3-им и 2-м байтами, при задании размера растровых шрифтов], но, думаю, вряд ли кто-то будет задавать размер шрифта для консольных приложений свыше 256 пикселей).
3. Для байта, полученному по этому смещению, задать потребный размер TrueType шрифта.
Например, так: »
Я так понимаю, что .Write 28 это желаемый размер шрифта? А strLnkFileName = "E:\Песочница\0063\Far2.lnk" это путь к ярлыку?
Спасибо попробую и отпишусь.
P.S. А можно чтобы путь к ярлыку указывался вне скрипта? например чтоб можно было применить в cmd: my.vbs "%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk"
Я так понимаю, что .Write 28 это желаемый размер шрифта? »
Да.
А strLnkFileName = "E:\Песочница\0063\Far2.lnk" это путь к ярлыку? »
Да, но эта строка в скрипте закомментирована:
'strLnkFileName = "E:\Песочница\0063\Far2.lnk"
Была оставлена «на пробу». А так путь к ярлыку берётся из первого параметра скрипта:
strLnkFileName = WScript.Arguments.Item(0)
Т.е., в командной строке можно вызывать именно так, как Вы написали:
чтоб можно было применить в cmd: my.vbs "%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" »
Anton04, Вы хотите менять размер шрифта в ярлыке сразу после установки Far Manager'а?
Вы хотите менять размер шрифта в ярлыке сразу после установки Far Manager'а? »
Да конечно. А что это разве что-то меняет!? Я выбрал Фар как наиболее яркий пример...
P.S. Всё работает спасибо. Правда за-комментировал строку создания bak файла, т.к. мне не к чему.
Anton04, я не уверен, но, помнится, сразу после установки Far Manager'а в ярлыке указан растровый, не TrueType, шрифт. Скрипт надо будет менять.
комментировал строку создания bak файла, т.к. мне не к чему. »
На всякий случай: вдруг где что у меня не так ;).
Iska,
Так, посмотрел, чё-то не нравится мне этот шрифт "Lucida Console" хочу "Точечные шрифты" и размером 10х18.
Поможете реализовать?
Anton04, я попробую почитать документацию на эту тему в ближайшие пару дней.
P.S. Я предпочитаю Consolas из последних версий Windows 7. Помнится, вроде как его можно получить с сайта Microsoft и сравнительно честно пользовать и под старыми ОС. Не пробовали?
я попробую почитать документацию на эту тему в ближайшие пару дней. »
Буду ждать. Спасибо.
Я предпочитаю Consolas из последних версий Windows 7. Помнится, вроде как его можно получить с сайта Microsoft и сравнительно честно пользовать и под старыми ОС. Не пробовали? »
Посмотрел, но он тоже не очень, больно режет глаз, я даже скриншот сделал для сравнения (в верху точечный в низу Consolas).
хочу "Точечные шрифты" и размером 10х18. »
Anton04, посмотрел. Примерно так:
Option Explicit
Const SSFMOpenReadWrite = 1
Const strConsoleDataBlockSignature = "CC000000020000A0"
Const lngFontSizePosition = 24
Dim objFSO
Dim objSpeechFileStream
Dim strLnkFileName
Dim lngConsoleDataBlockPosition
Dim arrContent
Dim byteValue
Dim strFontName
Dim i
'strLnkFileName = "E:\Песочница\0063\Far2.lnk"
strLnkFileName = WScript.Arguments.Item(0)
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objSpeechFileStream = WScript.CreateObject("SAPI.spFileStream")
With objFSO
If .FileExists(strLnkFileName) Then
If UCase(.GetExtensionName(strLnkFileName)) = UCase("lnk") Then
.GetFile(strLnkFileName).Copy strLnkFileName & ".bak", True
With objSpeechFileStream
.Open strLnkFileName, SSFMOpenReadWrite
.Read arrContent, objFSO.GetFile(strLnkFileName).Size
lngConsoleDataBlockPosition = InStr(ConvertByteArray2HexString(arrContent), strConsoleDataBlockSignature)
If lngConsoleDataBlockPosition <> 0 Then
.Seek lngConsoleDataBlockPosition \ 2 + Len(strConsoleDataBlockSignature) / 2 + lngFontSizePosition
' FontSize: 10x18
.Write CByte(&H0A)
.Write CByte(&H00)
.Write CByte(&H12)
.Write CByte(&H00)
' FontFamily: FF_MODERN
.Write CByte(&H30)
.Write CByte(&H00)
.Write CByte(&H00)
.Write CByte(&H00)
' FontWeight: 400
.Write CByte(&H90)
.Write CByte(&H01)
.Write CByte(&H00)
.Write CByte(&H00)
' Face Name: Terminal
strFontName = Left("Terminal" & String(32, Chr(0)), 32)
For i = 1 To Len(strFontName)
.Write Asc(Mid(strFontName, i, 1))
Next
Else
WScript.Echo "Can't find ConsoleDataBlock section in [" & strLnkFileName & "]"
End If
.Close()
End With
Else
WScript.Echo "File [" & strLnkFileName & "] is not *.lnk file"
End If
Else
WScript.Echo "File [" & strLnkFileName & "] not found"
End If
End With
Set objSpeechFileStream = Nothing
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
Function ConvertByteArray2HexString(arrByteArray)
Dim i
Dim strValue
strValue = ""
For i = 1 To LenB(arrByteArray)
strValue = strValue & Right("00" & Hex(AscB(MidB(arrByteArray, i, 1))), 2)
Next
ConvertByteArray2HexString = strValue
End Function
'=============================================================================
Iska,
Так всё хорошо, но вот если неизвестно какой размер и тип шрифта установлен, а известно какой хочется чтоб был, как тогда быть!?
Так всё хорошо, но вот если неизвестно какой размер и тип шрифта установлен, а известно какой хочется чтоб был, как тогда быть!? »
Поясните Ваш вопрос. Я не понял.
Iska,
Ну вот данный скрипт мы натравливали на ярлык фара после его установки, где было заранее известно какой размер шрифта установлен (в нашем примере это 24). А теперь представим ситуацию когда размер этого шрифта (да и тип Consolas, Lucida Console или Точечный шрифт) неизвестен, т.е. какой размер или тип шрифта неясен (ну изменили на какой-то и всё тут). А вот какой поставить хочется мы знаем.
Можно же реализовать это в скрипте?
P.S. Конечно универсальней было бы, если бы все параметры прописывались в командной строке при запуске скрипта, ну типа: my.vbs 10х18 "Точечный шрифт"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" или my.vbs 28 "Lucida Console"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" ну и т.п.
Anton04, так и есть. Какой размер хотите — такой и ставьте, какой шрифт хотите — такой и пишите. В роли «точечного шрифта» в Windows выступает шрифт Terminal. Есть определённые ограничения на использование шрифтов для консольных приложений, но не более того.
Ну вот данный скрипт мы натравливали на ярлык фара после его установки, где было заранее известно какой размер шрифта установлен (в нашем примере это 24).
Без разницы, какой до этого был задан шрифт и размер в ярлыке.
А вот какой поставить хочется мы знаем. Можно же реализовать это в скрипте? »
Именно это и было выше (http://forum.oszone.net/post-1745154.html#post1745154) сделано. Что не так?
Iska,
А всё увидел, не заметил Terminal... :tomato2:
Но всё же по поводу универсальности P.S. Конечно универсальней было бы, если бы все параметры прописывались в командной строке при запуске скрипта, ну типа: my.vbs 10х18 "Точечный шрифт"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" или my.vbs 28 "Lucida Console"%ALLUSERSPROFILE%\Рабочий стол\FAR manager.lnk" ну и т.п. » может реализуем!? ;)
может реализуем!? »
Конечно, можно. А смысл? Сколько нынче осталось консольных приложений, для которых нужны ярлыки с уникальными настройками шрифтов? Навскидку я кроме Far Manager'а ничего не припомню, где бы такое реально требовалось.
Что скажете?
Конечно, можно. А смысл? Сколько нынче осталось консольных приложений, для которых нужны ярлыки с уникальными настройками шрифтов? »
Это то конечно да их действительно не много, просто хотелось универсальности вдруг где ещё пригодится. Запас карман не тянет... ;) :Beer:
Если делать такой вариант — нужно будет предусмотреть обработку аргументов, включая требование непротиворечивости, корректности, достаточности и т.п. Т.е., уметь обрабатывать все возможные ошибочные ситуации с аргументами. Размер скрипта вырастет втрое.
Другое дело, если, допустим, взяться и нарисовать компонент (хотя бы и *.wsc), который будет всем этим заниматься, отслеживать и обрабатывать — тогда другое дело. Мне вот, допустим, хотелось бы внедрять в ярлык Far Manager'а ту палитру цветов, которая была характерна для Windows 9x (вместо нынешней), ибо править палитру цветов самим редактором ярлыков — это натуральный мазохизм.
Если делать такой вариант — нужно будет предусмотреть обработку аргументов, включая требование непротиворечивости, корректности, достаточности и т.п. Т.е., уметь обрабатывать все возможные ошибочные ситуации с аргументами. Размер скрипта вырастет втрое. »
Всё понял, не оправдано и не перспективно... Ещё раз спасибо Iska :Beer:
Тему закрываю....
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.