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 ビット版かを判定するコードと、リダイレクトの機能の無効して元に戻すコードを追加しています。
本ページのサンプルでのリダイレクトの機能の制御は、スレッド内だけで有効です。したがって、本ページのサンプルでは、システム全体としてのリダイレクトの機能は変更できません。


[備考]
[ファイル名を指定して実行] ダイアログでは、上のどちらのコードを実行してもスクリーンキーボードは起動します。



  • 図2
  • 実行例

リスト1
スクリーンキーボードを起動		 
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 の追加が必要 
//=============================================================================
//  フォームを閉じる時の処理
//  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;



03_ファイルシステムのリダイレクト機能の無効化


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 ビット版の電卓を起動		 
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
エクスプローラからアプリを起動するのと同じ操作を実行		 
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 ビットアプリでは使用できません。		 


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 ビットのコマンドプロンプトの起動パラメータで指定すると起動できます。
この仕様の違いについての詳細は不明です。実際にやってみて確認するしかないようです。		 


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
追加コードは何もなし。コンポーネントを配置しただけ		 
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 におけるファイルシステムのリダイレクトの無効化		 
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.