[BlueLeaf1336]> PROGRAM>

ホットキーを手軽に扱うためのクラス(TCoolKey,TCoolKeys)

history

TOP

2003/07/26:作成

download

TOP

CoolKey.zip(4,463bytes)

memo

TOP

※警告※ココの記述は「感じ」です。このとおりで無い可能性が十分にあります。

自分がアクティブで無い時でも、あるキーの組み合わせ(たとえばShift+Ctrl+F1とか)で呼び出したいときがあります。
これをホットキーと呼びます(多分)。
似た機能に、自分がアクティブな場合にメニューをいちいち選択せずに呼び出すキーの組み合わせがありますが、 これは、多分、アクセラレータキーとかショートカットキーと呼ぶと思っています。

で、ホットキーですが、まずWM_HOTKEYというウィンドウメッセージを捕まえる必要があります。
ところが、ウィンドウメッセージはウィンドウコントロールにしか飛んで来ないため、単純にTObjectから派生した クラスを作ってもうまくいきません。そこで登場するのが

AllocateHWnd

それから、キーの組み合わせをWindowsに登録するための関数が

RegisterHotKey

で、クラスの作成ですが、2つに分けようと思います。
1つは、あるキーの組み合わせとそのキーが押された時に実行する処理のを保持するクラス(TCoolKey)で、上の説明のRegisterHotKeyを実行します。
もう1つは、TCoolKeyを複数保持し、AllocateHWndを利用してWM_HOTKEYを捕まえ、適切なTCoolKeyを呼び出すクラス(TCoolKeys)です。

コードの重要ポイント(かなぁと思う所)は赤いボールドで示しています。

code-Call Test

TOP

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, iCoolKey;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Test        : TCoolKeys;
    procedure    ProcA();
    procedure    ProcB();
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// 登録するための関数
procedure    TForm1.ProcA();
begin
    // タスクバーの表示名を変更する
    Application.Title := 'ProcA';
end;

// 登録するための関数
procedure    TForm1.ProcB();
begin
    // タスクバーの表示名を変更する
    Application.Title := 'ProcB';
end;

// 初期化
procedure TForm1.FormCreate(Sender: TObject);
begin
    Test := TCoolKeys.Create;            // 保持クラスのインスタンス作成
    Test.Add(ProcA, [ssShift], VK_F10);  // Shift + F10 で ProcA 呼び出し
    Test.Add(ProcB, [ssShift], VK_F11);  // Shift + F11 で ProcB 呼び出し
end;

// 後始末
procedure TForm1.FormDestroy(Sender: TObject);
begin
    Test.Free;                            // 保持クラスのインスタンス破棄
end;

end.

code-Class

TOP

(*
    ****************************************************************************

    ホットキーをアプリケーションに比較的簡単に実装するための「ユニットファイル」

    ----------------------------------------------------------------------------

    作成日    ：2003/07/26
    作成者    ：fjtkt
    アドレス：http://www.geocities.jp/fjtkt/    (2003/07/26時点)

    ****************************************************************************
*)

unit iCoolKey;

interface

uses
    Windows, Messages, SysUtils, Classes;

(*
    =======================================================
    ホットキーで呼び出されるクラスメソッドの型宣言

    ココでは、単なるprocedureを想定している。変更は可能。
    =======================================================
*)
type
    TCoolProc = procedure of object;    // of object は、クラスメソッドの意味
//    TCoolProc = procedure;                // 単なる手続きならこちら

(*
    =======================================================
    ホットキーと呼び出す処理との組み合わせを保持するクラス
    =======================================================
*)
type
    TCoolKeys = class
    private
        WndHandle    : THandle;        // ウィンドウの「ふり」をするためのハンドル
        Finder        : TStringList;    // 組み合わせを保持するリスト
    public
        function    Add(AProc: TCoolProc; AModifier: TShiftState;
                        AKey: Cardinal): integer;
        procedure    Delete(AIndex: integer);
        procedure    Clear();
        procedure    Execute(AId: integer);

        constructor    Create();
        destructor    Destroy(); override;
        procedure    WndProc(var Msg: TMessage); message WM_HOTKEY;
    end;

implementation

(* ########################################################################## *)

(*
    =======================================================
    TShiftState → Cardinal 変換 for RegisterHotKey API
    =======================================================
*)
function    ShiftStateToModifiers(AShift: TShiftState): Cardinal;
begin
    Result := 0;
    if ssShift in AShift then Inc(Result, MOD_SHIFT);
    if ssAlt in AShift then Inc(Result, MOD_ALT);
    if ssCtrl in AShift then Inc(Result, MOD_CONTROL);
    // あきらめ Inc(Result, MOD_WIN);
end;

(*
    =======================================================
    単なるIntToStrだが...
    =======================================================
*)
function    IDtoStr(AId: integer): string;
begin
    Result := Format('%8.8d', [Aid]);
end;

(* ########################################################################## *)

(*
    =======================================================
    クラス宣言
    =======================================================
*)
type
    TCoolKey = class
    private
        ID        : integer;
        Modifier: Cardinal;
        VirtKey    : Cardinal;
        Handle    : THandle;
        Active    : Boolean;
        CoolProc: TCoolProc;
        class function    GetID(): integer;
    public
        constructor    Create(AWndHandle: THandle; ACoolProc: TCoolProc;
                            AShift: TShiftState; AKey: Cardinal);
        destructor    Destroy(); override;
        procedure    Execute();
    end;

(*
    =======================================================
    ID用変数
    =======================================================
*)
var
    _ID: integer = 123;        // 123 に意味は無い。なんとなく。

(*
    =======================================================
    一意のつもりのID作成関数
    =======================================================
*)
class function    TCoolKey.GetID(): integer;
begin
    Result := _ID;
    Inc(_ID);
end;

(*
    =================================================================
    コンストラクタ

    http://plaza12.mbn.or.jp/~tsuboi/tips/tipsCMP05.htm
    =================================================================
*)
constructor    TCoolKey.Create(AWndHandle: THandle; ACoolProc: TCoolProc;
                            AShift: TShiftState; AKey: Cardinal);
begin
    //メッセージ受け取りフォーム
    Handle    := AWndHandle;
    //関数割り当て
    CoolProc:= ACoolProc;
    //登録用ID
    ID        := GetID();
    //ホットキー用の修飾キー
    Modifier:= ShiftStateToModifiers(AShift);
    //ホットキー用の仮想キー
    VirtKey    := AKey;
    //登録(および成功/失敗判定)
    Active    := RegisterHotKey(Handle, ID, Modifier, VirtKey);
end;

(*
    =================================================================
    デストラクタ
    =================================================================
*)
destructor    TCoolKey.Destroy();
begin
    //登録できている場合は ** 絶対 ** 解除
    if Active then UnregisterHotKey(Handle, ID);
end;

(*
    =======================================================
    割り当て関数実行
    =======================================================
*)
procedure    TCoolKey.Execute();
begin
    CoolProc();
end;

(* ########################################################################## *)

(*
    =================================================================
    ウィンドウプロシージャ

    VCLリファレンス(AllocateHWnd)
    =================================================================
*)
procedure    TCoolKeys.WndProc(var Msg: TMessage);
begin
    // メッセージが WM_HOTKEY なら
    if Msg.Msg = WM_HOTKEY then
    begin
        Execute(Msg.WParam);
    end else
    // そうでないなら
    begin
        // 元のやつ
        Msg.Result := DefWindowProc(WndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;

(*
    =================================================================
    コンストラクタ

    VCLリファレンス(AllocateHWnd)
    =================================================================
*)
constructor    TCoolKeys.Create();
begin
    inherited Create;
    //TCoolKey 保持・検索用リスト
    Finder := TStringList.Create;
    // ウィンドウメッセージの受け取り手続き
    WndHandle := AllocateHWnd(WndProc);
end;

(*
    =================================================================
    デストラクタ

    VCLリファレンス(AllocateHWnd)
    =================================================================
*)
destructor    TCoolKeys.Destroy();
begin
    // ウィンドウメッセージの受け取り解除
    DeallocateHWnd(WndHandle);
    //クリア
    Clear();
    //解放
    Finder.Free;
    inherited Destroy;
end;

(*
    =================================================================
    ホットキーと呼び出す処理の組み合わせ追加
    =================================================================
*)
function    TCoolKeys.Add(AProc: TCoolProc; AModifier: TShiftState;
                            AKey: Cardinal): integer;
var
    CoolKey    : TCoolKey;
begin
    Result := -1;

    // 作ってみる
    CoolKey := TCoolKey.Create(WndHandle, AProc, AModifier, Ord(AKey));

    // 修飾キーが無い場合はやめておく。登録できていない場合もやめておく
    if (CoolKey.Modifier = 0) or (not CoolKey.Active) then
    begin
        CoolKey.Free;
    end else
    // 成功したらリストに保持しておく
    begin
        Result := Finder.AddObject(IDtoStr(CoolKey.ID), CoolKey);
    end;
end;

(*
    =================================================================
    ホットキーと呼び出す処理の組み合わせ削除
    =================================================================
*)
procedure    TCoolKeys.Delete(AIndex: integer);
begin
    //有効範囲チェック
    if (AIndex < 0) or (Finder.Count <= AIndex) then Exit;
    //登録TCoolKey解放
    Finder.Objects[AIndex].Free;
    //文字列削除
    Finder.Delete(AIndex);
end;

(*
    =================================================================
    ホットキーと呼び出す処理の組み合わせ全削除
    =================================================================
*)
procedure    TCoolKeys.Clear();
begin
    //全アイテムを削除
    while Finder.Count > 0 do Delete(0);
    //なんとなく
    Finder.Clear;
end;

(*
    =================================================================
    IDによる実行
    =================================================================
*)
procedure    TCoolKeys.Execute(AId: integer);
var
    Index: integer;
begin
    // WM_HOTKEY が教えてくれる情報は、ホットキーのIDだけ

    //そのIDを検索(IDは昇順に並んでいるとする)
    if Finder.Find(IDtoStr(AId), Index) then
        //あれば実行
        TCoolKey(Finder.Objects[Index]).Execute();
end;

end.

EOF

TOP