Search code examples
delphidelphi-xe6

How to set console font?


How can I set a unicode font for console? I tried the following but I get an AV on the line GetCurrentConsoleFontEx.

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.

Solution

  • These functions use the stdcall calling convention. You'll need to add that the their declaration.

    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';
    

    You should also check the return values of these API calls. For instance, using Win32Check would be appropriate.

    As an aside, the call to CheckWin32Version is pointless. If the API functions that you import are not present in kernel32.dll then the program will not even load. You could use delay loading to get around that and support XP, if XP support is indeed desirable to you.

    One final comment is that the struct parameter to these functions is not optional. In which case converting to const and var makes the function call a little more convenient.

    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';
    

    A more fundamental problem that you will face is that Delphi's console output functions do not support Unicode. Changing fonts won't change that. Nothing is going to get Delphi to deal with Unicode text when you call Write.

    To output Unicode text from Delphi, you'll need to go direct to the Windows console API. For instance, WriteConsoleW.

    Even that won't help you with characters that require surrogate pairs, such as Chinese text. The console API is still limited to UCS2 and so if your text has surrogate pairs you are simply out of luck.


    Update

    According to TOndrej's answer to another question, you can produce Unicode output from Write by:

    1. Setting the console code page to UTF-8 with SetConsoleOutputCP(CP_UTF8), and
    2. Passing UTF-8 encoded 8 bit text to Write by making use of UTF8Encode.

    However, I believe that you will still not get past the lack of UTF-16 surrogate pair support for text outside the BMP.