delphi - 如何设置控制台字体？

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。

最后一点是，这些函数的结构参数不是可选的。在这种情况下，转换为 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 输出:

1. 使用 SetConsoleOutputCP(CP_UTF8) 将控制台代码页设置为 UTF-8，并且
2. 使用 UTF8Encode 将 UTF-8 编码的 8 位文本传递给 Write。

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