ホットキークラス

とりあえず現時点でのソースを。

今後修正予定です。
保存形式をJSON形式にする予定です。

unit NYHotkey;

interface

uses Contnrs,SysUtils,Forms,Classes,AppEvnts,Windows,Messages,Controls
    ,System.Generics.Defaults,System.Generics.Collections,System.Types
    ,MMSystem,Menus,Graphics ,ComCtrls

    ,REST.Json
    ,System.JSON.Serializers

    ,NY_Consts,NY_Procs

   ;


 type
 //=====================================================================
 //---------------------------------------------------------------------
 // ホットキークラス
 // 連続ホットキー入力において一定間隔内のキー入力を無効化する機能を実装する
 //---------------------------------------------------------------------
 // NY_Values にて NV_HotKeys として定義されている
 //---------------------------------------------------------------------
 //(ホットキーを受けるフォームに追加)
 //  protected
 //   //ホットキー
 //   procedure WMHotKey(var Message: TMessage); message WM_HOTKEY;
 //---------------------------------------------------------------------
 TNYHotKeyRec=record
  Form     :TForm;
  HandleID :integer;
  HandleStr:string;  //識別名 ← 内部利用のため

  Title    :string;
  KeyStr   :string;
  Exp      :string;
  StrParam :string;
  IntParam :integer;

  procedure Init;
 end;


 TNY_HotKey=class
  private
   FHandleIDList:TDictionary;
   FLastTime    :Cardinal; //最後にホットキーを押した時刻
   FKeyIntervel :Cardinal;

  public
   constructor Create;
   destructor  Destroy;override;

   function  FGetCount:integer;

   procedure SetHotkeySub(aForm:TForm;Param:string);
   function  RegistHotKey(aForm:TForm;aHandleStr:string;vk:Cardinal;kCTRL,kShift,kALT,kWin:boolean;aStrParam:string;aIntParam:integer;aTitle:string;aExp:string=''):TNYHotKeyRec; overload;
   function  RegistHotKey(Form:TForm;aHandleStr:string;SC:THotKey;aParam:string;aExp:string=''):TNYHotKeyRec;     overload;
   procedure RemoveHotKey(HandleID:integer);
   procedure RemoveHotKeyAll;

   function  HandleExstsID(HandleID:integer;var HotKeyInfo:TNYHotKeyRec):boolean;
   function  GetHotKeyList:string;
   function  StrToHotKeyRec(var Val:string):TNYHotKeyRec;

   function  IsAcceptable:boolean;


  property KeyInterval:Cardinal read FKeyIntervel write FKeyIntervel;
  property Count:integer        read FGetCount;

 end;



implementation


//=========================================================================
//-------------------------------------------------------------------------
// ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
//-------------------------------------------------------------------------
// TNYHotKeyRec
//=========================================================================
procedure TNYHotKeyRec.Init;
begin
  Form     :=nil;
  HandleID :=0;
  Title    :='';
  HandleStr:='';
  KeyStr   :='';
  Exp      :='';
  StrParam :='';
  IntParam :=0;
end;





//=========================================================================
//-------------------------------------------------------------------------
// ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
//-------------------------------------------------------------------------
// TNY_HotKey
//=========================================================================
constructor TNY_HotKey.Create;
begin
 FHandleIDList:=TDictionary.Create;

 //現在時刻を取得
 FLastTime   :=timeGetTime;

 //キー入力を無効化する間隔(ミリ秒)
 FKeyIntervel:=100;
end;

destructor TNY_HotKey.Destroy;
begin
 //登録しているハンドルIDを全削除する
 RemoveHotKeyAll;

 //ハンドルIDリストの解放
 FreeAndNil(FHandleIDList);

 inherited;
end;



function TNY_HotKey.FGetCount:integer;
begin
 //登録しているハンドルIDの数を返す
 Result:=FHandleIDList.Count;
end;


function TNY_HotKey.IsAcceptable:boolean;
begin
 //キー入力が可能かどうか
 Result:=((timeGetTime - FLastTime) >= FKeyIntervel);
 if Result then FLastTime:=timeGetTime;
end;






procedure TNY_HotKey.SetHotkeySub(aForm:TForm;Param:string);
var s:string;
    KS:string;
    HKChar:Cardinal;
    vkCtrl,vkShift,vkAlt,vkWin:boolean;
    StrParam,Title,Exp:string;
    IntParam:integer;
begin
 //全解除
 RemoveHotKeyAll;

 while Param<>'' do begin
  s:=NP_Trim(NP_CutFirst(Param,_CRLF));
  if s='' then continue;

  //RegistHotKey(Self,'C+S_B',Ord('B'),True,True,False,False,'Param2',0,'ホットキーB','テスト用ホットキー B');
  //C+S_B,B,T,T,F,F,Param2,0,ホットキーB,テスト用ホットキー B
  KS      :=NP_Trim(NP_CutFirst(s,_CM));               //KeyStr
  HKChar  :=Ord(NP_Trim(NP_CutFirst(s,_CM))[1]);       //ホットキー文字列
  vkCtrl  :=NP_Trim(NP_CutFirst(s,_CM))='T';           //CTRL
  vkShift :=NP_Trim(NP_CutFirst(s,_CM))='T';           //Shift
  vkAlt   :=NP_Trim(NP_CutFirst(s,_CM))='T';           //ALT
  vkWin   :=NP_Trim(NP_CutFirst(s,_CM))='T';           //Win
  StrParam:=NP_Trim(NP_CutFirst(s,_CM));               //Param
  IntParam:=StrToIntDef(NP_Trim(NP_CutFirst(s,_CM)),0);//Param
  Title   :=NP_Trim(NP_CutFirst(s,_CM));               //Title
  Exp     :=NP_Trim(NP_CutFirst(s,_CM));               //Exp

  RegistHotKey(aForm,KS,HKChar,vkCtrl,vkShift,vkAlt,vkWin,StrParam,IntParam,Title,Exp);
 end;

end;


function TNY_HotKey.RegistHotKey(Form:TForm;aHandleStr:string;SC:THotKey;aParam:string;aExp:string=''):TNYHotKeyRec;
var s:string;
begin
 s:=ShortCutToText(SC.HotKey);

 while s.IndexOf('+')<>-1 do NP_CutFirst(s,'+');
 s:=NP_Trim(s);
 if not NP_DispErrMes('ショートカットの文字が設定されていません',s<>'') then exit;

end;



function TNY_HotKey.RegistHotKey(aForm:TForm;aHandleStr:string;vk:Cardinal;kCTRL,kShift,kALT,kWin:boolean;aStrParam:string;aIntParam:integer;aTitle:string;aExp:string=''):TNYHotKeyRec;
var LHotKeySet    : Cardinal;
    LHotKeyShifts : Cardinal;

 function GetKeyAssign:string;
 begin
  Result:='';
  if kCTRL  then Result:=Result +'Ctrl+';
  if kShift then Result:=Result +'Shift+';
  if kALT   then Result:=Result +'Alt+';
  if kWin   then Result:=Result +'Win+';

  Result:=Result+Chr(vk);
 end;

begin
 with Result do begin
  Init;

  Form     :=aForm;
  HandleID :=0;
  Title    :=aTitle;        //タイトル
  HandleStr:=aHandleStr;    //識別名        //内部利用のため
  KeyStr   :=GetKeyAssign;  //キーアサイン:
  Exp      :=aExp;          //説明
  StrParam :=aStrParam;     //文字列パラメータ
  IntParam :=aIntParam;     //整数パラメータ
 end;

  //文字設定
  LHotKeySet:=vk;    //ex.Ord('A');

  //修飾キー設定
  LHotKeyShifts :=0;
  if kCTRL  then LHotKeyShifts:=LHotKeyShifts or MOD_CONTROL;
  if kShift then LHotKeyShifts:=LHotKeyShifts or MOD_SHIFT;
  if kALT   then LHotKeyShifts:=LHotKeyShifts or MOD_ALT;
  if kWin   then LHotKeyShifts:=LHotKeyShifts or MOD_WIN;

  //ホットキーをグローバルアトムのテーブルに追加
  //文字列を識別する一意の値をホットキーIDとして取得
  Result.HandleID:=GlobalAddAtom(PWideChar(aHandleStr));

  //そのID値でホットキーを登録する
  if not RegisterHotKey(aForm.Handle, Result.HandleID, LHotKeyShifts, LHotKeySet) then begin
   NP_DispErrMes('ホットキーが登録できませんでした:['+aHandleStr+']');
   exit;
  end;

  FHandleIDList.AddOrSetValue(aHandleStr,Result);
end;



procedure TNY_HotKey.RemoveHotKey(HandleID:integer);
var s:string;
begin
 //-------------------------------------------------------------------
 // http://mrxray.on.coocan.jp/Delphi/plSamples/360_GlobalHotKey.htm
 //-------------------------------------------------------------------
 if HandleID <> 0 then begin
  //アトムに関連付けられている文字列を、アトムテーブルから削除
  GlobalDeleteAtom(HandleID);

  //ホットキーの登録解除
  for s in FHandleIDList.Keys do begin
   if FHandleIDList[s].HandleID=HandleID then begin
    UnregisterHotKey(FHandleIDList[s].Form.Handle,HandleID);
    FHandleIDList.Remove(s);
    exit;
   end;
  end;

  UnregisterHotKey(Application.Handle,HandleID);
 end;
end;

procedure TNY_HotKey.RemoveHotKeyAll;
var s:string;
begin
 //---------------------------------
 // 全てのホットキー登録を削除する
 //---------------------------------
 for s in FHandleIDList.Keys do RemoveHotKey(FHandleIDList[s].HandleID);
 FHandleIDList.Clear;
end;


function TNY_HotKey.HandleExstsID(HandleID:integer;var HotKeyInfo:TNYHotKeyRec):boolean;
var s:string;
begin
 //-----------------------------------------------------
 // ホットキー登録が存在しているかチェック
 // 戻り値:ホットキーが登録されていたらTrue
 //        ⇒ HotKeyInfo:ホットキー情報(TNYHotKeyRec)
 //----------------------------------------------------
 //キー入力無効化時間帯ならExit
 Result:=IsAcceptable;
 if not Result then exit;

 Result:=False;
 HotKeyInfo.Init;


 for s in FHandleIDList.Keys do begin
  if FHandleIDList[s].HandleID<>HandleID then Continue;
  Result:=True;
  HotKeyInfo:=FHandleIDList[s];
  break;
 end;

end;


function TNY_HotKey.GetHotKeyList:string;
var s:string;
begin
 result:='';

 for s in FHandleIDList.Keys do begin
  with FHandleIDList[s] do begin
   Result:=Result+HandleID.ToString+_Tab
                 +Title   +_tab
                 +KeyStr  +_Tab
                 +Exp     +_Tab
                 +StrParam+_Tab
                 +IntParam.ToString+_Tab
                 +_CRLF;
  end;
 end;
  
end;


function TNY_HotKey.StrToHotKeyRec(var Val:string):TNYHotKeyRec;
var s:string;
begin
 s:=NP_Trim(NP_CutFirst(Val,_CRLF));
 with Result do begin
  HandleID:=StrToIntDef(NP_CutFirst(s,_tab),0);
  Title   :=NP_CutFirst(s,_tab);
  KeyStr  :=NP_CutFirst(s,_tab);
  Exp     :=NP_CutFirst(s,_tab);
  StrParam:=NP_CutFirst(s,_tab);
  IntParam:=StrToIntDef(NP_CutFirst(s,_tab),0);
 end;
end;


end.

 
メインフォームでホットキーを受ける処理の例

//=============================================================================
//=============================================================================
//  WM_HOTKEYメッセージの処理
//=============================================================================
procedure TfrmHotkeyReceiver.WMHotKey(var Message: TMessage);
var HotKeyInfo:TNYHotKeyRec;
    ScriptSrc,ScriptName,StrParam:string;
begin
  //登録したホットキーが押された時の処理
  if NV_HotKeys.HandleExstsID(Message.WParam,HotKeyInfo) then begin
   //----------------------------------------------------
   // ⇒ HotKeyInfo にホットキー情報が入って戻ってくる
   //----------------------------------------------------
   // TNYHotKeyRec=record
   //  Form     :TForm;
   //  HandleID :integer;
   //  HandleStr:string;
   //  KeyStr   :string;
   //  Exp      :string;
   //  StrParam :string;
   //  IntParam :integer;
   //----------------------------------------------------

   StatusBar2.Panels[0].Text:='HotKeyPress ⇒ [ '+HotKeyInfo.KeyStr+' ]';


   //TestModeでの処理
   if FTestMode then exit;

   //HotKey処理
   StrParam  :=HotKeyInfo.StrParam;
   ScriptName:=NP_Trim(NP_CutFirst(StrParam,':'));
   StrParam  :=NP_Trim(StrParam);

   ScriptSrc :=NV_Script.Scripts[ScriptName];

   with NV_Script do begin
    Values['_StrParam']:=StrParam;
    Values['_IntParam']:=HotKeyInfo.IntParam.ToString;
    RunScript(ScriptSrc);
   end;

   //ShowMessage(HotKeyInfo.StrParam);


  Timer1.Enabled:=True;

  end else StatusBar2.Panels[0].Text:='';

end;

シェアする

  • このエントリーをはてなブックマークに追加

フォローする