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

如何为控制台设置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.

这些函数使用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,您可以通过以下方式生成Unicode输出：

>使用SetConsoleOutputCP(CP_UTF8)将控制台代码页设置为UTF-8,和
>通过使用UTF8Encode将UTF-8编码的8位文本传递给Write.

但是,我相信你仍然无法通过缺乏UTF-16代理对支持BMP之外的文本.