Использование SystemParametersInfo SPI_GETICONTITLELOGFONT

2

В настоящее время я использую функцию SystemParametersInfo для извлечения SPI_GETICONTITLELOGFONT. Согласно документации MSDN это http://msdn.microsoft.com/en-us/library/ms724947(VS.85).aspx

"Получает информацию о логическом шрифте для текущего шрифта заголовка значка"

Но это всегда извлекает "Segoe UI", даже когда я меняю свой шрифт на "VivlaidD". Я нахожусь на машине Windows 7. Является ли это, что эта функция только восстанавливает системный дефолт? Или что-то не так с "SystemParametersInfo"?

Вот мой код для извлечения шрифта:

procedure GetUserFontPreference(out FaceName: string; out PixelHeight: Integer);
var
  lf: LOGFONT;
begin
  ZeroMemory(@lf, SizeOf(lf));

  if SystemParametersInfo(SPI_GETICONTITLELOGFONT, SizeOf(lf), @lf, 0) then
  begin
    FaceName := PChar(Addr(lf.lfFaceName[0]));
    PixelHeight := lf.lfHeight;
  end
  else
  begin
    {
            If we can't get it, then assume the same non-user preferences that
            everyone else does.
    }
    FaceName := 'MS Shell Dlg 2';
    PixelHeight := 8;
  end;
end;
  • 0
    Вы правильно написали название этого шрифта? Должно ли это быть VivaldiD?
  • 0
    Остерегайтесь плохо намекаемых шрифтов, которые могут быть заменены маленькими точечными размерами.
Показать ещё 2 комментария
Теги:
windows-7

2 ответа

1

Проблема заключается в не с вашим кодом, как вы можете видеть со следующим консольным приложением D2010, изменением и извлечением шрифта и хорошей работой на Win7 x64:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;


procedure GetUserFontPreference(out FaceName: string; out PixelHeight: Integer);
var
  lf: LOGFONT;
begin
  ZeroMemory(@lf, SizeOf(lf));

  if SystemParametersInfo(SPI_GETICONTITLELOGFONT, SizeOf(lf), @lf, 0) then
  begin
    FaceName := lf.lfFaceName; // simpler than PChar(Addr(lf.lfFaceName[0]));
    PixelHeight := lf.lfHeight;
  end
  else
  begin
    {
            If we can t get it, then assume the same non-user preferences that
            everyone else does.
    }
    FaceName := 'MS Shell Dlg 2';
    PixelHeight := 8;
  end;
end;

procedure SetUserFontPreference(const AFaceName: string; const APixelHeight: Integer);
var
  lf: LOGFONT;
begin
  ZeroMemory(@lf, SizeOf(lf));
  Move(AFaceName[1], lf.lfFaceName, Length(AFaceName)*SizeOf(Char));
  lf.lfHeight := APixelHeight;
  SystemParametersInfo(SPI_SETICONTITLELOGFONT, SizeOf(lf), @lf, 0);
end;

procedure Test;
var
  FontName, NewFontName, OldFontName: string;
  FontHeight: Integer;
begin
  GetUserFontPreference(OldFontName, FontHeight);
  Writeln('Current (Old) Font is ', OldFontName);
  Readln;

  NewFontName := 'Rage Italic';  //'Segoe UI';//'Rage Italic';
  SetUserFontPreference(NewFontName, FontHeight);
  GetUserFontPreference(FontName, FontHeight);
  Assert(FontName=NewFontName);
  Writeln('Current (New) Font is ', FontName);
  Readln;

  SetUserFontPreference(OldFontName, FontHeight);
  GetUserFontPreference(FontName, FontHeight);
  Assert(FontName=OldFontName);
  Writeln('Current Font is back to (Old) ', FontName);
  Readln;
end;

begin
  try
    Test;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.
Поделиться
1

Возможно, вы изменили неправильный шрифт в меню персонализации? Если я изменил шрифт Icon из Segoe UI в Verdana, следующий код работает правильно:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

var
  LogFont: TLogFont;

begin
  try
    if SystemParametersInfo(SPI_GETICONTITLELOGFONT, SizeOf(LogFont),
      @LogFont, 0) then
      Writeln('Current Font is ', LogFont.lfFaceName)
    else
      Writeln('Error #', GetLastError);

    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.
Поделиться
  • 0
    Я также думал, что мог изменить неправильный шрифт, поэтому я изменил все свои шрифты на VivaldiD, но я все еще мог получить только «Segoe UI».
  • 0
    И мой код тоже не работает?
Показать ещё 1 комментарий

Ещё вопросы

Сообщество Overcoder
Наверх
Меню