spiegel-keyman/common/windows/delphi/components/OnScreenKeyboard.pas

(*
  Name:             OnScreenKeyboard
  Copyright:        Copyright (C) SIL International.
  Documentation:
  Description:
  Create Date:      23 Aug 2006

  Modified Date:    24 Jul 2015
  Authors:          mcdurdin
  Related Files:
  Dependencies:

  Bugs:
  Todo:
  Notes:
  History:          23 Aug 2006 - mcdurdin - Initial version
                    30 Aug 2006 - mcdurdin - Fix underlying layout published bug
                    14 Sep 2006 - mcdurdin - Add Transparent flag, retrieve aspected size, polish drawing
                    04 Dec 2006 - mcdurdin - Fix display of bitmaps, underlying scan codes
                    30 May 2007 - mcdurdin - I763 - Key names for non-character keys should follow active locale
                    04 Jun 2007 - mcdurdin - I763 - Fix size of font for non-character keys
                    04 Jun 2007 - mcdurdin - I764 - Fix layout of ENTER key for European keyboards
                    05 Jun 2007 - mcdurdin - I763 - Add GetItemsByScanCode for verifying UK keyboard 102 key
                    19 Nov 2007 - mcdurdin - I1157 - const string parameters
                    27 Mar 2008 - mcdurdin - I1227, I904, I1102 - Fix crash exporting OSK
                    06 Apr 2010 - mcdurdin - I2262 - Improve performance of OSK when resizing
                    06 Apr 2010 - mcdurdin - I2200 - Fix conflict in OSK and mnemonic layouts
                    06 Apr 2010 - mcdurdin - I764 - Distinguish between 102nd key and European layouts
                    11 Jan 2011 - mcdurdin - I764 - Fixup problems identifying UK layout
                    31 Jan 2011 - mcdurdin - I2576 - Fix positioning and size of text on OSK keys
                    19 Aug 2011 - mcdurdin - I3021 - Backslash key still shows wide keycap in OSK even on Euro layout with narrower key
                    08 Jun 2012 - mcdurdin - I3309 - V9.0 - Migrate to Delphi XE2, VS2010, svn 1.7
                    07 Nov 2013 - mcdurdin - I3945 - V9.0 - Touch Layout Editor should allow import from existing On Screen Keyboard
                    28 Feb 2014 - mcdurdin - I4098 - V9.0 - OSK is still 8.0 style
                    12 Aug 2014 - mcdurdin - I4363 - V9.0 - OSK does not always show base layout when keyboard active
                    02 Oct 2014 - mcdurdin - I4415 - V9.0 - OSK does not show underlying characters if base keyboard is not loaded
                    24 Jul 2015 - mcdurdin - I4799 - Preview keys are wrong colour in Developer
*)
unit OnScreenKeyboard;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  ExtShiftState, StdCtrls, Buttons, VisualKeyboardParameters, Contnrs,
  OnScreenKeyboardData,
  CleartypeDrawCharacter;

type
  TOnScreenKeyboard = class;
  TOnScreenKeyboardKey = class;

  TOnScreenKeyboardKeyPressedEvent = procedure(Sender: TOnScreenKeyboard; Key: TOnScreenKeyboardKey) of object;

  TOnScreenKeyboardKey = class
  private
    FKeyboard: TOnScreenKeyboard;
    FX, FY, FW, FH, FX2, FY2: Integer;
    FDefaultPos: TRect;
    FScanCode: Integer;
    FUSVKey, FVKey: Integer;
    FKeyType: TOnScreenKeyboardKeyType;
    FKeyCaps: array[0..High(ValidExtShiftStates)] of WideString;
    FFontSize: Integer;
    FKeyValue: WideString;
    FEnabled: Boolean;
    FKeyGlyph: TBitmap;
    FData: TOnScreenKeyboardKeyData;   // I3945
    procedure SetKeyCap(Index: Integer; Value: WideString);
    procedure SetKeyValue(Value: WideString);
    procedure DrawKey(DestCanvas: TCanvas; FIsDown, FIsHover, FIsSelected: Boolean);
    function CalcFontSize(Canvas: TCanvas): Integer;
    procedure SetEnabled(const Value: Boolean);
    procedure SetKeyGlyph(const Value: TBitmap);
    procedure Invalidate;
    function GetKeyRect: TRect;
    procedure UpdateKeyCap;
    function GetKeyCap(Index: Integer): WideString;
    function GetActiveKeyCap: WideString;
  public
    constructor Create(AKeyboard: TOnScreenKeyboard; AData: TOnScreenKeyboardKeyData);
    destructor Destroy; override;
    property ScanCode: Integer read FScanCode;
    property VKey: Integer read FVKey;
    property USVKey: Integer read FUSVKey;
    property KeyType: TOnScreenKeyboardKeyType read FKeyType;
    property KeyCaps[Index: Integer]: WideString read GetKeyCap write SetKeyCap;
    property ActiveKeyCap: WideString read GetActiveKeyCap;
    property KeyValue: WideString read FKeyValue write SetKeyValue;
    property KeyGlyph: TBitmap read FKeyGlyph write SetKeyGlyph;
    property KeyRect: TRect read GetKeyRect;
    property KeyData: TOnScreenKeyboardKeyData read FData;   // I3945
    property Enabled: Boolean read FEnabled write SetEnabled default true;
    property FontSize: Integer read FFontSize write FFontSize;
  end;

  TOnScreenKeyboardKeys = class(TObjectList)
  private
    FVKeys: array[0..255] of TOnScreenKeyboardKey;
    FUSVKeys: array[0..255] of TOnScreenKeyboardKey;
    FKeysByType: array[TOnScreenKeyboardKeyType] of TOnScreenKeyboardKey;
    function GetItem(Index: Integer): TOnScreenKeyboardKey;
    function GetItemByVK(Index: Integer): TOnScreenKeyboardKey;
    procedure FillVKeys;
    function GetItemByKeyType(Index: TOnScreenKeyboardKeyType): TOnScreenKeyboardKey;
    function GetItemByUSVK(Index: Integer): TOnScreenKeyboardKey;
    function GetItemsByScanCode(Index: Integer): TOnScreenKeyboardKey;
    function GetItemsByKeyCap(Index: WideChar; Shift: Integer): TOnScreenKeyboardKey;
  public
    procedure ClearValues;
    property Items[Index: Integer]: TOnScreenKeyboardKey read GetItem; default;
    property ItemsByVK[Index: Integer]: TOnScreenKeyboardKey read GetItemByVK;
    property ItemsByUSVK[Index: Integer]: TOnScreenKeyboardKey read GetItemByUSVK;
    property ItemsByKeyType[Index: TOnScreenKeyboardKeyType]: TOnScreenKeyboardKey read GetItemByKeyType;
    property ItemsByKeyCap[Index: WideChar; Shift: Integer]: TOnScreenKeyboardKey read GetItemsByKeyCap;
    property ItemsByScanCode[Index: Integer]: TOnScreenKeyboardKey read GetItemsByScanCode;
  end;

  TQuickBitmap = class
  private
    FOldHBitmap, FHandle: THandle;
    FCanvas: TCanvas;
    function GetCanvas: TCanvas;
    //function GetHDC: THandle;
    //procedure ReleaseDC;
    //FHDC: THandle;
    //function GetHDC: THandle;
  public
    constructor Create(AWidth, AHeight: Integer);
    destructor Destroy; override;
    //procedure ReleaseDC;
    procedure ReleaseCanvas;
    property Handle: THandle read FHandle;
    property Canvas: TCanvas read GetCanvas;
    //property HDC: THandle read GetHDC;
  end;

  TOnScreenKeyboard = class(TCustomControl)
  private
    FScale: Extended;
    FDataFont: TFont;
    FDisplayUnderlyingChar: Boolean;
    F102Key, FHoverKey, FDownKey, FSelectedKey: TOnScreenKeyboardKey;
    FBufferBitmap, FBackgroundBitmap: TQuickBitmap;
    FKeys: TOnScreenKeyboardKeys;
    FOnSelectionChange: TNotifyEvent;
    FIsDown: Boolean;
    FUnderlyingLayout: THandle;
    FShiftState: TExtShiftState;
    FDisableExtendedKeys: Boolean;
    FLRShift: Boolean;
    FOnShiftChange: TNotifyEvent;
    FSelectMode: Boolean;
    FOnKeyPressed: TOnScreenKeyboardKeyPressedEvent;
    FDisplay102Key: Boolean;
    FEuroLayout: Boolean;
    FDrawChar: TCleartypeDrawCharacter;
    FTransparent: Boolean;
    FLargeCapFont: Boolean;

    FUpdateLevel: Integer;
    FUpdateKeys: TList;
    FUpdateInvalidate: Boolean;
    FLoadedKeyboardLayout: HKL;   // I4363

    procedure SetDataFont(const Value: TFont);
    procedure SetDisplayUnderlyingChar(const Value: Boolean);

    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetSelectedKey(const Value: TOnScreenKeyboardKey);

    procedure MapScanCodes(FScanCode: Integer; var Values: array of WideString; var VKey: Integer);

    procedure DoDrawKey(Canvas: TCanvas; Key: TOnScreenKeyboardKey);

    procedure ResizeKeys;
    procedure SetShiftState(const Value: TExtShiftState);
    procedure SetLRShift(const Value: Boolean);
    procedure SetSelectMode(const Value: Boolean);
    procedure SetDisableExtendedKeys(const Value: Boolean);
    procedure SetDisplay102Key(const Value: Boolean);
    procedure SetUnderlyingLayout(const Value: THandle);
    procedure SetTransparent(const Value: Boolean);
    procedure FillBkRect(HDC: THandle; r: TRect);
    procedure SetLargeCapFont(const Value: Boolean);
    procedure CalcKeyFontSizes;
    procedure UpdateEuroLayout;
    procedure Resize102Key;

  protected
    procedure CreateParams(var params: TCreateParams); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;

    procedure SelectionChange; virtual;
    procedure ShiftChange; virtual;
    procedure KeyPressed(Key: TOnScreenKeyboardKey); virtual;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure BeginUpdate;
    procedure EndUpdate;

    procedure AdjustBoundsRect(var r: TRect; BiasX: Boolean);
    function GetKeyAtPoint(X, Y: Integer): TOnScreenKeyboardKey;

    procedure InvalidateKey(Key: TOnScreenKeyboardKey);
    procedure InvalidateShift(ShiftState: TExtShiftState);

    procedure Paint; override;
    procedure Resize; override;

    procedure Invalidate; override;

    property Keys: TOnScreenKeyboardKeys read FKeys;

    property UnderlyingLayout: THandle read FUnderlyingLayout write SetUnderlyingLayout;
    property EuroLayout: Boolean read FEuroLayout;  // I764

    property LargeCapFont: Boolean read FLargeCapFont write SetLargeCapFont;
    property LRShift: Boolean read FLRShift write SetLRShift;
    property ShiftState: TExtShiftState read FShiftState write SetShiftState;
    property SelectedKey: TOnScreenKeyboardKey read FSelectedKey write SetSelectedKey;
  published
    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
    property OnShiftChange: TNotifyEvent read FOnShiftChange write FOnShiftChange;
    property OnKeyPressed: TOnScreenKeyboardKeyPressedEvent read FOnKeyPressed write FOnKeyPressed;

    property DataFont: TFont read FDataFont write SetDataFont;
    property Display102Key: Boolean read FDisplay102Key write SetDisplay102Key default true;
    property DisableExtendedKeys: Boolean read FDisableExtendedKeys write SetDisableExtendedKeys default true;
    property DisplayUnderlyingChar: Boolean read FDisplayUnderlyingChar write SetDisplayUnderlyingChar;
    //property Extended

    property SelectMode: Boolean read FSelectMode write SetSelectMode default true;
    property Transparent: Boolean read FTransparent write SetTransparent default true;

    property Align;
    property Anchors;
    property Color;
    property OnDragOver;
    property OnDragDrop;
    property ParentColor;
    property Enabled;
    property TabOrder;
    property TabStop;
    property Font;
    property ParentFont;
    property Visible;
  end;

procedure Register;

const   // I4098   // I4799
  KeyFontColor_Disabled = $C3C1C0;
  KeyFontColor_Base = $5B5958;
  KeyFontColor_BaseSelected = $5B5958;
  KeyFontColor_Cap = $201f23;

implementation

uses
  System.Math,

  Glossary,
  ScanCodeMap,
  Types,
  Unicode;

{$R onscreenkeyboard.res}

function KeyTypeToExtShiftStateValue(KeyType: TOnScreenKeyboardKeyType; LRShift: Boolean): TExtShiftStateValue;
const
  ShiftStates: array[Boolean, TOnScreenKeyboardKeyType] of TExtShiftStateValue = (
    (TExtShiftStateValue(-1), TExtShiftStateValue(-1), TExtShiftStateValue(-1),
    essShift, essCtrl, essAlt,
    TExtShiftStateValue(-1), TExtShiftStateValue(-1),
    essShift, essCtrl, essAlt),
    (TExtShiftStateValue(-1), TExtShiftStateValue(-1), TExtShiftStateValue(-1),
    essShift, essLCtrl, essLAlt,
    TExtShiftStateValue(-1), TExtShiftStateValue(-1),
    essShift, essRCtrl, essRAlt));
begin
  Result := ShiftStates[LRShift, KeyType];
end;

procedure Register;
begin
  RegisterComponents('Keyman', [TOnScreenKeyboard]);
end;

procedure TOnScreenKeyboard.WMEraseBkGnd(var msg: TWMEraseBkGnd);
begin
  PerformEraseBackground(Self, FBackgroundBitmap.Canvas.Handle); // msg.DC);
  //BitBlt(FBackgroundBitmap.Canvas.Handle, 0, 0, Width, Height, msg.DC, 0, 0, SRCCOPY);
  //SetBkMode(msg.DC, Windows.TRANSPARENT);
  FillBkRect(FBufferBitmap.Canvas.Handle, Rect(0,0,Width,Height));
  msg.result := 1;
end;

procedure TOnScreenKeyboard.AdjustBoundsRect(var r: TRect; BiasX: Boolean);
var
  cx, cy, dx, dy: Integer;
  FScale: Extended;
begin
  cx := r.Right - r.Left;
  cy := r.Bottom - r.Top;

  with FKeys.ItemsByKeyType[kktCtrlRight] do
  begin
    dx := FDefaultPos.Right;
    dy := FDefaultPos.Bottom;
  end;

  if not BiasX then //(cx/dx) > (cy/dy) then
  begin
    // y constrains
    FScale := cy / dy;
    r.Right := r.Left + Trunc(dx * FScale);
  end
  else
  begin
    // x constrains
    FScale := cx / dx;
    r.Bottom := r.Top + Trunc(dy * FScale);
  end;
end;

procedure TOnScreenKeyboard.CMMouseLeave(var Message: TMessage);
var
  k: TOnScreenKeyboardKey;
begin
  if FHoverKey <> nil then
  begin
    k := FHoverKey;
    FHoverKey := nil;
    DoDrawKey(Canvas, k); //InvalidateKey(k);
  end;
  inherited;
end;

constructor TOnScreenKeyboard.Create(AOwner: TComponent);
var
  i: Integer;
  k: Integer;
begin
  inherited Create(AOwner);

  FUpdateKeys := TList.Create;

  Color := $F2F2F1;   // I4098

  FTransparent := True;
  FDrawChar := TCleartypeDrawCharacter.Create;

  FSelectMode := True;
  FDisplay102Key := True;
  FEuroLayout := False;

  FUnderlyingLayout := GetKeyboardLayout(0);

  F102Key := nil;
  FKeys := TOnScreenKeyboardKeys.Create;
  for i := 0 to High(KeyData) do
  begin
    k := FKeys.Add(TOnScreenKeyboardKey.Create(Self, KeyData[i]));
    if KeyData[i].ScanCode = $56 then F102Key := FKeys[k];
  end;
  FKeys.FillVKeys;

  DisableExtendedKeys := True;

  FDataFont := TFont.Create;
  FBackgroundBitmap := TQuickBitmap.Create(Width, Height);
  FBufferBitmap := TQuickBitmap.Create(Width, Height);
  ControlStyle := ControlStyle - [csOpaque];
  ParentBackground := True;

  UpdateEuroLayout;  // I764

  if HasParent then // I1227, I904, I1102 - crash export OSK to BMP, PNG
    CalcKeyFontSizes;
end;

procedure TOnScreenKeyboard.CalcKeyFontSizes;
var
  minsz: Integer;
  i: Integer;
  n: Integer;
  b: TBitmap;
begin
  b := TBitmap.Create;
  try
    minsz := MAXINT;
    for i := 0 to FKeys.Count - 1 do
      if FKeys[i].KeyType <> kktNormal then
      begin
        n := FKeys[i].CalcFontSize(b.Canvas);
        if (n > 0) and (n < minsz) then
          minsz := n;
      end;

    if minsz = MAXINT then minsz := 0;
    for i := 0 to FKeys.Count - 1 do
      if FKeys[i].KeyType <> kktNormal then
        FKeys[i].FontSize := minsz;
  finally
    b.Free;
  end;
end;

procedure TOnScreenKeyboard.CreateParams(var params: TCreateParams);
begin
  inherited CreateParams(params);
  //params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
end;

destructor TOnScreenKeyboard.Destroy;
begin
  FDataFont.Free;
  FreeAndNil(FBackgroundBitmap);
  FreeAndNil(FBufferBitmap);
  FreeAndNil(FDrawChar);
  FKeys.Free;
  FUpdateKeys.Free;

  if FLoadedKeyboardLayout <> 0 then   // I4363
    UnloadKeyboardLayout(FLoadedKeyboardLayout);
  FLoadedKeyboardLayout := 0;

  inherited Destroy;
end;

procedure TOnScreenKeyboard.BeginUpdate;
begin
  if FUpdateLevel = 0 then
  begin
    FUpdateInvalidate := False;
    FUpdateKeys.Clear;
  end;

  Inc(FUpdateLevel);
end;

procedure TOnScreenKeyboard.EndUpdate;
var
  i: Integer;
begin
  Dec(FUpdateLevel);
  if FUpdateLevel = 0 then
  begin
    if FUpdateInvalidate then
    begin
      Invalidate;
    end
    else
      for i := 0 to FUpdateKeys.Count - 1 do
        DoDrawKey(Canvas, TOnScreenKeyboardKey(FUpdateKeys[i]));
    FUpdateKeys.Clear;
  end;
end;
procedure TOnScreenKeyboard.DoDrawKey(Canvas: TCanvas; Key: TOnScreenKeyboardKey);
begin
  if not Assigned(Key) then Exit;
  if not Showing or (csCreating in ControlState) then Exit;
  if not FDisplay102Key and not FEuroLayout and (Key = F102Key) then Exit;

  if FUpdateLevel > 0 then
  begin
    if FUpdateKeys.IndexOf(Key) < 0 then
      FUpdateKeys.Add(Key);
  end
  else
    Key.DrawKey(Canvas, FDownKey = Key, FHoverKey = Key, (FSelectedKey = Key) or (KeyTypeToExtShiftStateValue(Key.KeyType, FLRShift) in FShiftState));
end;

procedure TOnScreenKeyboard.SelectionChange;
begin
  if Assigned(FOnSelectionChange) then
    FOnSelectionChange(Self);
end;

procedure TOnScreenKeyboard.SetDataFont(const Value: TFont);
begin
  FDataFont.Assign(Value);
  Invalidate;
end;

procedure TOnScreenKeyboard.SetSelectedKey(const Value: TOnScreenKeyboardKey);
var
  k: TOnScreenKeyboardKey;
begin
  k := FSelectedKey;
  FSelectedKey := Value;
  if Assigned(k) then DoDrawKey(Canvas, k);//InvalidateKey(k);
  if Assigned(FSelectedKey) then DoDrawKey(Canvas, FSelectedKey);//InvalidateKey(FSelectedKey);
end;

procedure TOnScreenKeyboard.SetSelectMode(const Value: Boolean);
var
  k: TOnScreenKeyboardKey;
begin
  FSelectMode := Value;
  if not Value then
  begin
    k := FSelectedKey;
    FSelectedKey := nil;
    if k <> nil then DoDrawKey(Canvas, k);
  end;
end;

procedure TOnScreenKeyboard.SetShiftState(const Value: TExtShiftState);
begin
  if FShiftState <> Value then
  begin
    FShiftState := Value;
    Invalidate;
  end;
end;

procedure TOnScreenKeyboard.SetTransparent(const Value: Boolean);
begin
  FTransparent := Value;
  if HandleAllocated then Invalidate;
end;

procedure TOnScreenKeyboard.SetUnderlyingLayout(const Value: THandle);
var
  i: Integer;
  FLastKeyboardLayout: Cardinal;
begin
  if FUnderlyingLayout <> Value then
  begin
    FUnderlyingLayout := Value;

    FLastKeyboardLayout := GetKeyboardLayout(0);
    if FLastKeyboardLayout <> FUnderlyingLayout then   // I4363   // I4415
    begin
      if FLoadedKeyboardLayout <> 0 then
        UnloadKeyboardLayout(FLoadedKeyboardLayout);

      if ActivateKeyboardLayout(FUnderlyingLayout, KLF_NOTELLSHELL) = 0
        then FLoadedKeyboardLayout := LoadKeyboardLayout(IntToHex(FUnderlyingLayout,8), KLF_ACTIVATE or KLF_NOTELLSHELL)
        else FLoadedKeyboardLayout := 0;
    end;

    for i := 0 to FKeys.Count - 1 do
      FKeys[i].UpdateKeyCap;

    UpdateEuroLayout;

    CalcKeyFontSizes;

    if HKLToKeyboardID(FLastKeyboardLayout) <> FUnderlyingLayout then   // I4363
      ActivateKeyboardLayout(FLastKeyboardLayout, KLF_NOTELLSHELL);

    FKeys.FillVKeys;
  end;
end;

procedure TOnScreenKeyboard.UpdateEuroLayout;
var
  k102, kbackslash: UINT;
  Value: Boolean;
begin
  if GetKeyboardType(0) in [1,2,3,4] then  // I764
  begin
    k102 := MapVirtualKeyExW($56, 1, FUnderlyingLayout);
    kbackslash := MapVirtualKeyExW($2b, 1, FUnderlyingLayout);

    if k102 <> 0 then k102 := MapVirtualKeyExW(k102, 2, FUnderlyingLayout);
    if kbackslash <> 0 then kbackslash := MapVirtualKeyExW(kbackslash, 2, FUnderlyingLayout);

    Value := (kbackslash <> k102) and (k102 <> 0);
  end
  else
    Value := False;

  if FEuroLayout <> Value then
  begin
    FEuroLayout := Value;
    Resize102Key;
  end;
end;

procedure TOnScreenKeyboard.ShiftChange;
begin
  if Assigned(FOnShiftChange) then
    FOnShiftChange(Self);
end;

procedure TOnScreenKeyboard.Invalidate;
begin
  if FUpdateLevel > 0 then
    FUpdateInvalidate := True
  else
    inherited Invalidate;
end;

procedure TOnScreenKeyboard.InvalidateKey(Key: TOnScreenKeyboardKey);
var
  r: TRect;
begin
  if not Assigned(key) then Exit;

  r := Rect(Key.FX, Key.FY, Key.FX+Key.FW, Key.FY+Key.FH);
  InvalidateRect(Handle, @r, False);
end;

procedure TOnScreenKeyboard.InvalidateShift(ShiftState: TExtShiftState);
begin
  if essShift in ShiftState then
  begin
    InvalidateKey(Keys.ItemsByKeyType[kktShiftLeft]);
    InvalidateKey(Keys.ItemsByKeyType[kktShiftRight]);
  end;

  if [essCtrl, essLCtrl] * ShiftState <> [] then InvalidateKey(Keys.ItemsByKeyType[kktCtrlLeft]);
  if [essCtrl, essRCtrl] * ShiftState <> [] then InvalidateKey(Keys.ItemsByKeyType[kktCtrlRight]);
  if [essAlt, essLAlt] * ShiftState <> [] then InvalidateKey(Keys.ItemsByKeyType[kktAltLeft]);
  if [essAlt, essRAlt] * ShiftState <> [] then InvalidateKey(Keys.ItemsByKeyType[kktAltRight]);
end;

procedure TOnScreenKeyboard.KeyPressed(Key: TOnScreenKeyboardKey);
begin
  if Assigned(FOnKeyPressed) then
    FOnKeyPressed(Self, Key);
end;

function TOnScreenKeyboard.GetKeyAtPoint(X, Y: Integer): TOnScreenKeyboardKey;
var
  i: Integer;
begin
  for i := 0 to FKeys.Count - 1 do
  begin
    with FKeys[i] do
      if PtInRect(KeyRect, Point(X, Y)) and (FDisplay102Key or FEuroLayout or (FKeys[i] <> F102Key)) then
      begin
        Result := FKeys[i];
        Exit;
      end;
  end;
  Result := nil;
end;

var
  FRunningNT: Boolean = False;
  FScanCodeDecimal: Integer = 0;

procedure TOnScreenKeyboard.MapScanCodes(FScanCode: Integer; var Values: array of WideString; var vkey: Integer);
var
  //vk: Integer;
  //hUser32: THandle;
  buf: array[0..9] of WideChar;
  keystate: TKeyboardState;
  n: Integer;
  i: Integer;

    procedure SetKeyStateFromShiftState(FShiftState: TExtShiftState);
    const
      ShiftStateValues: array[TExtShiftStateValue] of Integer = (VK_SHIFT, VK_CONTROL, VK_MENU, VK_LCONTROL, VK_RCONTROL, VK_LMENU, VK_RMENU);
    var
      i: TExtShiftStateValue;
    begin
      if essRAlt in FShiftState then
        FShiftState := FShiftState - [essRalt] + [essCtrl, essAlt];
      for i := Low(i) to High(i) do
        if i in FShiftState
          then keystate[ShiftStateValues[i]] := $80;
    end;

    procedure ClearKeyboardBuffer;
    var
      keystate: TKeyboardState;
    begin
      FillChar(keystate, sizeof(TKeyboardState), 0);  // I3309
      while not ToUnicodeEx(VK_DECIMAL, FScanCodeDecimal, keystate, buf, 10, 0, FUnderlyingLayout) in [0, 1] do;  // I3309
    end;

begin
  if FScanCodeDecimal = 0 then
    FScanCodeDecimal := MapVirtualKeyEx(VK_DECIMAL, 0, FUnderlyingLayout);

  vkey := MapVirtualKeyEx(FScanCode, 1, FUnderlyingLayout);  // I3309
  //ch := FMapVirtualKeyEx(vk, 2, FUnderlyingLayout);

  for i := Low(Values) to High(Values) do
  begin
    FillChar(keystate, sizeof(TKeyboardState), 0);  // I3309
    SetKeyStateFromShiftState(ValidExtShiftStates[i]);

    n := ToUnicodeEx(vkey, FScanCode, keystate, buf, 10, 0, FUnderlyingLayout);  // I3309
    case n of
      -1: Values[i] := Copy(buf, 1, 1);
      0: Values[i] := '';
      else Values[i] := Copy(buf, 1, n);
    end;
    if n < 0 then ClearKeyboardBuffer;
  end;
end;

procedure TOnScreenKeyboard.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  k: TOnScreenKeyboardKey;
begin
  if Button = mbLeft then
  begin
    k := GetKeyAtPoint(X, Y);
    if Assigned(k) and k.Enabled then
    begin
      FHoverKey := k;
      FDownKey := k;
      FIsDown := True;
      DoDrawKey(Canvas, FDownKey);//InvalidateKey(FDownKey);
    end;
  end;
end;

procedure TOnScreenKeyboard.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  k, k2: TOnScreenKeyboardKey;
begin
  k := GetKeyAtPoint(X, Y);
  if k <> FHoverKey then
  begin
    if FIsDown then
    begin
      if k = FDownKey
        then FHoverKey := k
        else FHoverKey := nil;
      DoDrawKey(Canvas, FDownKey);
    end
    else
    begin
      k2 := FHoverKey;
      if Assigned(k) and not k.Enabled then k := nil;

      FHoverKey := k;
      DoDrawKey(Canvas, k); //InvalidateKey(k);
      DoDrawKey(Canvas, k2); //InvalidateKey(k2);
      Update;
    end;
  end;
end;

procedure TOnScreenKeyboard.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  k, k2: TOnScreenKeyboardKey;
  ess: TExtShiftStateValue;
begin
  if FIsDown then
  begin
    FIsDown := False;
    k := GetKeyAtPoint(X, Y);
    if k = FDownKey then
    begin
      case k.KeyType of
        kktNormal:
          begin
            if SelectMode then
            begin
              k2 := FSelectedKey;
              FSelectedKey := k;
              if k2 <> nil then DoDrawKey(Canvas, k2);
              SelectionChange;
            end
            else
              KeyPressed(k);
          end;
        kktShiftLeft, kktCtrlLeft, kktAltLeft, kktShiftRight, kktCtrlRight, kktAltRight:
          begin
            ess := KeyTypeToExtShiftStateValue(k.KeyType, FLRShift);
            if FLRShift then
              case ess of
                essLCtrl: Exclude(FShiftState, essRCtrl);
                essRCtrl: Exclude(FShiftState, essLCtrl);
                essLAlt: Exclude(FShiftState, essRAlt);
                essRAlt: Exclude(FShiftState, essLAlt);
              end;

            if ess in FShiftState
              then Exclude(FShiftState, ess)
              else Include(FShiftState, ess);

            InvalidateShift([KeyTypeToExtShiftStateValue(k.KeyType, False)]);

            ShiftChange;
          end;
        else //kktTab, kktCaps, kktBackSpace, kktEnter:
          // later, fire the keystroke
          KeyPressed(k);
          ;
      end;
    end;
    k := FDownKey;
    FDownKey := nil;
    if k <> nil then DoDrawKey(Canvas, k); //InvalidateKey(k);
    if (k <> FSelectedKey) and (FSelectedKey <> nil) then DoDrawKey(Canvas, FSelectedKey); //InvalidateKey(FSelectedKey);
  end;
end;

procedure TOnScreenKeyboard.SetDisableExtendedKeys(const Value: Boolean);
begin
  if FDisableExtendedKeys <> Value then
  begin
    FDisableExtendedKeys := Value;
    Keys.ItemsByKeyType[kktTab].Enabled := not Value;
    Keys.ItemsByKeyType[kktCaps].Enabled := not Value;
    Keys.ItemsByKeyType[kktEnter].Enabled := not Value;
    Keys.ItemsByKeyType[kktBackSpace].Enabled := not Value;
  end;
end;

procedure TOnScreenKeyboard.FillBkRect(HDC: THandle; r: TRect);
var
  hbr: Cardinal;
begin
  if FTransparent then
  begin
    BitBlt(HDC, r.Left, r.Top, r.Right - r.Left,
      r.Bottom - r.Top, FBackgroundBitmap.Canvas.Handle, r.Left, r.Top,
      SRCCOPY);
    //Canvas.CopyRect(r, FBackgroundBitmap.Canvas, r);
  end
  else
  begin
    hbr := CreateSolidBrush(ColorToRGB(Color));
    FillRect(HDC, r, hbr);
    DeleteObject(hbr);
    //Canvas.Brush.Color := Color;
    //Canvas.FillRect(r);
  end;
end;

procedure TOnScreenKeyboard.SetDisplay102Key(const Value: Boolean);
begin
  if FDisplay102Key <> Value then
  begin
    FDisplay102Key := Value;
    Resize102Key;
  end;
end;

procedure TOnScreenKeyboard.Resize102Key;
var
  k: TOnScreenKeyboardKey;
  r: TRect;
begin
  k := FKeys.ItemsByKeyType[kktShiftLeft];
  if not FDisplay102Key and not FEuroLayout
    then k.FDefaultPos.Right := F102Key.FDefaultPos.Right
    else k.FDefaultPos.Right := F102Key.FDefaultPos.Left - 2;
  k.FW := Trunc(FScale*(k.FDefaultPos.Right))-k.FX;

  ResizeKeys;

  if HandleAllocated then
  begin
    if FDisplay102Key or FEuroLayout then
    begin
      r := Rect(k.FX, k.FY, F102Key.FX+F102Key.FW, F102Key.FY+F102Key.FH);
      FillBkRect(Canvas.Handle, r);
    end;
    DoDrawKey(Canvas, k);
    DoDrawKey(Canvas, F102Key);
  end;
end;

procedure TOnScreenKeyboard.SetDisplayUnderlyingChar(const Value: Boolean);
begin
  FDisplayUnderlyingChar := Value;
  Invalidate;
end;

procedure TOnScreenKeyboard.SetLargeCapFont(const Value: Boolean);
begin
  FLargeCapFont := Value;
  Invalidate;
end;

procedure TOnScreenKeyboard.SetLRShift(const Value: Boolean);
var
  FChanged: Boolean;
begin
  FLRShift := Value;
  FChanged := False;

  if FLRShift then
  begin
    if essCtrl in FShiftState then
    begin
      FShiftState := FShiftState - [essCtrl] + [essLCtrl];
      FChanged := True;
    end;

    if essAlt in FShiftState then
    begin
      FShiftState := FShiftState - [essAlt] + [essLAlt];
      FChanged := True;
    end;

    {FKeys.ItemsByKeyType[kktCtrlLeft].KeyCaps[0] := 'L Ctrl';
    FKeys.ItemsByKeyType[kktCtrlRight].KeyCaps[0] := 'R Ctrl';
    FKeys.ItemsByKeyType[kktAltLeft].KeyCaps[0] := 'L Alt';
    FKeys.ItemsByKeyType[kktAltRight].KeyCaps[0] := 'R Alt';}
  end
  else
  begin
    if (essLCtrl in FShiftState) or (essRCtrl in FShiftState) then
    begin
      FShiftState := FShiftState - [essLCtrl, essRCtrl] + [essCtrl];
      FChanged := True;
    end;

    if (essLAlt in FShiftState) or (essRAlt in FShiftState) then
    begin
      FShiftState := FShiftState - [essLAlt, essRAlt] + [essAlt];
      FChanged := True;
    end;

    {FKeys.ItemsByKeyType[kktCtrlLeft].KeyCaps[0]:= 'Ctrl';
    FKeys.ItemsByKeyType[kktCtrlRight].KeyCaps[0] := 'Ctrl';
    FKeys.ItemsByKeyType[kktAltLeft].KeyCaps[0] := 'Alt';
    FKeys.ItemsByKeyType[kktAltRight].KeyCaps[0] := 'Alt';}
  end;

  if FChanged then
  begin
    { update shift state ... }
    InvalidateShift([essCtrl]);
    InvalidateShift([essAlt]);
    //ShiftChange;
  end;
end;

procedure TOnScreenKeyboard.Paint;
var
  i: Integer;
  FClipped: Boolean;
  r: TRect;
begin
  FClipped := not IsRectEmpty(Canvas.ClipRect);
  for i := 0 to FKeys.Count - 1 do
    if not FClipped or IntersectRect(r, Canvas.ClipRect, FKeys[i].KeyRect) then
      DoDrawKey(FBufferBitmap.Canvas, FKeys[i]);
  if FClipped then
    with Canvas.ClipRect do
      BitBlt(Canvas.Handle, Left, Top, Right-Left, Bottom-Top, FBufferBitmap.Canvas.Handle, Left, Top, SRCCOPY)
  else
    BitBlt(Canvas.Handle, 0, 0, Width, Height, FBufferBitmap.Canvas.Handle, 0, 0, SRCCOPY);

  FBufferBitmap.ReleaseCanvas;
end;

procedure TOnScreenKeyboard.Resize;
begin
  inherited;
  FBackgroundBitmap.Free;
  FBackgroundBitmap := TQuickBitmap.Create(Width, Height);
  //FBackgroundBitmap.Width := Width;
  //FBackgroundBitmap.Height := Height;
  FBufferBitmap.Free;
  FBufferBitmap := TQuickBitmap.Create(Width, Height);
  //FBufferBitmap.Width := Width;
  //FBufferBitmap.Height := Height;
  ResizeKeys;
end;

procedure TOnScreenKeyboard.ResizeKeys;
var
  i: Integer;
  cx, cy, dx, dy: Integer;
  ox, oy: Integer;
begin

  cx := Width;
  cy := Height;

  with FKeys.ItemsByKeyType[kktCtrlRight] do
  begin
    dx := FDefaultPos.Right;
    dy := FDefaultPos.Bottom;
  end;

  if (cx/dx) > (cy/dy) then
  begin
    // y constrains
    FScale := cy / dy;
    oy := 0;
    ox := Trunc(cx - FScale * dx) div 2;
  end
  else
  begin
    // x constrains
    FScale := cx / dx;
    oy := Trunc(cy - FScale * dy) div 2;
    ox := 0;
  end;

  for i := 0 to FKeys.Count - 1 do
  begin
    with FKeys[i], FDefaultPos do
    begin
      if FScanCode = $2B then	// I3021
        FKeys[i].FDefaultPos.Right := 42 + FKeys[i].FDefaultPos.Left;  // I3021

      FX := Trunc(FScale*Left) + ox;
      FY := Trunc(FScale*Top) + oy;
      FW := Trunc(FScale*(Right))-FX + ox;
      FH := Trunc(FScale*(Bottom))-FY + oy;

      if FEuroLayout then
      begin
        if FScanCode = $2B then
        begin
          FX := Trunc(FScale * 432) + ox;
          FY := Trunc(FScale * 68) + oy;
          FW := Trunc(FScale * 33);
          FKeys[i].FDefaultPos.Right := 33 + FKeys[i].FDefaultPos.Left;  // I3021
        end
        else if FKeyType = kktEnter then
        begin
          FX := Trunc(FScale * 458) + ox;
          FY := Trunc(FScale * 34) + oy;
          FX2 := Trunc(FScale * (432+34)) + ox;
          FY2 := Trunc(FScale * (34+33)) + oy;
          FW := Trunc(FScale * 42);
          FH := Trunc(FScale * 67);
        end;
      end;
    end;
  end;

  CalcKeyFontSizes;

  if HandleAllocated then
    InvalidateRect(Handle, nil, True);
end;

{ TOnScreenKeyboardKeys }

procedure TOnScreenKeyboardKeys.ClearValues;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
  begin
    Items[i].KeyValue := '';
    Items[i].KeyGlyph := nil;
  end;
end;

procedure TOnScreenKeyboardKeys.FillVKeys;
var
  i: Integer;
begin
  for i := Low(FVKeys) to High(FVKeys) do FVKeys[i] := nil;
  for i := Low(FUSVKeys) to High(FUSVKeys) do FVKeys[i] := nil;

  for i := 0 to Count - 1 do
  begin
    if Items[i].VKey > 0 then
      FVKeys[Items[i].VKey] := Items[i];
    if Items[i].USVKey > 0 then
      FUSVKeys[Items[i].USVKey] := Items[i];
  end;
end;

function TOnScreenKeyboardKeys.GetItem(Index: Integer): TOnScreenKeyboardKey;
begin
  Result := inherited GetItem(Index) as TOnScreenKeyboardKey;
end;

function TOnScreenKeyboardKeys.GetItemByKeyType(
  Index: TOnScreenKeyboardKeyType): TOnScreenKeyboardKey;
var
  i: Integer;
begin
  if FKeysByType[Index] = nil then
  begin
    for i := 0 to Count - 1 do
      if Items[i].KeyType <> kktNormal then
        FKeysByType[Items[i].KeyType] := Items[i];
  end;
  Result := FKeysByType[Index];
end;

function TOnScreenKeyboardKeys.GetItemByUSVK(
  Index: Integer): TOnScreenKeyboardKey;
begin
  Assert((Index >= 0) and (Index <= 255));
  Result := FUSVKeys[Index];
end;

function TOnScreenKeyboardKeys.GetItemByVK(Index: Integer): TOnScreenKeyboardKey;
begin
  Assert((Index >= 0) and (Index <= 255));
  Result := FVKeys[Index];
end;

function TOnScreenKeyboardKeys.GetItemsByKeyCap(
  Index: WideChar; Shift: Integer): TOnScreenKeyboardKey;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if Items[i].KeyCaps[Shift] = Index then
    begin
      Result := Items[i];
      Exit;
    end;
  Result := nil;
end;

function TOnScreenKeyboardKeys.GetItemsByScanCode(
  Index: Integer): TOnScreenKeyboardKey;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if Items[i].ScanCode = Index then
    begin
      Result := Items[i];
      Exit;
    end;
  Result := nil;
end;

{ TOnScreenKeyboardKey }

function TOnScreenKeyboardKey.CalcFontSize(Canvas: TCanvas): Integer;
var
  ARect: TRect;
  R: TRect;
begin
  Result := 0;
  with Canvas do
  begin
    if FKeyType = kktNormal then Exit;

    Font.Size := Trunc(OnScreen_KeyBitmap.Parameters.CapFontSize*FKeyboard.FScale);
    FKeyboard.FDrawChar.SetFontDetails(Font.Name, Font.Height);

    R := Rect(FX, FY, FX+FW, FY+FH);

    with OnScreen_KeyBitmap.Parameters.TextRect[0] do
    begin
      ARect := Rect(R.Left+Trunc(Left*FKeyboard.FScale), R.Top+Trunc(1*FKeyboard.FScale),
        R.Left+Trunc(Right*FKeyboard.FScale), R.Top+FH);

      if FKeyType <> kktNormal then
        ARect.Right := R.Right - 4;
    end;

    //Result := TextWidth(FKeyCaps[0]);
    Result := FKeyboard.FDrawChar.CalcTextSize(Handle, ARect, FKeyCaps[0]);
  end;
end;

constructor TOnScreenKeyboardKey.Create(AKeyboard: TOnScreenKeyboard;
  AData: TOnScreenKeyboardKeyData);
begin
  inherited Create;
  FData := AData;   // I3945
  FEnabled := True;
  FKeyboard := AKeyboard;
  FDefaultPos := Rect(AData.X, AData.Y, AData.X+AData.Width, AData.Y+33);
  FX := AData.X; FY := AData.Y; FW := AData.Width; FH := 33;
  FScanCode := AData.ScanCode;
  FKeyType := AData.KeyType;
  UpdateKeyCap;
end;

destructor TOnScreenKeyboardKey.Destroy;
begin
  FreeAndNil(FKeyGlyph);
  inherited Destroy;
end;

procedure
 TransparentStretchBlt2(hDC: HDC; left, top, width, height: Integer; hBitmap: THandle; bmLeft, bmTop, bmWidth, bmHeight: Integer; colorMask: TColor);
var
  hMemDC, hStretchDC, hMaskDC: THandle;
  hStretchBm, hMaskBm, hOldMemBm, hOldStretchBm, hOldMaskBm: THandle;
  oldColor: COLORREF;
begin
    // Create the memory DC's.
    hMemDC := CreateCompatibleDC(hDC);
    hStretchDC := CreateCompatibleDC(hDC);
    hMaskDC := CreateCompatibleDC(hDC);

    // Create the bitmaps needed for the memory DC's.
    hStretchBm := CreateCompatibleBitmap(hDC, width, height);
    hMaskBm := CreateBitmap(width, height, 1, 1, nil);

    // Select the bitmaps into the memory DC's.
    hOldMemBm := SelectObject(hMemDC, hBitmap);
    hOldStretchBm := SelectObject(hStretchDC, hStretchBm);
    hOldMaskBm := SelectObject(hMaskDC, hMaskBm);

    // StretchBlt to a colored DC.
    StretchBlt(hStretchDC, 0, 0, width, height,
               hMemDC, bmLeft, bmTop, bmWidth, bmHeight, SRCCOPY);

    // BitBlt to a monochrome DC.
    oldColor := SetBkColor(hStretchDC, colorMask and $FFFFFF);
    BitBlt(hMaskDC, 0, 0, width, height,
           hStretchDC, 0, 0, SRCCOPY);
    SetBkColor(hStretchDC, oldColor);

    // Transparent BitBlt technique.
    BitBlt(hDC, left, top, width, height,
           hMaskDC, 0, 0, SRCAND);
    BitBlt(hDC, left, top, width, height,
           hStretchDC, 0, 0, SRCPAINT);

    // Restore the memory DC's.
    SelectObject(hMemDC, hOldMemBm);
    SelectObject(hStretchDC, hOldStretchBm);
    SelectObject(hMaskDC, hOldMaskBm);

    // Delete the allocated bitmaps.
    DeleteObject(hStretchBm);
    DeleteObject(hMaskBm);

    // Delete the allocated memory DC's.
    DeleteDC(hMemDC);
    DeleteDC(hStretchDC);
    DeleteDC(hMaskDC);
end;

procedure TOnScreenKeyboardKey.DrawKey(DestCanvas: TCanvas; FIsDown, FIsHover, FIsSelected: Boolean);
var
  ARect, RGlyph, R: TRect;

  procedure DrawKeyBitmap(Canvas: TCanvas);
      function CompareRect(r1, r2: TRect): Boolean;
      begin
        Result := (r1.Left = r2.Left) and (r1.Top = r2.Top) and (r1.Right = r2.Right) and (r1.Bottom = r2.Bottom);
      end;

  var
    bIndex, n: Integer;
    ssi: Integer;
    Save: THandle;
    MaskDC: THandle;
    s: string;
    FTextExtent: TSize;
    tm: TTextMetric;
    BaseLineHeight: Integer;
    RText: TRect;
  begin
    if Enabled then
    begin
      bIndex := 0;
      if FIsDown and FIsHover then bIndex := bIndex or 1;
      if FIsSelected then bIndex := bIndex or 2;
      if FIsHover and not FIsDown then bIndex := bIndex or 4;
      if FKeyType <> kktNormal then bIndex := bIndex or 8;
    end
    else
      bIndex := 16;

    if FIsDown and FIsHover then n := 1 else n := 0;

    if (FKeyType = kktEnter) and FKeyboard.FEuroLayout then
      DrawEuropeanEnterKeyParam(Canvas, OnScreen_KeyBitmap.Parameters.Border[n], R.Left, R.Top, FW, FH, bIndex, OnScreen_KeyBitmap.Bitmap,
        FX2, FY2)
    else
      DrawKeyParam(Canvas, OnScreen_KeyBitmap.Parameters.Border[n], R.Left, R.Top, FW, FH, bIndex, OnScreen_KeyBitmap.Bitmap);

    with Canvas, OnScreen_KeyBitmap.Parameters do
    begin
      SetBkMode(Handle, TRANSPARENT);

      Font := FKeyboard.Font;
      Font.Name := CapFont;

      //if FFontSize > 0 then
        //Font.Size := FFontSize
      //else
      if FKeyboard.FLargeCapFont and (FKeyType = kktNormal) then
        Font.Size := Trunc((TextRect[n].Top - TextRect[n].Bottom) * FKeyboard.FScale)
      else //if FKeyType = kktNormal then
        Font.Size := Trunc(CapFontSize*FKeyboard.FScale);

      if not Enabled then    Font.Color := KeyFontColor_Disabled   // I4098
      else if (FKeyType = kktNormal) and not FIsSelected then Font.Color := KeyFontColor_Base   // I4098
      else if FKeyType = kktNormal then Font.Color := KeyFontColor_BaseSelected   // I4098
      else Font.Color := KeyFontColor_Cap;   // I4098

      RText := TextRect[n]; // I2576
      RText.Right := FDefaultPos.Right - FDefaultPos.Left - (33 - RText.Right); // I2576 -  Adjust for key width

      with RText do
      begin
        ARect := Rect(R.Left+Trunc(Left*FKeyboard.FScale), R.Top+Trunc(1*FKeyboard.FScale),
          R.Left+Trunc(Right*FKeyboard.FScale), R.Top+FH);

        if FKeyType <> kktNormal then
          ARect.Right := R.Right - 4;
      end;

      if FKeyType <> kktNormal then
      begin
        s := FKeyCaps[0];
        Font.Size := FontSize;
        if (Abs(Font.Height) < 8) or (Abs(Font.Height) > 24) then
        begin
          Font.Height := Font.Height * 2 div 3;
          if Font.Height < 0 then
          begin
            if Font.Height > -8 then Font.Height := -8
          end
          else if Font.Height < 8 then Font.Height := 8;
        end;
        ARect.Top := ARect.Top + CapPos[n].Y;
        DrawText(Handle, PChar(s), Length(FKeyCaps[0]), ARect, DT_NOPREFIX or DT_WORDBREAK);
      end
      else if FKeyboard.FDisplayUnderlyingChar or (FKeyType <> kktNormal) then
      begin
        if FKeyType <> kktNormal
          then ssi := 0
          else ssi := ValidExtShiftStateIndex(FKeyboard.ShiftState);
        FKeyboard.FDrawChar.DisplayQuality := ctCleartype;
        FKeyboard.FDrawChar.Color := Font.Color;
        FKeyboard.FDrawChar.SetFontDetails(Font.Name, Font.Height);
        if ((FKeyCaps[ssi] = '') or (FKeyCaps[ssi][1] < #32)) and (ssi > 0) and (FKeyType = kktNormal) and Enabled then
        begin
          FKeyboard.FDrawChar.Color := $B0B0B0;
          FKeyboard.FDrawChar.DrawText(Handle, TA_LEFT or TA_TOP, R.Left+Trunc(CapPos[n].X*FKeyboard.FScale),
            R.Top+Trunc(CapPos[n].Y*FKeyboard.FScale), ARect, FKeyCaps[0]);
        end
        else
          FKeyboard.FDrawChar.DrawText(Handle, TA_LEFT or TA_TOP, R.Left+Trunc(CapPos[n].X*FKeyboard.FScale),
            R.Top+Trunc(CapPos[n].Y*FKeyboard.FScale), ARect, FKeyCaps[ssi]);
        //ExtTextOutW(Handle, R.Left+Trunc(CapPos[n].X*FKeyboard.FScale), R.Top+Trunc(CapPos[n].Y*FKeyboard.FScale), 0, @ARect, PWideChar(FKeyCap), Length(FKeyCap), nil);
      end;

      if Assigned(FKeyGlyph) and not FKeyGlyph.Empty then
      begin
        // image is anchored to
        RGlyph := Rect(
          R.Left+Trunc(RText.Right*FKeyboard.FScale) - Trunc(FKeyGlyph.Width*FKeyboard.FScale),  // I2576
          R.Top+Trunc(RText.Bottom*FKeyboard.FScale) - Trunc(FKeyGlyph.Height*FKeyboard.FScale),
          R.Left+Trunc(RText.Right*FKeyboard.FScale),
          R.Top+Trunc(RText.Bottom*FKeyboard.FScale));

          if RGlyph.Right - RGlyph.Left > (RText.Right - RText.Left) * FKeyboard.FScale then
          begin
            RGlyph.Top := RGlyph.Bottom - Trunc((RGlyph.Bottom - RGlyph.Top) * ((RText.Right-RText.Left)*FKeyboard.FScale) / (RGlyph.Right - RGlyph.Left));
            RGlyph.Left := R.Left + Trunc(RText.Left * FKeyboard.FScale);
          end;

          if RGlyph.Bottom - RGlyph.Top > (RText.Bottom - RText.Top) * FKeyboard.FScale then
          begin
            RGlyph.Left := RGlyph.Right - Trunc((RGlyph.Right - RGlyph.Left) * ((RText.Bottom-RText.Top)*FKeyboard.FScale) / (RGlyph.Bottom - RGlyph.Top));
            RGlyph.Top := R.Top + Trunc(RText.Top * FKeyboard.FScale);
          end;

          SetStretchBltMode(Handle, HALFTONE);
          SetBrushOrgEx(Handle, 0, 0, nil);
          FKeyGlyph.TransparentMode := tmAuto;
          FKeyGlyph.Transparent := True;
          FKeyGlyph.PixelFormat := pf24Bit;


          Save := 0;
          MaskDC := 0;
          try
            MaskDC := CreateCompatibleDC(0);
            Save := SelectObject(MaskDC, FKeyGlyph.MaskHandle);
            TransparentStretchBlt(Handle, RGlyph.Left, RGlyph.Top, RGlyph.Right - RGlyph.Left,
              RGlyph.Bottom - RGlyph.Top, FKeyGlyph.Canvas.Handle, 0, 0, FKeyGlyph.Width,
              FKeyGlyph.Height, MaskDC, 0, 0);
          finally
            if Save <> 0 then SelectObject(MaskDC, Save);
            if MaskDC <> 0 then DeleteDC(MaskDC);
          end;
          //StretchDraw(RGlyph, FKeyGlyph);
        //Draw(R.Left+CapPos[n].X-FKeyGlyph.Width, R.Top+CapPos[n].Y-FKeyGlyph.Height, FKeyGlyph);
      end
      else
      begin
        Font := FKeyboard.FDataFont;
        Font.Height := Trunc((RText.Top - RText.Bottom) * FKeyboard.FScale);  // I2576

        FillChar(tm, Sizeof(tm), 0);  // I2576
        GetTextMetrics(Canvas.Handle, tm);
        BaseLineHeight := tm.tmDescent;

        if GetTextExtentPoint32W(Canvas.Handle, PWideChar(FKeyValue), Length(FKeyValue), FTextExtent) then  // I2576
        begin
          if (FTextExtent.cx > (RText.Right - RText.Left) * FKeyboard.FScale) or
            (FTextExtent.cy > (RText.Bottom - RText.Top) * FKeyboard.FScale) then
          begin
            // font.height may be either positive or negative, depending on whether
            // internal leading is included. It doesn't matter, so long as we keep
            // the same factor.
            if Font.Height < 0 then
              Font.Height := System.Math.Max(
                Trunc(Font.Height * (RText.Right - RText.Left) * FKeyboard.FScale / FTextExtent.cx),
                Trunc(Font.Height * (RText.Bottom - RText.Top) * FKeyboard.FScale / FTextExtent.cy)
              )
            else
              Font.Height := System.Math.Min(
                Trunc(Font.Height * (RText.Right - RText.Left) * FKeyboard.FScale / FTextExtent.cx),
                Trunc(Font.Height * (RText.Bottom - RText.Top) * FKeyboard.FScale / FTextExtent.cy)
              );
          end;
        end;

        // TODO: in future re-scale the font here per designer's preference
        //       but this requires a file format change, so a much bigger scope

        if not Enabled then      Font.Color := $808080
        else                     Font.Color := KeyFontColor_Cap;

        FKeyboard.FDrawChar.DisplayQuality := ctCleartype;
        FKeyboard.FDrawChar.Color := Font.Color;
        FKeyboard.FDrawChar.SetFontDetails(Font.Name, Font.Height);

        FKeyboard.FDrawChar.DrawText(Handle, TA_RIGHT or TA_BASELINE, R.Left+Trunc(RText.Right*FKeyboard.FScale),  // I2576
          R.Top+Trunc(RText.Bottom*FKeyboard.FScale)-BaseLineHeight, ARect, FKeyValue, False, True);
        //GetTextExtentPoint32W(Handle, PWideChar(FKeyValue), Length(FKeyValue), sz);
        //ExtTextOutW(Handle, ETO_CLIPPED, @ARect, PWideChar(FKeyValue), Length(FKeyValue), nil);
      end;
    end;
  end;

begin
  //FKeyboard.FBufferBitmap.SetSize(FW, FH);

  R := Rect(FX, FY, FX+FW, FY+FH);

  if (FKeyType = kktEnter) and FKeyboard.FEuroLayout then
  begin
    if FKeyboard.FTransparent then
    begin
      BitBlt(FKeyboard.FBufferBitmap.Canvas.Handle, FX, FY, FW, FY2-FY, FKeyboard.FBackgroundBitmap.Canvas.Handle, FX, FY, SRCCOPY);
      BitBlt(FKeyboard.FBufferBitmap.Canvas.Handle, FX2, FY2, FW-(FX2-FX), FH-(FY2-FY), FKeyboard.FBackgroundBitmap.Canvas.Handle, FX2, FY2, SRCCOPY);
    end
    else
    begin
      FKeyboard.FBufferBitmap.Canvas.Brush.Color := FKeyboard.Color;
      FKeyboard.FBufferBitmap.Canvas.FillRect(Rect(FX, FY, FX+FW, FY2));
      FKeyboard.FBufferBitmap.Canvas.FillRect(Rect(FX2, FY2, FX+FW, FY+FH));
    end;

    DrawKeyBitmap(FKeyboard.FBufferBitmap.Canvas);
    if DestCanvas <> FKeyboard.FBufferBitmap.Canvas then
    begin
      BitBlt(DestCanvas.Handle, FX, FY, FW, FY2-FY, FKeyboard.FBufferBitmap.Canvas.Handle, FX, FY, SRCCOPY);
      BitBlt(DestCanvas.Handle, FX2, FY2, FW-(FX2-FX), FH-(FY2-FY), FKeyboard.FBufferBitmap.Canvas.Handle, FX2, FY2, SRCCOPY);
    end;
  end
  else
  begin
    if FKeyboard.FTransparent then
      BitBlt(FKeyboard.FBufferBitmap.Canvas.Handle, FX, FY, FW, FH, FKeyboard.FBackgroundBitmap.Canvas.Handle, FX, FY, SRCCOPY)
    else
    begin
      FKeyboard.FBufferBitmap.Canvas.Brush.Color := FKeyboard.Color;
      FKeyboard.FBufferBitmap.Canvas.FillRect(R);
    end;

    DrawKeyBitmap(FKeyboard.FBufferBitmap.Canvas);
    if DestCanvas <> FKeyboard.FBufferBitmap.Canvas then
      BitBlt(DestCanvas.Handle, FX, FY, FW, FH, FKeyboard.FBufferBitmap.Canvas.Handle, FX, FY, SRCCOPY);
  end;
end;

function TOnScreenKeyboardKey.GetActiveKeyCap: WideString;
begin
  Result := FKeyCaps[ValidExtShiftStateIndex(FKeyboard.ShiftState)];
end;

function TOnScreenKeyboardKey.GetKeyCap(Index: Integer): WideString;
begin
  Assert((Index >= Low(FKeyCaps)) and (Index <= High(FKeyCaps)));
  Result := FKeyCaps[Index];
end;

function TOnScreenKeyboardKey.GetKeyRect: TRect;
begin
  Result := Rect(FX, FY, FX+FW, FY+FH);
end;

procedure TOnScreenKeyboardKey.SetEnabled(const Value: Boolean);
begin
  FEnabled := Value;
  FKeyboard.DoDrawKey(FKeyboard.Canvas, Self); //InvalidateKey(Self);
end;

procedure TOnScreenKeyboardKey.SetKeyCap(Index: Integer; Value: WideString);
begin
  FKeyCaps[Index] := Value;
  FKeyboard.DoDrawKey(FKeyboard.Canvas, Self); //FKeyboard.InvalidateKey(Self);
end;

procedure TOnScreenKeyboardKey.SetKeyGlyph(const Value: TBitmap);
begin
  if Assigned(Value) then
  begin
    if not Assigned(FKeyGlyph) then FKeyGlyph := TBitmap.Create;
    FKeyGlyph.Assign(Value);
  end
  else
    FreeAndNil(FKeyGlyph);
  Invalidate;
end;

procedure TOnScreenKeyboardKey.SetKeyValue(Value: WideString);
begin
  FKeyValue := Value;
  FKeyboard.DoDrawKey(FKeyboard.Canvas, Self); //Invalidate;
end;

procedure TOnScreenKeyboardKey.UpdateKeyCap;
var
  lParam: Integer;
  bufW: array[0..64] of WideChar;
begin
  if FKeyType <> kktNormal then
  begin
    lParam := FScanCode shl 16;
    if FKeyType in [kktCtrlRight, kktAltRight] then
      lParam := lParam or (1 shl 24);

    if GetKeyNameText(lParam, bufW, 64) = 0 then FKeyCaps[0] := OnScreenKeyboardKeyTypeCaption[FKeyType]  // I3309
    else FKeyCaps[0] := bufW;

    FVKey := MapScanCodeToUSVK(FScanCode);
    FUSVKey := FVKey;
    //FKeyCaps[0] := OnScreenKeyboardKeyTypeCaption[FKeyType];
  end
  else
  begin
    FKeyboard.MapScanCodes(FScanCode, FKeyCaps, FVKey);
    FUSVKey := MapScanCodeToUSVK(FScanCode);
    //FVKey := MapScanCodeToVK(FScanCode);
  end;
end;

procedure TOnScreenKeyboardKey.Invalidate;
begin
  FKeyboard.InvalidateKey(Self);
end;

{ TQuickBitmap }

constructor TQuickBitmap.Create(AWidth, AHeight: Integer);
var
  FHDC: THandle;
begin
  inherited Create;
  FHDC := GetDC(0);
  FHandle := CreateCompatibleBitmap(FHDC, AWidth, AHeight);
  ReleaseDC(0, FHDC);
end;

destructor TQuickBitmap.Destroy;
begin
  ReleaseCanvas;
  DeleteObject(FHandle);
  inherited Destroy;
end;

function TQuickBitmap.GetCanvas: TCanvas;
begin
  if not Assigned(FCanvas) then
  begin
    FCanvas := TCanvas.Create;
    FCanvas.Handle := CreateCompatibleDC(0);
    FOldHBitmap := SelectObject(FCanvas.Handle, FHandle);
  end;
  Result := FCanvas;
end;

{function TQuickBitmap.GetHDC: THandle;
begin
  if FHDC = 0 then
  begin
    FHDC := CreateCompatibleDC(0);
    FOldHBitmap := SelectObject(FHDC, FHandle);
  end;
  Result := FHDC;
end;}

procedure TQuickBitmap.ReleaseCanvas;
var
  h: THandle;
begin
  if Assigned(FCanvas) then
  begin
    SelectObject(FCanvas.Handle, FOldHBitmap);
    h := FCanvas.Handle;
    FCanvas.Handle := 0;
    DeleteDC(h);
  end;
  FreeAndNil(FCanvas);
end;

{procedure TQuickBitmap.ReleaseDC;
begin
  if FHDC <> 0 then
  begin
    SelectObject(FHDC, FOldHBitmap);
    DeleteDC(FHDC);
    FHDC := 0;
  end;
end;}

end.