Swanman's Horizon

性欲をもてあましつつなんらかの話をするよ。

TTouchKeyboardをいぢ(め)る。

2010買ったので何か2010っぽいことをやってみようとした結果がこれだよ!というわけで、とりあえず今回から新たに付属してるコンポーネントであるTTouchKeyboardの描画周りを弄ってみる。
TTouchKeyboardにはDrawingStyleやGradientStart(End)といったプロパティがあり、これを変えればキーの描画を変えられるように見えて実はキーではなく背景の描画が変わるだけという肩透かしっぷりで、実際に変えるにはKeyboardユニット内にあるTCustomKeyboardButtonクラスを継承し、Paintメソッドを自分で書いた上で、TTouchKeyboardのDefaultButtonClassにその継承したクラスをぶち込んでやる必要がある。
こう書くと、「なんだちゃんと独自描画の手段用意してるんじゃん」なんて思えるんだけど、Paintメソッドを自分で書く上で必要となるメソッドやプロパティの可視性がprivateだったりprotectedだったりして(簡単には)使えず、さらにはDefaultButtonClassにぶち込んだところですぐに描画が変わるわけでもなく(DefaultButtonClassプロパティのreadやwriteはアクセッサではなくただの変数指定なので)、TTouchKeyboardのCreateKeyboardメソッドを呼んで(その後Redrawで再描画)やらないといけないんだけど、これもprotectedと、本気で糞仕様。
けど、やってやれないことはないので、実際に書いてみたのが以下のコード。

type
  THogeKeyboardButton = class(TCustomKeyboardButton)
  public
    procedure Paint(Canvas: TCustomCanvas = nil); override; // 基本的にこれだけあればOK
  end;
  TTempTouchKeyboard = class(TCustomTouchKeyboard); // protectedなものにアクセスするために必要

procedure THogeKeyboardButton.Paint(Canvas: TCustomCanvas);
var
  LRect: TRect;
  LCanvas: TCanvas;
  LCaption: String;
const
  BGColors: array[TDrawState] of TColor = (clWhite, $000080FF, clGray);

  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
    // State <> TDrawState.dsNormalの時はnilが渡されるので、代わりに親Canvasを使う…がこれもprotected!Shit!
    LCanvas := TTempTouchKeyboard(Parent).Canvas;
  LRect := ClientRect;
  LCanvas.Pen.Color := clBlack;
  LCanvas.Font.Color := clBlack;
  LCanvas.Brush.Color := BGColors[State];
  LCanvas.Rectangle(LRect);
  case KeyImage of
    kiOverride:
    begin
      // 本当はParent.GetOverrideCaptionとすればいいんだけど、これに至ってはprivateでアクセス不可、死ねばいいのに
      if not GetOverrideCaption(Parent, Key, LCaption) then
        LCaption := Caption;
      LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, LCaption);
    end;
    kiText: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, Caption);
    // kiOverrideとkiText以外は面倒なのでテキスト描画
    kiTab: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, 'Tab');
    kiShift: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, 'Shift');
    kiEnter: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, 'Enter');
    kiBackspace: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, 'BS');
    kiUp: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, '↑');
    kiDown: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, '↓');
    kiLeft: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, '←');
    kiRight: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, '→');
    kiTallEnter: LCanvas.TextOut(LRect.Left + 4, LRect.Top + 4, 'Enter');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
  TouchKeyboard1.DefaultButtonClass := THogeKeyboardButton;
  // 本当は引数としてTouchKeyboard1.FLanguageを渡したいけど、privateでむりぽなので…
  // ちなみにLayoutプロパティを一旦違うのにして戻せばCreateKeyboard呼び出されるけど、それじゃ負けかなって
  TTempTouchKeyboard(TouchKeyboard1).CreateKeyboard('ja-JP');
  TouchKeyboard1.Redraw;
end;

その結果がこちら。

他にもTTouchKeyboardの大きさによっては右端のキーが欠けて描画されるだとか、CapsLockの実際の状態がどうなってるか考慮しておらず、キーの見た目と実際に入力される文字が異なる場合がある(まぁ物理キーボードとの併用は考えてないと言われればそれまでだけど)などのバグ(というか困った仕様というか)もあり、デフォルトのままでは使えても、ちょっと手を加えようと思うと非常に面倒で使えないコンポーネントなんでどうにかしてもらいたいところ。
ちなみにキー配列を変えるのはさらに面倒だったけど、それはまたいつか。