Delphi Programming / Object Pascal
[掲載 2005年08月21日] [更新 2014年02月01日] Delphi サンプルプログラム集
640_ソフトキーボード ( スクリーンキーボード )
動作確認等
Windows 7 U64(SP1) + Delphi XE(UP1) Pro
一部 Delphi XE5(UP2) + FireMonkey HD のサンプルあり
640_SoftKeyboard.zip [4,581 KB] 2014年02月01日版 (EXE 同梱)
2014年01月28日
未確定文字例取得のサンプルコードを削除
ファイルシステムのリダイレクトの制御関係のサンプルを追加して記事を整備
2014年02月01日
FireMonkey のサンプルを追加
ソフトウェアキーボードとして,Windows のスクリーンキーボードを起動するサンプルです.
本ページは,当初,質問のレス用に作成しました.ボタンクリックで変換前の文字列を入力する,ソフトキーボードの様な機能を実装したい,というものでした.これは,未確定文字列を入力コントロールにセットすることに相当します.カナ漢字変換ウィンドウ等の表示や確定のための API もあります.
その後,質問された方からの反応がありませんでしたので,実際にはどのような機能が必要だったのかは不明のままです.
そこで,今回の更新では,スクリーンキーボードの起動のサンプルだけにしました.
01_ スクリーンキーボードの起動とリダイレクトの無効化
スクリーンキーボードは,システムフォルダ内にある osk.exe というプログラムです.
ShellExecute 関数等で起動できますが,64 ビット版の Windows で,32 ビットの EXE から起動すると下図のように起動に失敗します.
図1
64 ビット版の Windows での実行結果
32 ビットの EXE からは起動に失敗する
64 ビットの EXE からは起動できる
64 ビット版の Windows では,スクリーンキーボード osk.exe は,以下の場所の 64 ビット版しかありません.
%SystemRoot%\system32\osk.exe
32 ビットの EXE から上のパスで起動しようとすると,ファイルシステムのリダイレクト機能が働き,実際には以下のパス名のファイルを実行しようとします.
%SystemRoot%\sysWOW64\osk.exe
しかし,実際にはこの場所には osk.exe はありません.そこで,上の図のエラーとなります.
この後に「電卓」を起動するサンプルがありますが,「電卓」は 32 ビット版と 64 ビット版の両方があります.
32 ビットの EXE も 64 ビットの EXE もない場合は,見つかりませんというエラーになります.
次のサンプルでは,ファイルシステムのリダイレクト機能を無効にすることで,32 ビットの EXE からもスクリーンキーボードが起動できるようにしています.
そのため,Windows が 32 ビット版か 64 ビット版かを判定するコードと,リダイレクトの機能の無効して元に戻すコードを追加しています.
本ページのサンプルでのリダイレクトの機能の制御は,スレッド内だけで有効です.したがって,本ページのサンプルでは,システム全体としてのリダイレクトの機能は変更できません.
[備考]
[ファイル名を指定して実行] ダイアログでは,上のどちらのコードを実行してもスクリーンキーボードは起動します.
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TForm1 = class (TForm)
Edit1: TEdit;
SpeedButton10: TSpeedButton;
procedure FormShow(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
fnDisableRedirection = function (var EnableRedirect: LongBool): LongBool; stdcall ;
fnEnableRedirection = function (EnableRedirect: LongBool): LongBool; stdcall ;
fnRevertRedirection = function (EnableRedirect: LongBool): LongBool; stdcall ;
var
Form1: TForm1;
implementation
uses ShellAPI;
{$R *.DFM}
var
DisableRedirection : fnDisableRedirection;
EnableRedirection : fnEnableRedirection;
RevertRedirection : fnRevertRedirection;
// -----------------------------------------------------------------------------
// 32ビットのWindowsか64ビットのWindowsかを調べる関数
// 64ビット版のWindowsの場合はTrueを返す
// -----------------------------------------------------------------------------
function Is64bitWindows: Boolean;
var
Wow64Proc : function (hProcess: THandle; var Wow64: BOOL): BOOL stdcall ;
RetFlag : LongBool;
begin
@Wow64Proc := GetProcAddress(GetModuleHandle('Kernel32.dll' ), 'IsWow64Process' );
if @Wow64Proc <> nil then begin
Wow64Proc(GetCurrentProcess, RetFlag);
if SizeOf(THandle) = 4 then begin
Result := RetFlag;
end else
if SizeOf(THandle) = 8 then begin
Result := True;
end ;
end else begin
// Windows XP-64bit
Result := CheckWin32Version(5 , 2 );
end ;
end ;
// =============================================================================
// フォーム表示開始時の処理
// Edit1を日本語入力状態にしておく
// =============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
DllHandle : THandle;
begin
Edit1.ImeMode := imHira;
if not Is64bitWindows then exit;
DllHandle := LoadLibrary('Kernel32.dll' );
if DllHandle <> 0 then begin
DisableRedirection := GetProcAddress(DllHandle, 'Wow64DisableWow64FsRedirection' );
EnableRedirection := GetProcAddress(DllHandle, 'Wow64EnableWow64FsRedirection' );
RevertRedirection := GetProcAddress(DllHandle, 'Wow64RevertWow64FsRedirection' );
FreeLibrary(DllHandle);
end ;
end ;
// =============================================================================
// フォームを閉じる時の処理
// スクリーンキーボードは管理者権限でないと終了できないので注意
// =============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
OskHandle : HWND;
begin
OskHandle := FindWindow('OSKMainClass' , nil );
if OskHandle <> 0 then begin
PostMessage(OskHandle, WM_CLOSE, 0 , 0 );
end ;
end ;
// =============================================================================
// スクリーンキーボード(osk.exe)の起動
//
// 64ビット版Windowsで32ビットEXEの時だけリダイレクトを無効にする
// =============================================================================
procedure TForm1.SpeedButton10Click(Sender: TObject);
var
DirectFlag : LongBool;
oskFullPath : String ;
begin
if (Is64bitWindows) and (SizeOf(NativeInt) = 4 ) then begin
DisableRedirection(DirectFlag);
end ;
oskFullPath := 'C:\Windows\System32\osk.exe' ;
ShellExecute(0 , nil , PChar(oskFullPath), nil , nil , SW_SHOW);
if (Is64bitWindows) and (SizeOf(NativeInt) = 4 ) then begin
RevertRedirection(DirectFlag);
end ;
end ;
end .
02_ 管理者権限でなくてもスクリーンキーボードを終了させる
スクリーンキーボードは管理者権限で起動されます.管理者権限で起動することにより,一般ユーザで起動したアプリにも操作メッセージを送ることができます.
したがって,ユーザーインターフェイス特権の分離 (UIPI) の機能により,上のテストプログラムを管理者権限以外で起動した場合,スクリーンキーボードは終了できませんが,WMI を使用すると終了させることができます.ここでは終了させるアプリケーションの実行パス名を使用していますが,WMI ではプロセスの ID 値等を指定したりもできます.
スクリーンキーボードの実行パス名をグローバル変数にして,フォームを閉じる時のイベントを次のコードにします.
リスト2
管理者権限がなくても管理者権限で起動しているアプリを終了させる
uses に ComObj, ActiveX の追加が必要
copy code
// =============================================================================
// フォームを閉じる時の処理
// WMIを使用しているので管理者権限でなくてもスクリーンキーボードの終了が可能
// =============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
const
wbemFlagReturnImmediately = $00000010 ;
wbemFlagForwardOnly = $00000020 ;
var
OskHandle : HWND;
ProcessPath : OleVariant;
objWMILocator : OleVariant;
objWMIService : OleVariant;
colItems : OleVariant;
colItem : OleVariant;
colEnum : IEnumvariant;
iValue : LongWord;
begin
OskHandle := FindWindow('OSKMainClass' , nil );
if OskHandle <> 0 then begin
ProcessPath := oskFullPath;
ProcessPath := QuotedStr(ExtractFileName(ProcessPath));
ObjWMILocator := CreateOleObject('WbemScripting.SWbemLocator' );
ObjWMIService := ObjWMILocator.ConnectServer('' , 'root\CIMV2' );
colItems := objWMIService.ExecQuery(
'SELECT * FROM Win32_Process where name = ' + ProcessPath,
'WQL' ,
wbemFlagReturnImmediately);
// コレクションを取得
colEnum := IUnknown(colItems._NewEnum) as IEnumVariant;
// -------------------------------------------------------------------------
// 以下が各コレクションの操作コード
// -------------------------------------------------------------------------
// それを順番に取得
while colEnum.Next(1 , colItem, iValue) = 0 do begin
// 値がない場合はスキップ
if iValue <= 0 then Break;
if VarIsNull(colItem) then Continue;
colItem.Terminate;
end ;
end ;
end ;
64 ビット版の Windows 専用のテストサンプルです.64 ビット版のアプリから,32 ビットまたは 64 ビット用のシステムフォルダにアクセスするテストです.
32 ビット版の電卓と 64 ビット版の電卓の両方を起動します.
最初のサンプルでは,Wow64DisableWow64FsRedirection という関数を,ファイルシステムのリダイレクト機能を無効にするために使用しましたが,Windows XP でも動作可能にするために,DLL 内のそれらの関数の存在を確認してから使用しています.
もし,Windows 7 のように,最初からそれらの関数が実装されてるのであれば,次のように,最初から関数の定義文を書いて利用でき,コードを簡略化できます.
リダイレクトを制御するこれらの関数は,Delphi XE3 以降の FireMonkey には実装されています.
これの関数類によるリダイレクトの機能の制御は,同一スレッド内だけで有効です.したがって,システム全体としてのリダイレクトの機能は変更できません.
[備考]
リダイレクトされないフォルダ内のプログラムは,その EXE のフルパスで起動可能です.下記のリンクの記事とサンプルを参考にしてください.
[ファイルシステムリダイレクト] と [フォルダリダイレクト] とは機能が違います.これも下記のリンクの記事で確認してください.
図3
実行結果
32 ビット版の電卓と 64 ビット版の電卓が起動している
図4
タスクマネージャーで確認
calc.exe が 64 ビット版の電卓
calc.exe * 32 が 32 ビット版の電卓
リスト3
リダイレクト機能を無効にして 64 ビット版の電卓を起動
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
Button2: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
function Wow64DisableWow64FsRedirection(var flgRedirec: LongBool): LongBool; stdcall ;
external 'Kernel32.dll' Name 'Wow64DisableWow64FsRedirection' ;
function Wow64EnableWow64FsRedirection(flgRedirect: LongBool): LongBool; stdcall ;
external 'Kernel32.dll' Name 'Wow64EnableWow64FsRedirection' ;
function Wow64RevertWow64FsRedirection(flgRedirect: LongBool): LongBool; stdcall ;
external 'Kernel32.dll' Name 'Wow64RevertWow64FsRedirection' ;
var
Form1: TForm1;
implementation
uses ShellAPI;
{$R *.DFM}
// =============================================================================
// フォームを閉じる時の処理
// 起動している電卓を全て閉じる
// =============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
calcHandle : HWND;
begin
while True do begin
calcHandle := FindWindow('CalcFrame' , nil );
if calcHandle =0 then break;
PostMessage(calcHandle, WM_CLOSE, 0 , 0 );
end ;
end ;
// =============================================================================
// 64ビット版の電卓を起動
// 32ビットアプリでも64ビットアプリでも動作する
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
DirectFlag : LongBool;
calcFullPath : String ;
begin
calcFullPath := 'C:\Windows\System32\calc.exe' ;
Wow64DisableWow64FsRedirection(DirectFlag);
ShellExecute(0 , nil , PChar(calcFullPath), nil , nil , SW_SHOW);
Wow64RevertWow64FsRedirection(DirectFlag);
end ;
// =============================================================================
// 32ビット版の電卓を起動
// C:\Windows\SysWOW64\calc.exeを起動する
// =============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
calcFullPath : String ;
begin
calcFullPath := 'C:\Windows\SysWOW64\calc.exe' ;
ShellExecute(0 , nil , PChar(calcFullPath), nil , nil , SW_SHOW);
end ;
end .
04_ エクスプローラからアプリを起動するのと同じ操作を実行
これも 64 ビット版の Windows 専用のテストサンプルです.
スクリーンキーボードも電卓も,エクスプローラを表示し,該当 EXE ファイルを選択してダブルクリックまたは [Enter] キーで起動できます.
この方法であれば,システムフォルダ内の
32 ビットまたは 64 ビットのアプリのどちらでも起動することができます.
次のコードは,この操作と同じことを,ShellExecute 関数で実行するサンプルです.
ShellExecute 関数では通常,起動する EXE ファイルを指定しますが,エクスプローラからの起動と同じ操作をするためには,起動アプリを explorer.exe にして,パラメータに実際に起動するアプリケーションのフルパスを指定します.そうすると,ファイルシステムのリダイレクト機能に関係なくアプリケーションを起動できます.この時,エクスプローラそのものは起動しません.
図5
エクスプローラで calc.exe の場所を表示
calc.exe が 64 ビット版の電卓
ダブルクリックすると起動する
リスト4
エクスプローラからアプリを起動するのと同じ操作を実行
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses ShellAPI;
{$R *.DFM}
// =============================================================================
// フォームを閉じる時の処理
// 起動しているスクリーンキーボードと電卓を全て閉じる
// スクリーンキーボードは管理者権限でないと閉じることはできない
// =============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
AppHandle : HWND;
begin
while True do begin
AppHandle := FindWindow('CalcFrame' , nil );
if AppHandle =0 then break;
PostMessage(AppHandle, WM_CLOSE, 0 , 0 );
end ;
AppHandle := FindWindow('OSKMainClass' , nil );
if AppHandle <> 0 then begin
PostMessage(AppHandle, WM_CLOSE, 0 , 0 );
end ;
end ;
// =============================================================================
// 64ビット版のスクリーンキーボードを起動
// エクスプローラでC:\Windows\System32\osk.exeを起動するのと同じ操作を実行
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
AppPath : String ;
oskFullPath : String ;
begin
AppPath := 'explorer.exe' ;
oskFullPath := 'C:\Windows\System32\osk.exe' ;
ShellExecute(0 , nil , PChar(AppPath), PChar(oskFullPath), nil , SW_SHOW);
end ;
// =============================================================================
// 64ビット版の電卓を起動
// 32ビットアプリでも64ビットアプリでも動作する
// エクスプローラでC:\Windows\System32\calc.exeを起動するのと同じ操作を実行
// =============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
AppPath : String ;
calcFullPath : String ;
begin
AppPath := 'explorer.exe' ;
calcFullPath := 'C:\Windows\System32\calc.exe' ;
ShellExecute(0 , nil , PChar(AppPath), PChar(calcFullPath), nil , SW_SHOW);
end ;
// =============================================================================
// 32ビット版の電卓を起動
// エクスプローラでC:\Windows\SysWOW64\calc.exeを起動するのと同じ操作を実行
// =============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
AppPath : String ;
calcFullPath : String ;
begin
AppPath := 'explorer.exe' ;
calcFullPath := 'C:\Windows\SysWOW64\calc.exe' ;
ShellExecute(0 , nil , PChar(AppPath), PChar(calcFullPath), nil , SW_SHOW);
end ;
end .
05_ 32 ビットアプリ専用の仮想ディレクトリ Sysnative
32 ビットのアプリから
System32 フォルダにアクセスするには,仮想ディレクトリ Sysnative を使用する方法もあります.「電卓」の場合,次のコードで 64 ビット版の電卓が起動します.
Sysnative を使用すると,32 ビット版の Windows でも 64 ビット版のWindows でも System32 フォルダにアクセスできます.Sysnative は Windows Vista で実装された機能です.64 ビットアプリでは使用できません.
copy code
procedure TForm1.Button2Click(Sender: TObject);
var
calcFullPath : String ;
begin
calcFullPath := 'C:\Windows\Sysnative\calc.exe' ;
ShellExecute(0 , nil , PChar(calcFullPath), nil , nil , SW_SHOW);
end ;
スクリーンキーボードは,直接 Sysnative を使用しても起動できません.次のように 64 ビットのコマンドプロンプトの起動パラメータで指定すると起動できます.
この仕様の違いについての詳細は不明です.実際にやってみて確認するしかないようです.
copy code
procedure TForm1.SpeedButton10Click(Sender: TObject);
var
oskFullPath : String ;
begin
oskFullPath := 'C:\Windows\Sysnative\cmd.exe' ;
ShellExecute(0 , nil , PChar(oskFullPath), '/c osk.exe' , nil , SW_HIDE);
end ;
06_ TTouchKeyboard によるソフトキーボード
Delphi 2010 では,TTouchKeyboard というソフトウェアキーボードが実装されました.
下図のようなものです.タッチキーボードとなっていますが,マウスでも操作できます.リンクの記事を参考にしてください.
本サンプルは,単にフォームに配置して表示するだけとなっています.入力フォーカスがあるコントロールに,入力した文字や操作内容が送られます.
図は設計時の画像ですが,実行してもこのデザインと全く同じです.TTouchKeyboard は コンポーネントパレットの [Touch] タブにあります.
図6
リスト5
追加コードは何もなし.コンポーネントを配置しただけ
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Keyboard;
type
TForm1 = class (TForm)
TouchKeyboard1: TTouchKeyboard;
Edit1: TEdit;
private
{ Private 宣言 }
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
{$R *.DFM}
end .
07_ FireMonkey におけるファイルシステムのリダイレクトの無効化
64 ビット版の Widnows でのテスト用ですが,32 ビット版の Windows でも動作します.
上の方のサンプルの記事で,Delphi XE3 の FireMonkey でリダイレクトの機能を無効化する関数が実装されたと書きました.それを実際に確認してみます.添付のプロジェクトは,
Windows 7 U64(SP1) + Delphi XE5(UP2) Pro + FireMonkey HD アプリケーション
で動作確認しています.
FireMonkey は,Delphi のバージョンによって,仕様,機能共に多少違いがあります.他のバージョンの FireMonkey で使用する場合は修正が必要です.修正したら再構築あるいはビルドします.
Windows の機能を使用するために,uses に FMX.Platform.Win, Winapi.Windows を追加
ShellExecute 関数を使用するために uses に Winapi.ShellAPI を追加
しています.
[備考 1]
uses に追加した Winapi.Windows と Winapi.ShellAPI は RTL (ランタイムライブラリ) が提供している機能です.これらのソースコードは rtf フォルダの階層下にあります.FireMonkey では,RTL の機能は利用できますが,VCL そのものは使用できません.
[備考 2]
FireMonkey はグラフィックス関係の豊富な機能が実装されています.本サンプルのように,Windows 専用のアプリケーションを開発するにしても,使用価値はあるのではないかと思われます.
機能が豊富な分,作成された実行ファイル,EXE のサイズは必然的に大きくなります.
図7
設計時画面
図8
実行して電卓を起動
リスト6
FireMonkey におけるファイルシステムのリダイレクトの無効化
copy code
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls;
type
TForm1 = class (TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ private 宣言 }
public
{ public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
FMX.Platform.Win, Winapi.Windows, Winapi.ShellAPI;
{$R *.fmx}
// =============================================================================
// System32内のスクリーンキーボードを起動
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
DirectFlag : Boolean;
AppFullPath : String ;
begin
AppFullPath := 'C:\Windows\System32\osk.exe' ;
Wow64DisableRedirection(DirectFlag);
ShellExecute(0 , nil , PChar(AppFullPath), nil , nil , SW_SHOW);
Wow64EnableRedirection(DirectFlag);
end ;
// =============================================================================
// System32内の電卓を起動
// =============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
DirectFlag : Boolean;
AppFullPath : String ;
begin
AppFullPath := 'C:\Windows\System32\calc.exe' ;
Wow64DisableRedirection(DirectFlag);
ShellExecute(0 , nil , PChar(AppFullPath), nil , nil , SW_SHOW);
Wow64EnableRedirection(DirectFlag);
end ;
end .