[ 230_NumLock を常に ON ( システム全体 ) ]

Delphi Programming / Object Pascal

[掲載 2005年03月21日] [更新 2015年09月26日]　Delphi サンプルプログラム集

230_NumLock を常に ON ( システム全体 )
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro

230_NumLockControl.zip　[1,652 KB]　2015年09月26日版 (EXE 同梱)

01_NumLock を常に ON (システム全体)
02_トグルキーの状態検出と設定
03_NumLock キーの状態検出と設定

2005年08月13日
Windows XP でフックを有効した時，ワード起動中に [NumLock] を操作すると，システム全体がハングアップする現象を修正

2010年08月17日
NumLock のキー状態の取得方法を修正．この修正で Vista と Windows 7 に対応

2010年08月21日
サンプル [2],[3] を追加

2010年08月25日
低レベルキーフックを使用して DLL を使わないコードに変更
[CapsLock] を常にオフにするコードを追加

2015年09月26日
Windows 7 U64(SP1) + Delphi XE(UP1) Pro で動作確認

01_NumLock を常に ON ( システム全体 )

低レベルのキーフック WH_KEYBOARD_LL 使用して，NumLock を常にONにするサンプルです．
動作はシステム全体に有効となっていて，実行開始時にキーフックを開始するようになっています．
常駐プログラムにして，システム起動時に実行すれば便利かも知れません．

図1
実行画面

下部にテスト用の Edit を配置
[Stop KeyHook] で通常の動作に戻る

リスト1
[NumLock] を常に ONに，[CapsLock] を常に OFF にする

unit Unit1;

interface

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

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

var
 Form1: TForm1;

implementation

{$R *.DFM}

//-----------------------------------------------------------------------------
//  低レベルキーフックのキー情報構造体と定数
//  Delphi2007のWindos.pasにはWH_KEYBOARD_LLの定義がないのでここで設定
//-----------------------------------------------------------------------------
const
  WH_KEYBOARD_LL = 13;

  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;

//-----------------------------------------------------------------------------
//  [CapsLock]の状態をチェックして設定
//-----------------------------------------------------------------------------
procedure ChangeCapsLock;
var
  LKeyFlg : Boolean;
  LMsg    : TMsg;
begin
  LKeyFlg := (GetKeyState(VK_CAPITAL) and 1) = 1;

  if (LKeyFlg) then begin
    keybd_event(VK_SHIFT,   MapVirtualKey(VK_SHIFT, 0),   0, 0);
    keybd_event(VK_CAPITAL, MapVirtualKey(VK_CAPITAL, 0), 0, 0);

    keybd_event(VK_CAPITAL, MapVirtualKey(VK_CAPITAL, 0), KEYEVENTF_KEYUP, 0);
    keybd_event(VK_SHIFT,   MapVirtualKey(VK_SHIFT, 0),   KEYEVENTF_KEYUP, 0);

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

//-----------------------------------------------------------------------------
//  フックのコールバック関数
//-----------------------------------------------------------------------------
function LowLevelKeyProc(Code:integer; wPar:wParam; lPar:LParam): LRESULT; stdcall;
var
  LKeyFlg : Boolean;
  Lkbdll  : PKBDLLHOOKSTRUCT;
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
    // [NumLock]の調査
    // オフになっていたら ChangeNumLock でオンにする
    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 else

    // [CapsLock] の調査
    // こちらはオンになっていたら hangeCapsLock でオフにする
    if (Lkbdll.vkCode in [VK_CAPITAL]) then begin
      LKeyFlg := (GetKeyState(VK_CAPITAL) and 1) = 1;
      if LKeyFlg then begin
        ChangeCapsLock;
        Result := 1;
      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;
    ChangeCapsLock;                               
  end;
end;

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

end.

02_トグルキーの状態検出と設定

CapsLock や NumLock のトグル状態はフックでなくても検出，設定できます．そのサンプルです．このサンプルコードでは，キーボードにあるインジケータは変化しません．また NumLock キーの状態は検出設定ともに正常にできません．

	図2 設計時画面 Panel1, Panel2 はキーのロック状態を表示するインジケータ
	図3 実行例キーボードのインジケータの状態は反映されない，反映しない NumLock は正しく動作しない

リスト2
CapsLock と NumLock の状態検出と設定

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Panel2: TPanel;
    Label2: TLabel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ChangePanelColor;
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  起動したら表示用コントロールを設定
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Panel1.Caption := '';
  Panel2.Caption := '';

  Panel1.ParentBackground := False;
  Panel2.ParentBackground := False;

  //現在の設定状態によってパネルの色を変える
  //この起動時はキーボードのインジケータと同じ
  ChangePanelColor;
end;

//=============================================================================
//  [Caps Lock (トグル)]ボタン
//  CapsLockの操作をコードで実行
//  このコードではキーボードのインジケータ(ランプ)は変化しない
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  LKeyState : TKeyboardState;
begin
  //現在のキー状態をTKeyboardState構造体に取得
  GetKeyboardState(LKeyState);

  //KeyStateのVK_CAPITALの値をセット
  if (LKeyState[VK_CAPITAL] = 0) then begin
    LKeyState[VK_CAPITAL] := 1
  end else begin
    LKeyState[VK_CAPITAL] := 0;
  end;

  //現在のキー設定をTKeyboardState構造体に格納
  SetKeyboardState(LKeyState);

  //現在の設定状態によってパネルの色を変える
  ChangePanelColor;
end;

//=============================================================================
//  [Num Lock (トグル)]ボタン
//  NumLockの操作をコードで実行
//  このコードはうまくいかない．NumLock状態の変更はタイムラグがあるため
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  LKeyState : TKeyboardState;
begin
  //現在のキー状態をTKeyboardState構造体に取得
  GetKeyboardState(LKeyState);

  //KeyStateのVK_NUMLOCKの値をセット
  if (LKeyState[VK_NUMLOCK] = 0) then begin
    LKeyState[VK_NUMLOCK] := 1
  end else begin
    LKeyState[VK_NUMLOCK] := 0;
  end;

  //現在のキー設定をTKeyboardState構造体に格納
  SetKeyboardState(LKeyState);

  //現在の設定状態によってパネルの色を変える
  ChangePanelColor;
end;

//=============================================================================
//  [OnlyCheck]ボタン
//  Lock状態変更のコードは実行しないで
//  現在の設定状態によってパネルの色を変更
//=============================================================================
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  ChangePanelColor;
end;

//-----------------------------------------------------------------------------
//  現在の設定状態によってパネルの色を変更
//  このコードではキーボードのインジケータ(ランプ)は変化しない
//-----------------------------------------------------------------------------
procedure TForm1.ChangePanelColor;
begin
  //CapsLockの状態を表示
  //CapsLockがONならパネルの色をclLime
  if GetKeyState(VK_CAPITAL) = 1 then begin
    Panel1.Color := clLime;
  end else begin
    Panel1.Color := clWhite;
  end;

  //NumLockの状態を表示
  //NumLockがONならパネルの色をclLime
  if GetKeyState(VK_NUMLOCK) = 1 then begin
    Panel2.Color := clLime;
  end else begin
    Panel2.Color := clWhite;
  end;
end;

end.

03_NumLock キーの状態検出と設定

このサンプルは，前のサンプルでは正常に制御できなかった NumLock だけのサンプルです．
NumLock のオン・オフを keybd_event 関数で行うと，実際のキー操作と同じとなり制御できるようになります．キーの状態も GetKeyState 関数でキーコードのビットで判定すれば正確に検出でき，インジケータの状態も正しく検出もできます (最下位ビットがトグル状態)．

サンプルを実行してみると，NumLock の状態を自動で検出して制御できそうな気がしますが，NumLock のトグル状態設定にはタイムラグがあるため，実際には簡単ではありません．このタイムラグはキーバッファの状態も関係しているようです．

	図4 設計時画面 Panel1 はインジケータ
	図5 実行例

リスト3
NumLock の状態検出と設定

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Panel1: TPanel;
    Edit1: TEdit;
    SpeedButton2: TSpeedButton;
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ChangePanelColor;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  起動したら表示用コントロールを設定
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //Edit1でもキーを検出可能にする
  Self.KeyPreview := True;

  Panel1.Caption := '';
  Panel1.ParentBackground := False;

  //現在の設定状態によってパネルの色を変える
  ChangePanelColor;
end;

//=============================================================================
//  [Num Lock (トグル)]ボタン
//  NumLockの操作をコードで実行
//  keybd_eventは実際のキーの疑似操作なので，キーボードのインジケータも変化
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  keybd_event(VK_NUMLOCK, 0, 0, 0);
  keybd_event(VK_NUMLOCK, 0, KEYEVENTF_KEYUP, 0);

  //現在の設定状態によってパネルの色を変える
  ChangePanelColor;
end;

//=============================================================================
//  キー操作した時の処理
//  ここではNUMLOCKキーのみ処理
//=============================================================================
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_NUMLOCK then begin
    //現在の設定状態によってパネルの色を変更
    ChangePanelColor;
  end;
end;

//-----------------------------------------------------------------------------
//  現在の設定状態によってパネルの色を変更
//  GetKeyStateでVK_NUMLOCKの最下位ビットで判定
//-----------------------------------------------------------------------------
procedure TForm1.ChangePanelColor;
var
  LKeyFlg : Boolean;
begin
  LKeyFlg := (GetKeyState(VK_NUMLOCK) and 1) = 1;

  //NumLockの状態を表示
  //NumLockがONならパネルの色をclLime
  if LKeyFlg then begin
    Panel1.Color := clLime;
  end else begin
    Panel1.Color := clWhite;
  end;
end;

end.