Добрый день.
Есть шрифт (ttf), который в системе не установлен.
Как узнать, под каким именем он установится?
(бинарный поиск по файлу - не подходит).
Спасибо.
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
Поподробнее, если можно. Не удалить сразу после Add, Remove, без использования? Или после использования в каком нибудь TFont? Может на него ссылка в Canvas-е осталась? AddFontMemResourceEx не подойдёт?
Мдя... работает. Но тут другая проблема. :)
Как сам шрифт удалить? RemoveFontResource и RemoveFontResourceEx не удаляют признак занятости файла. А просить перезагрузку для этого как-то не хорошо....
Если кому-то ещё надо, вот платформенно независимый вариант функции. Работает только с TTF шрифтами. Результат идентичен GetFontResourceInfoW проверено под XP SP2, на пятитысячной коллекции шрифтов.
type
TT_OFFSET_TABLE=packed record
uMajorVersion,uMinorVersion,uNumOfTables,
uSearchRange,uEntrySelector,uRangeShift:Word;
end;
TT_TABLE_DIRECTORY=packed record
szTag:array[0..3] of Char;
uCheckSum,uOffset,uLength:DWORD;
end;
TT_NAME_TABLE_HEADER=packed record
uFSelector,uNRCount,uStorageOffset:Word;
end;
TT_NAME_RECORD=packed record
uPlatformID,uEncodingID,uLanguageID,
uNameID,uStringLength,uStringOffset:Word;
end;
function GetTTFFontName(Stream:TStream):string;
var
ttOffsetTable:TT_OFFSET_TABLE;
tblDir:TT_TABLE_DIRECTORY;
ttNTHeader:TT_NAME_TABLE_HEADER;
ttBestRecord,ttRecord:TT_NAME_RECORD;
Found:Boolean;
Temp:array of Byte;
A,LangID:Integer;
procedure SwapBuffer16(var Buffer;Count:Integer);
var
A:Integer;
Words:array[0..0] of Word absolute Buffer;
begin
for A:=0 to(Count div 2)-1 do
Words[A]:=ByteSwap16(Words[A]);
end;
begin
Result:='';
if Stream.Read(ttOffsetTable,SizeOf(ttOffsetTable))<>SizeOf(ttOffsetTable) then Exit;
SwapBuffer16(ttOffsetTable,SizeOf(ttOffsetTable));
if (ttOffsetTable.uMajorVersion<>1)or(ttOffsetTable.uMinorVersion<>0) then Exit;
Found:=False;
for A:=0 to ttOffsetTable.uNumOfTables-1 do begin
if Stream.Read(tblDir,SizeOf(tblDir))<>SizeOf(tblDir) then Exit;
if StrLIComp(tblDir.szTag,'name',4)=0 then begin
Found:=True;
Break;
end
end;
if Found then begin
tblDir.uOffset:=ByteSwap32(tblDir.uOffset);
Stream.Position:=tblDir.uOffset;
if (Stream.Read(ttNTHeader,SizeOf(ttNTHeader))<>SizeOf(ttNTHeader))or(ttNTHeader.uFSelector<>0) then Exit;
SwapBuffer16(ttNTHeader,SizeOf(ttNTHeader));
Found:=False;
LangID:=GetSystemDefaultLangID;
for A:=0 to ttNTHeader.uNRCount-1 do begin
if Stream.Read(ttRecord,SizeOf(ttRecord))<>SizeOf(ttRecord) then Exit;
SwapBuffer16(ttRecord,SizeOf(ttRecord));
if ((ttRecord.uNameID=4)and(ttRecord.uStringLength>0))and(not Found
or((ttRecord.uLanguageID=LangID)and not(ttBestRecord.uLanguageID=LangID))
or((ttRecord.uLanguageID=$409)and not(ttBestRecord.uLanguageID=$409))
or((ttRecord.uLanguageID=0)and not(ttBestRecord.uLanguageID=0))) then begin
ttBestRecord:=ttRecord;
Found:=True;
end;
end;
if Found then begin
Stream.Position:=tblDir.uOffset+ttNTHeader.uStorageOffset+ttBestRecord.uStringOffset;
SetLength(Temp,ttBestRecord.uStringLength);
if Stream.Read(Temp[0],ttBestRecord.uStringLength)<>ttBestRecord.uStringLength then Exit;
if (ttBestRecord.uPlatformID in [PLATFORM_UNICODE,PLATFORM_MICROSOFT])
and(ttBestRecord.uEncodingID in [0..1]) then begin
SwapBuffer16(Temp[0],ttBestRecord.uStringLength);
WideCharLenToStrVar(PWideChar(@Temp[0]),ttBestRecord.uStringLength div 2,Result);
end
else
if (ttBestRecord.uPlatformID in [PLATFORM_MACINTOSH,PLATFORM_ISO])
and(ttBestRecord.uEncodingID=0) then
SetString(Result,PChar(@Temp[0]),ttBestRecord.uStringLength);
end;
end;
end;
To Михаил Комин:
Отлично! Спасибо! Я тут правда свой способ придумал, без использования недокументированных функций, он менее надёжен, но его, судя по всему, можно и в 9х использовать.
function FontNameFromFile(const FileName:string):string;
type
TInfo=record
Fonts:TStringList;
Index:Integer;
Name:string;
end;
var
DC:HDC;
LFont:TLogFont;
Info:TInfo;
function EnumFontsProc1(const LogFont:EnumLogFontEx;const TextMetric:TTextMetric;FontType:Integer;var Info:TInfo):Integer; stdcall;
begin
Info.Fonts.Add(LogFont.elfFullName);
Result:=1;
end;
function EnumFontsProc2(const LogFont:EnumLogFontEx;const TextMetric:TTextMetric;FontType:Integer;var Info:TInfo):Integer; stdcall;
begin
if (Info.Index<Info.Fonts.Count)and(Info.Fonts[Info.Index]=LogFont.elfFullName) then begin
Result:=1;
Inc(Info.Index);
end
else begin
Result:=0;
Info.Name:=LogFont.elfFullName;
end;
end;
begin
Result:='';
DC:=GetDC(0);
try
FillChar(LFont,SizeOf(LFont),0);
LFont.lfCharset:=DEFAULT_CHARSET;
Info.Fonts:=TStringList.Create;
try
EnumFontFamiliesEx(DC,LFont,@EnumFontsProc1,Integer(@Info),0);
if AddFontResourceEx(PChar(FileName),FR_PRIVATE,nil)=0 then Exit;
Info.Index:=0;
EnumFontFamiliesEx(DC,LFont,@EnumFontsProc2,Integer(@Info),0);
RemoveFontResourceEx(PChar(FileName),FR_PRIVATE,nil);
Result:=Info.Name;
finally
Info.Fonts.Free;
end;
finally
ReleaseDC(0,DC);
end;
end;
function GetFontResourceInfoW (FontPath : PWideChar; var BufSize : DWORD; FontName : PWideChar; dwFlags : DWORD) : DWORD; stdcall; external 'GDI32.DLL';
1-ый параметр - указатель на Wide-строку, содержащую путь к файлу шрифта;
2-ой параметр - указатель на DWORD-переменную, содержащую размер выходного буфера. После выполнения функции в этой переменной будет содержаться необходимая длина буфера;
3-ий параметр - указатель на буфер, в случае успешного выполнения будет содержать Wide-строку имени шрифта;
4-ый параметр - какие-то флаги, если рыться в функции GetFontResourceInfoW особым случаем является когда dwFlags=4, но зачем это, я так и не понял - в результате будет возвращен тот же путь к файлу; ну а для получения имени шрифта флаг должен быть равен 1.
использование:
function TForm1.GetFontName (FontFileA : PChar) : String;
type
TGetFontResourceInfoW = function (FontPath : PWideChar; var BufSize : DWORD; FontName : PWideChar; dwFlags : DWORD) : DWORD; stdcall;
var
GetFontResourceInfoW : TGetFontResourceInfoW;
FontFileW : PWideChar;
FontNameW : PWideChar;
FontFileWSize, FontNameSize : DWORD;
begin
Result := '';
GetFontResourceInfoW := GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW');
if @GetFontResourceInfoW = nil then Exit;
if AddFontResource(FontFileA) = 0 then Exit;
Result := FontNameW;
FreeMem (FontFileW);
FreeMem (FontNameW);
RemoveFontResource(FontFileA);
end;
вызов:
GetFontName('C:\MyFonts\FUTURA.TTF')
PS: Всё бы хорошо, но эта функция хоть и есть в Win9x, только её там вызывать нельзя - пишет "This function is only valid in Windows NT mode."...
FontView в Win9x использует EnumFontFamiliesEx (видимо по предложенному Vit'ом и x77 способу)...
FontView в WinNT использует GetFontResourceInfo (в импорте вообще нет EnumFontFamiliesEx или других Enum*)...
25-08-2005 13:06 | Комментарий к предыдущим ответам
винда сканирует выбранную папку и выводит названия всех шрифтов без их установки
Чаще всего винда просто читает заголовки файлов, чтобы отобразить какую-то информацию о файле...
Ну да, это скорее всего выполняется какими-то функциями...
25-08-2005 12:25 | Комментарий к предыдущим ответам
Установи шрифт, посмотри имя, удали шрифт ;)
А если серьёзно? Меня тоже интересует как из TTF получить имя шрифта которое можно в TFont.Name подставить. Поиск по MSDN результатов не дал (может плохо искал). Вариант с ручным разбором структуры TTF не устраивает, ведь при добавлении шрифта в панель управления, винда сканирует выбранную папку и выводит названия всех шрифтов без их установки, хотелось бы знать какие функции при этом используются.
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
