FireMonkeyでのショートカット(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;
・・・
| 固定リンク
| コメント (2)
| トラックバック (0)



最近のコメント