& pourquoi j’n’écrirais pas ça ?

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Keyboard, KeyboardTypes, Math;

type
  TTempTouchKeyboard = class(TCustomTouchKeyboard);
  TMyKeyboardButton  = class(TCustomKeyboardButton)
  public
    procedure Paint(Canvas: TCustomCanvas = nil); override;
  end;
type
  TfrmMain = class(TForm)
  TouchKeyboard1: TTouchKeyboard;
  procedure FormCreate(Sender: TObject);
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TMyKeyboardButton.Paint(Canvas: TCustomCanvas);
var
  LRect:    TRect;
  LCanvas:  TCanvas;
  LCaption: String;
const
  //TDrawState = (dsNormal, dsPressed, dsDisabled);
  acKeyColors: array[TDrawState] of TColor = (clWhite, clYellow, clGray);

  procedure DrawOneChar(rSize: TRect; cWhere: TCanvas; sWhat: string);
  begin
    rSize.Left := rSize.Left + (((rSize.Right-rSize.Left) - cWhere.TextWidth(sWhat)) div 2);
    rSize.Top := rSize.Top + (((rSize.Bottom-rSize.Top) - cWhere.TextHeight(sWhat)) div 2);

    cWhere.TextOut(rSize.Left, rSize.Top, sWhat);
  end;

  function GetOverrideCaption(Keyboard: TCustomTouchKeyboard; const Key: TVirtualKey; var Caption: string): Boolean;
  begin
    if Keyboard.CaptionOverrides.HasCaption(Key.PublishedName) then
    begin
      Caption := Keyboard.CaptionOverrides.GetCaption(Key.PublishedName);
      Exit(True);
    end
    else if Keyboard.CaptionOverrides.HasCaption(Key.PublishedName) then
    begin
      Caption := Keyboard.CaptionOverrides.GetCaption(Key.PublishedName);
      Exit(True);
    end;
    Result := False;
  end;

begin
  if Canvas <> nil then
    LCanvas := Canvas as TCanvas
  else
    LCanvas := TTempTouchKeyboard(Parent).Canvas;

  LRect := ClientRect;
  LCanvas.Font.Name   := 'Arial';
  LCanvas.Pen.Color   := clBlack;
  LCanvas.Font.Color  := clBlack;
  LCanvas.Font.Style  := [fsBold];
  LCanvas.Brush.Color := acKeyColors[State];
  LCanvas.Rectangle(LRect);

  case KeyImage of
    kiOverride:
    begin
      if not GetOverrideCaption(Parent, Key, LCaption) then
        LCaption := Caption;
      DrawOneChar(LRect, LCanvas, LCaption);
    end;
    kiText:
    begin
      if ((Length(Caption) > 0) and
        ((Caption[1] = '^') or (Caption[1] = '¨'))) then
        Caption := Caption[1];
      DrawOneChar(LRect, LCanvas, Caption);
    end;
    kiTab:       DrawOneChar(LRect, LCanvas, 'Tabulation');
    kiShift:     DrawOneChar(LRect, LCanvas, 'Majuscule');
    kiEnter:     DrawOneChar(LRect, LCanvas, 'Entrée');
    kiBackspace: DrawOneChar(LRect, LCanvas, '←');
    kiUp:        DrawOneChar(LRect, LCanvas, '↑');
    kiDown:      DrawOneChar(LRect, LCanvas, '↓');
    kiLeft:      DrawOneChar(LRect, LCanvas, '←');
    kiRight:     DrawOneChar(LRect, LCanvas, '→');
    kiTallEnter: DrawOneChar(LRect, LCanvas, 'Entrée');
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  TouchKeyboard1.DefaultButtonClass := TMyKeyboardButton;
  TTempTouchKeyboard(TouchKeyboard1).CreateKeyboard();
  TouchKeyboard1.Redraw;
end;

end.