Question

如何为控制台设置unicode字体？我尝试了以下操作，但我在GetCurrentConsoleFontEx行上获得了一个AV。

program ConsoleVsUnicode;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils;

type
  COORD = record
    X, Y: smallint;
  end;

  TCONSOLE_FONT_INFOEX = record
    cbSize: cardinal;
    nFont: longword;
    dwFontSize: COORD;
    FontFamily: cardinal;
    FontWeight: cardinal;
    FaceName: array [0 .. LF_FACESIZE - 1] of WideChar;
  end;

  PCONSOLE_FONT_INFOEX = ^TCONSOLE_FONT_INFOEX;

function SetCurrentConsoleFontEx(ConsoleOutput: THandle; MaximumWindow: BOOL; ConsoleInfo: PCONSOLE_FONT_INFOEX): BOOL; external kernel32 name 'SetCurrentConsoleFontEx';
function GetCurrentConsoleFontEx(ConsoleOutput: THandle; MaximumWindow: BOOL; ConsoleInfo: PCONSOLE_FONT_INFOEX): BOOL; external kernel32 name 'GetCurrentConsoleFontEx';

procedure SetConsoleFont(const AFontSize: word);
var
  ci: TCONSOLE_FONT_INFOEX;
  ch: THandle;
begin
  if NOT CheckWin32Version(6, 0) then
  EXIT;

  FillChar(ci, SizeOf(TCONSOLE_FONT_INFOEX), 0);
  ci.cbSize := SizeOf(TCONSOLE_FONT_INFOEX);

  ch := GetStdHandle(STD_OUTPUT_HANDLE);
  GetCurrentConsoleFontEx(ch, FALSE, @ci); // AV Here!

  ci.FontFamily := FF_DONTCARE;
  // ci.FaceName:= 'Lucida Console';
  ci.FaceName := 'Consolas';
  ci.dwFontSize.X := 0;
  ci.dwFontSize.Y := AFontSize;
  ci.FontWeight := FW_BOLD;
  SetCurrentConsoleFontEx(ch, FALSE, @ci);

end;

begin
  SetConsoleFont(32);
  ReadLn;

end.

Answer 1

这些函数使用stdcall调用约定。您需要添加他们的声明。

function SetCurrentConsoleFontEx(ConsoleOutput: THandle; MaximumWindow: BOOL;
  ConsoleInfo: PCONSOLE_FONT_INFOEX): BOOL; stdcall;
  external kernel32 name 'SetCurrentConsoleFontEx';
function GetCurrentConsoleFontEx(ConsoleOutput: THandle; MaximumWindow: BOOL;
  ConsoleInfo: PCONSOLE_FONT_INFOEX): BOOL; stdcall;
  external kernel32 name 'GetCurrentConsoleFontEx';

您还应该检查这些API调用的返回值。例如，使用Win32Check是合适的。

顺便说一下，对CheckWin32Version的呼吁毫无意义。如果导入的API函数不在kernel32.dll中，则程序甚至不会加载。如果确实需要XP支持，你可以使用延迟加载来解决这个问题并支持XP。

最后一个评论是这些函数的struct参数不是可选的。在这种情况下，转换为const和var会使函数调用更加方便。

function SetCurrentConsoleFontEx(ConsoleOutput: THandle; MaximumWindow: BOOL;
  const ConsoleInfo: TCONSOLE_FONT_INFOEX): BOOL; stdcall;
  external kernel32 name 'SetCurrentConsoleFontEx';
function GetCurrentConsoleFontEx(ConsoleOutput: THandle; MaximumWindow: BOOL;
  var ConsoleInfo: TCONSOLE_FONT_INFOEX): BOOL; stdcall;
  external kernel32 name 'GetCurrentConsoleFontEx';

您将面临的一个更基本的问题是Delphi的控制台输出功能不支持Unicode。更改字体不会改变它。当你致电Write时，没有什么能让Delphi处理Unicode文本。

要从Delphi输出Unicode文本，您需要直接转到Windows控制台API。例如，WriteConsoleW。

即便如此，也无法帮助您处理需要代理对的字符，例如中文文本。控制台API仍然仅限于UCS2，因此，如果您的文本具有代理对，那么您就是运气不好。

<强>更新

根据TOndrej's answer to another question，您可以通过以下方式从Write生成Unicode输出：

使用SetConsoleOutputCP(CP_UTF8)和
使用Write将UTF-8编码的8位文本传递给UTF8Encode。

但是，我相信你仍然无法克服缺乏UTF-16代理对支持BMP之外的文本。

如何设置控制台字体？

1 个答案: