Einzelnen Beitrag anzeigen

Der schöne Günther

Registriert seit: 6. Mär 2013
6.156 Beiträge
 
Delphi 10 Seattle Enterprise
 
#6

AW: Handschriften-Erkennung

  Alt 27. Mär 2015, 13:42
Ich hatte damit einmal angefangen aber es nie ganz fertig gestellt. Schau mal ob du damit etwas anfangen kannst:

Delphi-Quellcode:
unit TabTip_ 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
         windowHandle:   HWND;
         exePath:      String;

         procedure determineExePath();
         /// <returns>
         /// Gibt <c>0</c> zurück wenn das Fenster nicht gefunden wurde
         /// </returns>
         function determineHWND(): HWND;

      private
         procedure setHandWriting(const isEnabled: Boolean);
//      public const
//         DOCK_BOTTOM   =   10021;
//         DOCK_TOP   =   10023;
//         FLOATING   =   10020;

      public var
         handWriting: Boolean;

      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();

         //procedure setPosition(const position: Word);
   end;

var
   TabTip: TTabTip;


implementation uses
   System.IOUtils, System.SysUtils, System.Win.Registry,
   Winapi.ShellApi, Winapi.Messages, Winapi.TlHelp32,
   Spring.Utils
;

{ 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();
const
   messageName:   PChar = 'IPTipDockButtonPressed';
var
   dockButtonPressed:   DWORD;
   windowHandle:      HWND;
begin
    dockButtonPressed := RegisterWindowMessage(messageName);
    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;
   fileName:      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);
   try
      registry.RootKey := HKEY_LOCAL_MACHINE;
      registry.OpenKeyReadOnly(path);
      registryValue := registry.ReadString(EmptyStr);
      exePath := TEnvironment.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;


procedure TTabTip.launch(const parentHWND: HWND = 0);
begin
   if exePath.IsEmpty() then determineExePath();
   setHandWriting(handWriting);
   ShellExecute(parentHWND, 'open', PChar(exePath), nil, nil, SW_SHOWNA);
end;

procedure TTabTip.SetHandWriting(const isEnabled: Boolean);
const
   path = 'SOFTWARE\Microsoft\TabletTip\1.7';
   keyName = 'LastUsedModalityWasHandwriting';
var
   registry: TRegistry;
begin
   registry := TRegistry.Create(KEY_READ or KEY_WRITE or KEY_WOW64_64KEY);
   try
      registry.RootKey := HKEY_CURRENT_USER;
      if not registry.OpenKey(path, False) then RaiseLastOSError();

      registry.WriteInteger( keyName, isEnabled.ToInteger() );
   finally
      registry.Destroy();
    end;
end;

procedure TTabTip.termiante();
var
   processHandle:   THandle;
begin
   if determineProcessHandleForExeName('tabtip.exe', processHandle) then
      Win32Check( TerminateProcess(processHandle, ERROR_SUCCESS) );
end;

//procedure TTabTip.setPosition(const position: Word);
//const
//   errorMsg = 'position (%d) was not within the allowed range';
//var
//   windowHandle:   HWND;
//begin
//   if (position <> DOCK_BOTTOM) and (position <> DOCK_TOP) and (position <> FLOATING) then raise
//      EArgumentOutOfRangeException.Create(errorMsg);
//
//   windowHandle := determineHWND();
//   PostMessage(windowHandle, WM_COMMAND, MakeWParam(position, 0), LPARAM(0));
//end;

end.
Da das "Handwriting an/aus" über die Registry geht und mir nichts besseres eingefallen ist muss man das Tabtip vor dem Ändern mit Gewalt abschießen:

Delphi-Quellcode:
   TabTip.launch();
   ReadLn;
   TabTip.termiante();
   TabTip.handWriting := True;
   TabTip.launch();
  Mit Zitat antworten Zitat