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.
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:
Setting the console code page to UTF-8 with SetConsoleOutputCP(CP_UTF8), and
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.
Related
AS. since closing related questions - more examples added below.
The below simple code (which finds a top-level Ie window and enumerates its children) works Ok with a '32-bit Windows' target platform. There's no problem with earlier versions of Delphi as well:
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
EnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
I've inserted an Assert to indicate where it fails with a '64-bit Windows' target platform. There's no problem with the code if I un-nest the callback.
I'm not sure if the erroneous values passed with the parameters are just garbage or are due to some mis-placed memory addresses (calling convention?). Is nesting callbacks infact something that I should never do in the first place? Or is this just a defect that I have to live with?
edit:
In response to David's answer, the same code having EnumChildWindows declared with a typed callback. Works fine with 32-bit:
(edit: The below does not really test what David says since I still used the '#' operator. It works fine with the operator, but if I remove it, it indeed does not compile unless I un-nest the callback)
type
TFNEnumChild = function(hwnd: HWND; lParam: LPARAM): Bool; stdcall;
function TypedEnumChildWindows(hWndParent: HWND; lpEnumFunc: TFNEnumChild;
lParam: LPARAM): BOOL; stdcall; external user32 name 'EnumChildWindows';
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
TypedEnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
Actually this limitation is not specific to a Windows API callbacks, but the same problem happens when taking address of that function into a variable of procedural type and passing it, for example, as a custom comparator to TList.Sort.
http://docwiki.embarcadero.com/RADStudio/Rio/en/Procedural_Types
procedure TForm2.btn1Click(Sender: TObject);
var s : TStringList;
function compare(s : TStringList; i1, i2 : integer) : integer;
begin
result := CompareText(s[i1], s[i2]);
end;
begin
s := TStringList.Create;
try
s.add('s1');
s.add('s2');
s.add('s3');
s.CustomSort(#compare);
finally
s.free;
end;
end;
It works as expected when compiled as 32-bit, but fails with Access Violation when compiled for Win64. For 64-bit version in function compare, s = nil and i2 = some random value;
It also works as expected even for Win64 target, if one extracts compare function outside of btn1Click function.
This trick was never officially supported by the language and you have been getting away with it to date due to the implementation specifics of the 32 bit compiler. The documentation is clear:
Nested procedures and functions (routines declared within other routines) cannot be used as procedural values.
If I recall correctly, an extra, hidden, parameter is passed to nested functions with the pointer to the enclosing stack frame. This is omitted in 32 bit code if no reference is made to the enclosing environment. In 64 bit code the extra parameter is always passed.
Of course a big part of the problem is that the Windows unit uses untyped procedure types for its callback parameters. If typed procedures were used the compiler could reject your code. In fact I view this as justification for the belief that the trick you used was never legal. With typed callbacks a nested procedure can never be used, even in the 32 bit compiler.
Anyway, the bottom line is that you cannot pass a nested function as parameter to another function in the 64 bit compiler.
AS. since closing related questions - more examples added below.
The below simple code (which finds a top-level Ie window and enumerates its children) works Ok with a '32-bit Windows' target platform. There's no problem with earlier versions of Delphi as well:
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
EnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
I've inserted an Assert to indicate where it fails with a '64-bit Windows' target platform. There's no problem with the code if I un-nest the callback.
I'm not sure if the erroneous values passed with the parameters are just garbage or are due to some mis-placed memory addresses (calling convention?). Is nesting callbacks infact something that I should never do in the first place? Or is this just a defect that I have to live with?
edit:
In response to David's answer, the same code having EnumChildWindows declared with a typed callback. Works fine with 32-bit:
(edit: The below does not really test what David says since I still used the '#' operator. It works fine with the operator, but if I remove it, it indeed does not compile unless I un-nest the callback)
type
TFNEnumChild = function(hwnd: HWND; lParam: LPARAM): Bool; stdcall;
function TypedEnumChildWindows(hWndParent: HWND; lpEnumFunc: TFNEnumChild;
lParam: LPARAM): BOOL; stdcall; external user32 name 'EnumChildWindows';
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
TypedEnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
Actually this limitation is not specific to a Windows API callbacks, but the same problem happens when taking address of that function into a variable of procedural type and passing it, for example, as a custom comparator to TList.Sort.
http://docwiki.embarcadero.com/RADStudio/Rio/en/Procedural_Types
procedure TForm2.btn1Click(Sender: TObject);
var s : TStringList;
function compare(s : TStringList; i1, i2 : integer) : integer;
begin
result := CompareText(s[i1], s[i2]);
end;
begin
s := TStringList.Create;
try
s.add('s1');
s.add('s2');
s.add('s3');
s.CustomSort(#compare);
finally
s.free;
end;
end;
It works as expected when compiled as 32-bit, but fails with Access Violation when compiled for Win64. For 64-bit version in function compare, s = nil and i2 = some random value;
It also works as expected even for Win64 target, if one extracts compare function outside of btn1Click function.
This trick was never officially supported by the language and you have been getting away with it to date due to the implementation specifics of the 32 bit compiler. The documentation is clear:
Nested procedures and functions (routines declared within other routines) cannot be used as procedural values.
If I recall correctly, an extra, hidden, parameter is passed to nested functions with the pointer to the enclosing stack frame. This is omitted in 32 bit code if no reference is made to the enclosing environment. In 64 bit code the extra parameter is always passed.
Of course a big part of the problem is that the Windows unit uses untyped procedure types for its callback parameters. If typed procedures were used the compiler could reject your code. In fact I view this as justification for the belief that the trick you used was never legal. With typed callbacks a nested procedure can never be used, even in the 32 bit compiler.
Anyway, the bottom line is that you cannot pass a nested function as parameter to another function in the 64 bit compiler.
Since I've upgraded from delphi 5 to XE I'm struggling to use specific Dlls that were compiled a while ago. My blocking point seems related to the unicode/ansi character but I haven't found out how to solve the problem
Here is an example of procedure:
procedure GetFilename(Buffer: PChar; BufSize: Integer); stdcall;
In my code I'm calling this that way
implementation
procedure GetFilename; external 'myDll.dll' name 'GetFilename';
procedure myproc
var
buffer : Array [0..255] of Char;
begin
GetFilename(buffer, length(buffer)-1);
Showmessage(buffer); //This gives me chinese character
end;
Buffer contains this:
byte((#buffer[0])^); // 67 which is the ASCII for C
byte((#buffer[1])^); // 92 which is the ASCII for \
what I'm expecting normal is a string starting with "C:\"
Has anyone faced the same problem?
Because the dll was made using a non-Unicode version of Delphi you must change the declaration from
procedure GetFilename(Buffer: PChar; BufSize: Integer); stdcall;
to
procedure GetFilename(Buffer: PAnsiChar; BufSize: Integer); stdcall;
and the buffer variable from
buffer : Array [0..255] of Char;
to
buffer : Array [0..255] of AnsiChar;
Additionally to learn about the Delphi Unicode support take a look to the Delphi and Unicode Whitepaper from Marco Cantú.
AS. since closing related questions - more examples added below.
The below simple code (which finds a top-level Ie window and enumerates its children) works Ok with a '32-bit Windows' target platform. There's no problem with earlier versions of Delphi as well:
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
EnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
I've inserted an Assert to indicate where it fails with a '64-bit Windows' target platform. There's no problem with the code if I un-nest the callback.
I'm not sure if the erroneous values passed with the parameters are just garbage or are due to some mis-placed memory addresses (calling convention?). Is nesting callbacks infact something that I should never do in the first place? Or is this just a defect that I have to live with?
edit:
In response to David's answer, the same code having EnumChildWindows declared with a typed callback. Works fine with 32-bit:
(edit: The below does not really test what David says since I still used the '#' operator. It works fine with the operator, but if I remove it, it indeed does not compile unless I un-nest the callback)
type
TFNEnumChild = function(hwnd: HWND; lParam: LPARAM): Bool; stdcall;
function TypedEnumChildWindows(hWndParent: HWND; lpEnumFunc: TFNEnumChild;
lParam: LPARAM): BOOL; stdcall; external user32 name 'EnumChildWindows';
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
TypedEnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
Actually this limitation is not specific to a Windows API callbacks, but the same problem happens when taking address of that function into a variable of procedural type and passing it, for example, as a custom comparator to TList.Sort.
http://docwiki.embarcadero.com/RADStudio/Rio/en/Procedural_Types
procedure TForm2.btn1Click(Sender: TObject);
var s : TStringList;
function compare(s : TStringList; i1, i2 : integer) : integer;
begin
result := CompareText(s[i1], s[i2]);
end;
begin
s := TStringList.Create;
try
s.add('s1');
s.add('s2');
s.add('s3');
s.CustomSort(#compare);
finally
s.free;
end;
end;
It works as expected when compiled as 32-bit, but fails with Access Violation when compiled for Win64. For 64-bit version in function compare, s = nil and i2 = some random value;
It also works as expected even for Win64 target, if one extracts compare function outside of btn1Click function.
This trick was never officially supported by the language and you have been getting away with it to date due to the implementation specifics of the 32 bit compiler. The documentation is clear:
Nested procedures and functions (routines declared within other routines) cannot be used as procedural values.
If I recall correctly, an extra, hidden, parameter is passed to nested functions with the pointer to the enclosing stack frame. This is omitted in 32 bit code if no reference is made to the enclosing environment. In 64 bit code the extra parameter is always passed.
Of course a big part of the problem is that the Windows unit uses untyped procedure types for its callback parameters. If typed procedures were used the compiler could reject your code. In fact I view this as justification for the belief that the trick you used was never legal. With typed callbacks a nested procedure can never be used, even in the 32 bit compiler.
Anyway, the bottom line is that you cannot pass a nested function as parameter to another function in the 64 bit compiler.
First of all, I'm not too comfortable with DLL's. I've done them before, but know very little and always have problems.
This DLL I'm building requires passing a windows form handle (HWND) into the DLL function, and the DLL shall call a Windows API function using that handle. I keep getting an access violation when trying to call any function (starting from Win7InitTaskbar) - as if it failed to even call the function. That made me conclude that it must be the HWND parameter making it crash... I think...
library Win7;
uses
//Do I need ShareMem?
//ShareMem, //<---
Windows,
Forms,
JDWin7,
SysUtils,
Classes;
{$R *.res}
function Win7InitTaskbar(const FormHandle: HWND): Bool; stdcall;
begin
Result:= InitializeTaskbarAPI(FormHandle);
end;
function Win7InitForm(const FormHandle: HWND): Bool; stdcall;
begin
end;
function Win7SetTaskbarState(const AState: Cardinal): Bool; stdcall;
begin
Result:= SetTaskbarProgressState(AState);
end;
function Win7SetTaskbarValue(const ACurrent: UInt64; const AMax: UInt64): Bool; stdcall;
begin //is UInt64 Safe for DLL?
Result:= SetTaskbarProgressValue(ACurrent, AMax);
end;
exports
Win7InitTaskbar,
Win7InitForm,
Win7SetTaskbarState,
Win7SetTaskbarValue;
begin
end.
Implementation of DLL functions:
function Win7InitTaskbar(const FormHandle: HWND): Bool;
external W7DLL;
function Win7SetTaskbarState(const AState: Cardinal): Bool;
external W7DLL;
function Win7SetTaskbarValue(const ACurrent: UInt64; const AMax: UInt64): Bool;
external W7DLL;
I had this problem whether I used ShareMem or not (Which, I also do not want to use). Is it safe to publish the function with a HWND parameter? I tried LongWord as well, still no luck. The internal function InitializeTaskbarAPI does in fact work perfectly outside of the DLL, if i were to use it directly inside the app. But in this case, I want to put these in a shared DLL.
Also, is it safe to pass UInt64 into a DLL? One of the functions was already published with this parameter type when I got the source.
Your problem here appears to me to be unrelated to using Sharemem or passing Form.Handle to an HWND parameter.
It is simply a calling convention mismatch. You export as stdcall but then import as register. Whenever you do that, runtime errors are sure to follow.
You need to do it like this:
function Win7InitTaskbar(const FormHandle: HWND): Bool;
stdcall; external W7DLL;
function Win7SetTaskbarState(const AState: Cardinal): Bool;
stdcall; external W7DLL;
function Win7SetTaskbarValue(const ACurrent: UInt64; const AMax: UInt64): Bool;
stdcall; external W7DLL;
And for what it is worth, you don't need Sharemem here. You only need that when you allocate memory in one module but free it in a different one. And passing Form.Handle to an HWND parameter in a DLL is not a problem. You do this all then time when you call Windows API functions.