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.
|