unit Common.Classes.OSK
platform;
interface
uses Winapi.Windows;
type
/// <summary>
/// Wrapper für die <i>TabTip</i>-Bildschirmtastatur von Windows
/// </summary>
/// <remarks>
/// Die Singleton-Instanz ist die globale Variable <see cref="TabTip" />
/// </remarks>
TTabTip =
record
private var
exePath:
String;
procedure determineExePath();
/// <returns>
/// Gibt <c>0</c> zurück wenn das Fenster nicht gefunden wurde
/// </returns>
function determineHWND(): HWND;
public
procedure launch(
const parentHWND: HWND = 0);
/// <summary>
/// Blendet das Fenster freundlich aus. Der <c>TabTip.exe</c>-Prozess
/// wird nicht geschlossen
/// </summary>
procedure close();
/// <summary>
/// Schießt den <c>TabTip.exe</c>-Prozess mit Gewalt ab. Das nächste
/// <see cref="launch">Starten</see> hat zur Folge dass die
/// Einstellungen aus der Registry neu gelesen werden
/// </summary>
procedure termiante();
function isVisible(): Boolean;
end;
var
TabTip: TTabTip;
implementation uses
System.IOUtils, System.SysUtils, System.Win.Registry,
Winapi.ShellApi,
Winapi.Messages,
Winapi.TlHelp32
;
function ExpandEnvironmentVariables(
const variable:
string):
string;
var
len: DWORD;
begin
len := MAX_PATH;
SetLength(Result, len);
len :=
WinApi.Windows.ExpandEnvironmentStrings(PChar(variable), PChar(Result), len);
Win32Check(len > 0);
SetLength(Result, len - 1);
end;
{ TTabTip }
function determineProcessHandleForExeName(
const exeName:
String;
out processHandle: THandle
): Boolean;
var
snapShot: THandle;
process: TProcessEntry32;
pid: DWORD;
begin
Result := False;
snapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
process.dwSize := SizeOf(TProcessEntry32);
if Process32First(snapShot, process)
then
while Process32Next(snapShot, process)
do
if String(process.szExeFile).ToLowerInvariant() = exeName
then begin
pid := process.th32ProcessID;
processHandle := OpenProcess(PROCESS_TERMINATE, False, pid);
Exit(True);
end;
finally
CloseHandle(snapShot);
end;
end;
procedure TTabTip.close();
var
windowHandle: HWND;
begin
windowHandle := determineHWND();
PostMessage(windowHandle, WM_SYSCOMMAND, SC_CLOSE, 0);
end;
procedure TTabTip.determineExePath();
const
path = '
SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\TabTip.exe';
hardcodedPath = '
C:\Program Files\Common Files\microsoft shared\ink\TabTip.exe';
errorMsg = '
The executable for "TabTip" cannot be found';
var
registry: TRegistry;
registryValue:
String;
begin
{TODO -oJM -cGeneral : Eine 32-Bit-Anwendung muss auf einem 64-Bit OS
trotzdem das 64-Bit OSK aufrufen. Deshalb sollten wir mittels dem
KEY_WOW64_64KEY-Flag in die 64-Bit-Registry schauen und die
dort vorhandene Umgebungsvariable nach 64-Bit-Art expandieren. Aber wie
das gehen soll ist mir schleierhaft.
Außerdem muss das noch auf einem 32-Bit OS getestet werden}
registry := TRegistry.Create(KEY_READ
or KEY_WOW64_64KEY);
try
registry.RootKey := HKEY_LOCAL_MACHINE;
registry.OpenKeyReadOnly(path);
registryValue := registry.ReadString(EmptyStr);
exePath := ExpandEnvironmentVariables(registryValue);
finally
registry.Destroy();
end;
if not TFile.Exists(exePath)
then exePath := hardcodedPath;
if not TFile.Exists(exePath)
then raise EFileNotFoundException.Create(errorMsg);
end;
function TTabTip.determineHWND(): HWND;
const
windowName: PChar = '
IPTip_Main_Window';
begin
Result := FindWindow(windowName,
nil);
end;
function TTabTip.isVisible(): Boolean;
begin
Result := determineHWND() <> 0
end;
procedure TTabTip.launch(
const parentHWND: HWND = 0);
begin
if exePath.IsEmpty()
then determineExePath();
if ShellExecute(parentHWND, '
open', PChar(exePath),
nil,
nil, SW_SHOWNA) < 32
then RaiseLastOSError();
end;
procedure TTabTip.termiante();
var
processHandle: THandle;
begin
if determineProcessHandleForExeName('
tabtip.exe', processHandle)
then
Win32Check( TerminateProcess(processHandle, ERROR_SUCCESS) );
end;
end.