Delphi VirtualKey to WideString/UNICODE using TNT controls on non-unicode Delphi 7

Question

I am using this code to convert a virtual key to WideString:

function VKeytoWideString (Key : Word) : WideString; 
var 
 WBuff         : array [0..255] of WideChar; 
 KeyboardState : TKeyboardState; 
 UResult       : Integer;
begin 
 Result := '';
 GetKeyBoardState (KeyboardState); 
 ZeroMemory(@WBuff[0], SizeOf(WBuff));
 UResult := ToUnicode(key, MapVirtualKey(key, 0), KeyboardState, WBuff, Length(WBuff), 0); 
 if UResult > 0 then
  SetString(Result, WBuff, UResult)
 else if UResult = -1 then
  Result := WBuff;
end; 

It works fine on my PC, but on a Chinese PC I get this:

It converts the Chinese chars to Hanyu Pinyin. I think the function actually returns the raw input of the keyboard and not what the user actually wants to type in.

How should I handle this?

Answer 1

As per the comments, here is an example of how you can avoid the problem by handling KeyPress events instead of manually converting KeyDown events. The TNT controls don't provide a WideChar KeyPress event, but it's fairly easy to add. Ideally, you should not put the extensions to TTntMemo and TTntForm in derived classes as I've done here, but instead modify the TNT source code.

The form contains two TTntMemo controls. Pressing keys in the first will log the events in the second.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TntForms, StdCtrls, TntStdCtrls;

type
  TKeyPressWEvent = procedure(Sender: TObject; var Key: WideChar) of object;

  TTntMemo = class(TntStdCtrls.TTntMemo)
  private
    FOnKeyPressW: TKeyPressWEvent;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  protected
    function DoKeyPressW(var Message: TWMKey): Boolean;
    procedure KeyPressW(var Key: WideChar);
  published
    property OnKeyPressW: TKeyPressWEvent read FOnKeyPressW write FOnKeyPressW;
  end;

  TTntForm = class(TntForms.TTntForm)
  private
    FOnKeyPressW: TKeyPressWEvent;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  protected
    function DoKeyPressW(var Message: TWMKey): Boolean;
    procedure KeyPressW(var Key: WideChar);
  published
    property OnKeyPressW: TKeyPressWEvent read FOnKeyPressW write FOnKeyPressW;
  end;

  TForm1 = class(TTntForm)
    TntMemo1: TTntMemo;
    TntMemo2: TTntMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPressW(Sender: TObject; var Key: WideChar);
    procedure TntMemo1KeyPressW(Sender: TObject; var Key: WideChar);
  end;

var
  Form1: TForm1;

implementation

uses
  TntControls;

{$R *.dfm}

type
  TWinControlAccess = class(TWinControl);
  TTntFormAccess = class(TTntForm);

function TntControl_DoKeyPressW(Self: TWinControl; var Message: TWMKey;
  KeyPressW: Pointer): Boolean;
type
  TKeyPressWProc = procedure(Self: TWinControl; var Key: WideChar);
var
  Form: TCustomForm;
  Ch: WideChar;
begin
  Result := True;
  Form := GetParentForm(Self);
  if (Form <> nil) and (Form <> Self) and Form.KeyPreview then
  begin
    if (Form is TTntForm) and TTntFormAccess(Form).DoKeyPressW(Message) then Exit;
    if TWinControlAccess(Form).DoKeyPress(Message) then Exit;
  end;
  if not (csNoStdEvents in Self.ControlStyle) then
  begin
    Ch := GetWideCharFromWMCharMsg(Message);
    TKeyPressWProc(KeyPressW)(Self, Ch);
    SetWideCharForWMCharMsg(Message, Ch);
    if Ch = #0 then Exit;
  end;
  Result := False;
end;

{ TTntMemo }

function TTntMemo.DoKeyPressW(var Message: TWMKey): Boolean;
begin
  Result := TntControl_DoKeyPressW(Self, Message, @TTntMemo.KeyPressW);
end;

procedure TTntMemo.KeyPressW(var Key: WideChar);
begin
  if Assigned(FOnKeyPressW) then FOnKeyPressW(Self, Key);
end;

procedure TTntMemo.WMChar(var Msg: TWMChar);
begin
  if not DoKeyPressW(Msg) then inherited;
end;

{ TTntForm }

function TTntForm.DoKeyPressW(var Message: TWMKey): Boolean;
begin
  Result := TntControl_DoKeyPressW(Self, Message, @TTntForm.KeyPressW);
end;

procedure TTntForm.KeyPressW(var Key: WideChar);
begin
  if Assigned(FOnKeyPressW) then FOnKeyPressW(Self, Key);
end;

procedure TTntForm.WMChar(var Msg: TWMChar);
begin
  if not DoKeyPressW(Msg) then inherited;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.OnKeyPressW := FormKeyPressW;
  TntMemo1.OnKeyPressW := TntMemo1KeyPressW;
end;

procedure TForm1.FormKeyPressW(Sender: TObject; var Key: WideChar);
begin
  TntMemo2.Lines.Add(WideString('FormKeyPress: ') + Key);
end;

procedure TForm1.TntMemo1KeyPressW(Sender: TObject; var Key: WideChar);
begin
  TntMemo2.Lines.Add(WideString('TntMemo1KeyPress: ') + Key);
end;

end.