Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年03月25日] [更新 2015年09月26日] Delphi サンプルプログラム集
   
240_NumLock を常にON ( 自アプリのみ )
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
240_NumLockControlSelf.zip [551 KB] 2015年09月26日版 (EXE 同梱)



  • 2010年08月17日
  • NumLock のキー状態の取得方法を変更
  • このフォームがアクティブになった時も NumLock の状態をチェック
  • 2010年08月25日
  • 低レベルキーフックを使用して DLL を使わないコードに変更
  • 2015年09月26日
  • Windows 7 U64(SP1) + Delphi XE(UP1) Pro で動作確認




NumLock を常に ON ( 自アプリのみ )


[NumLock] を常にONにするサンプルプログラムですが,自アプリのみで有効とする場合です.WH_KEYBORD_LL フックはシステム全体で有効ですので,スレッド ID を調査して,自アプリの場合のみ [NumLock] キー状態を設定するようにしています.


図1
設計時画面
  • TEdit は動作確認用
  • [Stop KeyHook] で通常の動作に戻る
図2
実行画面
  • このプログラムだけで常に [NumLock] が ON

リスト1
自アプリの [NumLock] を常に ON にするサンプル
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, AppEvnts;

type
 TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Edit1: TEdit;
    ApplicationEvents1: TApplicationEvents;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ApplicationEvents1Activate(Sender: TObject);
 private
   { Private 宣言 }
 public
   { Public 宣言 }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
//  低レベルキーフックのキー情報構造体と定数
//-----------------------------------------------------------------------------
const
  LLKHF_EXTENDED = KF_EXTENDED shr 8;
  LLKHF_INJECTED = $00000010;
  LLKHF_ALTDOWN  = KF_ALTDOWN shr 8;
  LLKHF_UP       = KF_UP shr 8;
  LLMHF_INJECTED = $00000001;

type
  LPKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  tagKBDLLHOOKSTRUCT = record
    vkCode      : DWORD;
    scanCode    : DWORD;
    flags       : DWORD;
    time        : DWORD;
    dwExtraInfo : ULONG_PTR;
  end;
  KBDLLHOOKSTRUCT  = tagKBDLLHOOKSTRUCT;
  TKbDllHookStruct = KBDLLHOOKSTRUCT;
  PKbDllHookStruct = LPKBDLLHOOKSTRUCT;

var
  KeyHookHandle : HHOOK=0;

//-----------------------------------------------------------------------------
//  [NumLock] の状態をチェックして設定
//-----------------------------------------------------------------------------
procedure ChangeNumLockOn;
var
  LKeyFlg : Boolean;
  LKeyExt : Cardinal;
  LMsg    : TMsg;
begin
  LKeyFlg := (GetKeyState(VK_NUMLOCK) and 1) = 1;

  if LKeyFlg = False then begin
    LKeyExt := KEYEVENTF_EXTENDEDKEY;
    keybd_event(VK_NUMLOCK, MapVirtualKey(VK_NUMLOCK, 0), LKeyExt, 0);

    LKeyExt := KEYEVENTF_KEYUP or KEYEVENTF_EXTENDEDKEY;
    keybd_event(VK_NUMLOCK, MapVirtualKey(VK_NUMLOCK, 0), LKeyExt, 0);

    // キーバッファのクリア
    while PeekMessage(LMsg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE) do;
  end;
end;

//-----------------------------------------------------------------------------
//  フックのコールバ ック関数
//  現在の Foreground なウィンドウのスレッド ID とこのアプリのスレッドID が
//  等しい場合のみ処理を行う
//-----------------------------------------------------------------------------
function LowLevelKeyProc(Code:integer; wPar:wParam; lPar:LParam): LRESULT; stdcall;
var
  LKeyFlg       : Boolean;
  Lkbdll        : PKBDLLHOOKSTRUCT;
  LThreadForeID : Cardinal;
  LThreadSelfID : Cardinal;
begin
  Result := 0;

  // Code < 0の時は余計なことをせずに
  // 直ち に CallNextHookEx の Result を返して終了する
  if Code < 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
    exit;
  end;

  Lkbdll := PKBDLLHOOKSTRUCT(lPar);

  if Code = HC_ACTION then begin

    LThreadSelfID := GetCurrentThreadId;
    LThreadForeID := GetWindowThreadProcessId(GetForegroundWindow);

    if LThreadSelfID = LThreadForeID then begin
      if (Lkbdll.vkCode in [VK_NUMLOCK]) then begin
        LKeyFlg := (GetKeyState(VK_NUMLOCK) and 1) = 1;
        if LKeyFlg= False then begin
          ChangeNumLockOn;
          Result := 1;
        end;
      end;
    end;
  end;

  if Result = 0 then begin
    Result := CallNextHookEx(KeyHookHandle, Code, wPar, lPar);
  end;
end;

//=============================================================================
//  キーフック開始
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  終了時にはフックを解除
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Button2Click(nil);
end;

//=============================================================================
//  キーフック開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if KeyHookHandle = 0 then begin
    KeyHookHandle := SetWindowsHookEx(WH_KEYBOARD_LL,
                                      @LowLevelKeyProc,
                                      hInstance,
                                      0);
    ChangeNumLockOn;
  end;
end;

//=============================================================================
//  キーフックを解除して通常の動作に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if KeyHookHandle <> 0 then begin
    UnhookWindowsHookEx(KeyHookHandle);
    KeyHookHandle := 0;
  end;
end;

//=============================================================================
//  このフォームがアクティブになった ら[NumLock] の状態をチェックして設定
//=============================================================================
procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
begin
  ChangeNumLockOn;
end;

end.