« FireMonkey小ネタ その2 | トップページ | チョコレートグラミー産卵&孵化 »

2011年10月21日 (金)

FireMonkeyでのショートカット(Windows)

以前の記事でWindowsのショートカットの動作にも問題があると書きましたが、解決法を上げるのを忘れてました。

私の見逃しかもしれませんが、FireMonkey/Winのコード中にはショートカットキー処理するコードがありません。
実際にショートカットを設定しても動作しないので、間違ってはいないと思います。おそらくまだ作りかけなんでしょう。
この件に関しては、そのうちアップデートで治ると思いますので正式対応を待ってもいいと思っていますが、 エンバカの公式フォーラムで困っている人がいるのを見つけたので(無理やりな)解決方法を書いておきます。

まず次のようなクラスを作ります:
interface
{$IFDEF MSWINDOWS}
uses
  System.Classes, Winapi.Windows, Winapi.Messages, FMX.Menus;

type
  TAccelkeyTable = class
  private
    var FTable : array of TMenuItem;
  protected

  public
    procedure Init;
    procedure Add(menuitem : TMenuItem);
    procedure Remove(menuitem : TMenuItem);
    function  Translate(var msg : TMsg) : Boolean;
    function  CheckShortCut(Handle : HWND; var Key: Word; var KeyChar: System.WideChar;  Shift: TShiftState): Boolean;
  end;

var
  AccelKeyTable : TAccelKeyTable = nil;


{$ENDIF}
implementation
{$IFDEF MSWINDOWS}

{ TAccelkeyTable }

procedure TAccelkeyTable.Add(menuitem: TMenuItem);
var
  i : integer;
begin
  i := Length(FTable);
  SetLength(FTable, i+1);
  FTable[i] := menuitem;
end;

procedure TAccelkeyTable.Init;
begin
  Initialize(FTable);
end;

procedure TAccelkeyTable.Remove(menuitem: TMenuItem);
var
  i, cnt : integer;
begin
  cnt := Length(FTable);
  for i := 0 to cnt-1 do
  begin
    if FTable[i] = menuitem then
    begin
      FTable[i] := nil;
      break;
    end;
  end;
end;

function TAccelkeyTable.Translate(var msg: TMsg): Boolean;
var
  Shift : TShiftState;
  Key : Word;
  KeyChar : System.WideChar;
begin
  result := false;
  if msg.message = WM_KEYDOWN then
  begin
    Shift := [];
    if (GetKeyState(VK_SHIFT) and $80) <> 0 then Shift := Shift + [ssShift]
    else if (GetKeyState(VK_CONTROL) and $80) <> 0 then Shift := Shift + [ssCtrl]
    else if (GetKeyState(VK_MENU) and $80) <> 0 then Shift := Shift + [ssAlt];

    Key := LOWORD(msg.wparam);
    KeyChar := System.WideChar(LOWORD(msg.lParam));
    result := CheckShortCut(msg.hwnd, Key, KeyChar, Shift);
  end;
end;

function TAccelkeyTable.CheckShortCut(Handle : HWND; var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState) : Boolean;
var
  i, cnt : integer;
  sc : TShortCut;
begin
  result := false;

  sc := scNone;
  if ssShift in Shift then sc := sc or scShift
  else if ssCtrl in Shift then sc := sc or scCtrl
  else if ssAlt in Shift then sc := sc or scAlt;

  if Key > 32 then
  begin
    sc := sc or Key;
    //Application.MainForm.Caption := ShortCutToText(sc); // debug
    cnt := Length(FTable);
    for i := 0 to cnt-1 do
    begin
      if (FTable[i] <> nil) and (FTable[i].ShortCut = sc) then
      begin
        SendMessage(Handle, WM_COMMAND, NativeUInt( FTable[i] ), 0);
        result := true;
        break;
      end;
    end;
  end;
end;

initialization

{$ENDIF}
end.
このクラスのインスタンスを作り、ショートカットを設定したTMenuItemをすべて登録してください:
  AccelKeyTable.Add( mnuSaveAs );
  AccelKeyTable.Add( mnuCopy );
    ....
みたいな感じ
個人的にはTMainMenu/TMenuItemを派生したクラスを作って自動で登録するようにしてます。

次に、ショートカットキーが押された時にコマンドを実行するための処理を呼び出します。FireMonkeyのソースコードを見るとWM_COMMANDのwparamにTMenuItemのインスタンスを渡してメッセージを送ることでTMenuItem.Clickが実行されるようなので、キーイベントでWM_COMMANDをSendMessage()してやるようにします。

これも個人的にはFMX.Platform.Winのメッセージループを書き換えたりして実験してますが、もう少し単純にフォームのKeyDown()メソッドをoverrideして呼び出す方法を記載しておきます。


interface
  ・・・
type
  TForm1 = class(TForm)
  ・・・
 protected
  ・・・
     procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override;
  ・・・
  ・・・
  end;

implementation

  ・・・

procedure TForm1.KeyDown(var Key: Word; var KeyChar: System.WideChar;  Shift: TShiftState);
begin
{$ifdef MSWINDOWS}
  if not AccelKeyTable.CheckShortCut(FmxHandleToHWND(Handle), Key, KeyChar, Shift) then
    inherited;
{$else}
  inherited;
{$endif}
end;

  ・・・

|

« FireMonkey小ネタ その2 | トップページ | チョコレートグラミー産卵&孵化 »

プログラミング」カテゴリの記事

Delphi」カテゴリの記事

FireMonkey/Delphi XE2」カテゴリの記事

コメント

アップデートが出るまでとあきらめておりました。実装されてなかったんですね,,
Update2と併せて試したいと思います。ありがとうございました!!

投稿: Yuzuru Kato | 2011年11月 8日 (火) 03時18分

こんにちは。
まだ検証できていないんですが、Update2ではシュートカット周りにかなり手が入ってるようです。FireMonkeyのソースを見る限り動作するようになってるかもしれません。

記事の方法を試す前に、素の状態で試した方がよいかも

投稿: Mae | 2011年11月 8日 (火) 03時34分

コメントを書く



(ウェブ上には掲載しません)




トラックバック


この記事へのトラックバック一覧です: FireMonkeyでのショートカット(Windows):

« FireMonkey小ネタ その2 | トップページ | チョコレートグラミー産卵&孵化 »