4

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.

1 Answers1

3

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.

Community
  • 1
  • 1
David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • 1
    How about delayed loading? – user3841593 Jul 15 '14 at 15:41
  • @user3841593 Yes, I already mentioned that, but that's really orthogonal to the question – David Heffernan Jul 15 '14 at 15:42
  • The problem with this implementation is that this still will not output chinese characters. – user3841593 Jul 15 '14 at 15:44
  • I took your question to be how to resolve the access violation. I cannot see anywhere in the question where you attempt to write to the console. – David Heffernan Jul 15 '14 at 15:45
  • @DavidHeffernan Thanks. I'll ask it in another question. – user3841593 Jul 15 '14 at 15:48
  • @user3841593 I've already dealt with it in an update to this answer. In summary, `Write` is not going to be of any use to you. You need to use Win32 API directly. You might find it more productive to link to `msvcrt.dll` and use its console support! – David Heffernan Jul 15 '14 at 15:49
  • Yup, that gets it done. It won't handle Chinese I suspect. If I recall correctly the console is still UCS2 and Chinese characters require surrogate pairs. – David Heffernan Jul 15 '14 at 16:02
  • You can use SetConsoleOutputCP(CP_UTF8) as mentioned [here](http://stackoverflow.com/questions/265018/unicode-console-application-in-delphi-2009/268202#268202). – Ondrej Kelle Jul 15 '14 at 16:14