Skip to content

Instantly share code, notes, and snippets.

@DelphiWorlds
Last active January 21, 2019 03:42
Show Gist options
  • Save DelphiWorlds/2098ebafd20aa43f6c5a69503b06c4ca to your computer and use it in GitHub Desktop.
Save DelphiWorlds/2098ebafd20aa43f6c5a69503b06c4ca to your computer and use it in GitHub Desktop.
Work in progress to handle when the Windows 10 OSK shows/hides
unit FrameworkInputPaneHandler;
interface
uses
System.Win.ComObj,
Winapi.Windows;
// https://github.com/tpn/winsdk-10/blob/master/Include/10.0.10240.0/um/ShObjIdl.idl
const
CLSID_FrameworkInputPane: TGUID = '{D5120AA3-46BA-44C5-822D-CA8092C1FC72}';
SID_IFrameworkInputPane = '{5752238B-24F0-495A-82F1-2FD593056796}';
SID_IFrameworkInputPaneHandler = '{226C537B-1E76-4D9E-A760-33DB29922F18}';
type
IFrameworkInputPaneHandler = interface(IUnknown)
[SID_IFrameworkInputPaneHandler]
function Hiding(var fEnsureFocusedElementInView: BOOL): HResult; stdcall;
function Showing(var rcInputPaneScreenLocation: TRect; var fEnsureFocusedElementInView: BOOL): HResult; stdcall;
end;
IFrameworkInputPane = interface(IUnknown)
[SID_IFrameworkInputPane]
function Advise(var window: IUnknown; handler: IFrameworkInputPaneHandler; var dwCookie: DWORD): HResult; stdcall;
function AdviseWithHWND(hwnd: HWND; handler: IFrameworkInputPaneHandler; var dwCookie: DWORD): HResult; stdcall;
function Unadvise(dwCookie: DWORD): HResult; stdcall;
function Location(var rcInputPaneScreenLocation: TRect): HResult; stdcall;
end;
TInputPaneHidingEvent = procedure(Sender: TObject; var EnsureFocusedElementInView: Boolean) of object;
TInputPaneShowingEvent = procedure(Sender: TObject; const Rect: TRect; var EnsureFocusedElementInView: Boolean) of object;
TFrameworkInputPaneHandler = class(TInterfacedObject, IFrameworkInputPaneHandler)
private
FAdviseCookie: DWORD;
FInputPane: IFrameworkInputPane;
FOnInputPaneHiding: TInputPaneHidingEvent;
FOnInputPaneShowing: TInputPaneShowingEvent;
protected
{ IFrameworkInputPaneHandler }
function Hiding(var fEnsureFocusedElementInView: BOOL): HResult; stdcall;
function Showing(var rcInputPaneScreenLocation: TRect; var fEnsureFocusedElementInView: BOOL): HResult; stdcall;
public
constructor Create(const AWnd: HWND);
destructor Destroy; override;
property OnInputPaneHiding: TInputPaneHidingEvent read FOnInputPaneHiding write FOnInputPaneHiding;
property OnInputPaneShowing: TInputPaneShowingEvent read FOnInputPaneShowing write FOnInputPaneShowing;
end;
implementation
uses
Winapi.ActiveX;
{ TFrameworkInputPaneHandler }
constructor TFrameworkInputPaneHandler.Create(const AWnd: HWND);
begin
// I am using the Handle property of the main form to pass as the AWnd parameter
inherited Create;
CoCreateInstance(CLSID_FrameworkInputPane, nil, CLSCTX_INPROC_SERVER, StringToGUID(SID_IFrameworkInputPane), FInputPane);
FInputPane.AdviseWithHWND(AWnd, Self as IFrameworkInputPaneHandler, FAdviseCookie);
end;
destructor TFrameworkInputPaneHandler.Destroy;
begin
FInputPane.Unadvise(FAdviseCookie);
FInputPane := nil;
inherited;
end;
function TFrameworkInputPaneHandler.Hiding(var fEnsureFocusedElementInView: BOOL): HResult;
begin
// Intention here is to call the event handler
end;
function TFrameworkInputPaneHandler.Showing(var rcInputPaneScreenLocation: TRect; var fEnsureFocusedElementInView: BOOL): HResult;
begin
// Intention here is to call the event handler
end;
end.
@DelphiWorlds
Copy link
Author

Not working at present. System seems to call Hiding instead of Showing when the OSK shows, and it throws an AV. I'm guessing I've screwed up a method declaration somewhere..

@SSchiele
Copy link

Here's a corrected and working implementation. Successfully tested under Windows 10 version 1803.

unit FrameworkInputPaneHandler;

(* *****************************************************************************

  2018-09-28 STS
  - interface declaration optimized
  - single event handler for showing/hiding

***************************************************************************** *)

interface

uses
  ComObj, Windows;

const
  CLSID_FrameworkInputPane: TGUID = '{D5120AA3-46BA-44C5-822D-CA8092C1FC72}';
  SID_IFrameworkInputPane = '{5752238B-24F0-495A-82F1-2FD593056796}';
  SID_IFrameworkInputPaneHandler = '{226C537B-1E76-4D9E-A760-33DB29922F18}';

type
  IFrameworkInputPaneHandler = interface(IInterface)
    [SID_IFrameworkInputPaneHandler]
    function Showing(var rcInputPaneScreenLocation: TRect; fEnsureFocusedElementInView: BOOL): HResult; stdcall;
    function Hiding(fEnsureFocusedElementInView: BOOL): HResult; stdcall;
  end;

  IFrameworkInputPane = interface(IInterface)
    [SID_IFrameworkInputPane]
    function Advise(window: IUnknown; handler: IFrameworkInputPaneHandler; var dwCookie: DWORD): HResult; stdcall;
    function AdviseWithHWND(hwnd: HWND; handler: IFrameworkInputPaneHandler; var dwCookie: DWORD): HResult; stdcall;
    function Unadvise(dwCookie: DWORD): HResult; stdcall;
    function Location(var rcInputPaneScreenLocation: TRect): HResult; stdcall;
  end;

  TTouchKeyboardChangeEvent = procedure(Sender: TObject; IsShowing: Boolean; const Rect: TRect; EnsureFocusedElementInView: Boolean) of object;

  TFrameworkInputWrapper = class(TInterfacedObject, IFrameworkInputPaneHandler)
  private
    FAdviseCookie: DWORD;
    FInputPane: IFrameworkInputPane;
    FOnTouchKeyboardVisibilityChanged: TTouchKeyboardChangeEvent;
  protected
  public
    { IFrameworkInputPaneHandler }
    function Showing(var rcInputPaneScreenLocation: TRect; fEnsureFocusedElementInView: BOOL): HResult; stdcall;
    function Hiding(fEnsureFocusedElementInView: BOOL): HResult; stdcall;

    constructor Create(const AWnd: HWND);
    destructor Destroy; override;
    function GetLocation(var rt: TRECT): Boolean;
    property OnTouchKeyboardChanged: TTouchKeyboardChangeEvent read FOnTouchKeyboardVisibilityChanged write FOnTouchKeyboardVisibilityChanged;
  end;

implementation

uses
  ActiveX;

{ TFrameworkInputWrapper }

constructor TFrameworkInputWrapper.Create(const AWnd: HWND);
var hr: HRESULT;
begin
  // I am using the Handle property of the main form to pass as the AWnd parameter
  inherited Create();

  FAdviseCookie := 0;
  FInputPane    := nil;
  FOnTouchKeyboardVisibilityChanged := nil;

  hr := CoCreateInstance(CLSID_FrameworkInputPane, nil, CLSCTX_ALL {CLSCTX_INPROC_SERVER}, StringToGUID(SID_IFrameworkInputPane), FInputPane);

  if not FAILED(hr) and Assigned(FInputPane) then
  begin
    hr := FInputPane.AdviseWithHWND(AWnd, Self as IFrameworkInputPaneHandler, FAdviseCookie);
  end;

end;

destructor TFrameworkInputWrapper.Destroy();
begin

  if Assigned(FInputPane) then
  begin
    FInputPane.Unadvise(FAdviseCookie);
    FInputPane := nil;
  end;

  inherited Destroy();
end;

function TFrameworkInputWrapper.GetLocation(var rt: TRECT): Boolean;
begin

  Result := FALSE;

  if Assigned(FInputPane) then
  begin
    Result := not FAILED(FInputPane.Location(rt));
  end;
end;

function TFrameworkInputWrapper.Hiding(fEnsureFocusedElementInView: BOOL): HResult;
var tr: TRECT;
begin

  if Assigned(FOnTouchKeyboardVisibilityChanged) then
  begin

    tr.Left   := 0;
    tr.Top    := 0;
    tr.Right  := 0;
    tr.Bottom := 0;

    FOnTouchKeyboardVisibilityChanged(self, FALSE, tr, fEnsureFocusedElementInView);
  end;

  Result := S_OK;
end;

function TFrameworkInputWrapper.Showing(var rcInputPaneScreenLocation: TRect; fEnsureFocusedElementInView: BOOL): HResult;
begin

  if Assigned(FOnTouchKeyboardVisibilityChanged) then
  begin

    FOnTouchKeyboardVisibilityChanged(self, TRUE, rcInputPaneScreenLocation, fEnsureFocusedElementInView);
  end;

  Result := S_OK;
end;

end.

@DelphiWorlds
Copy link
Author

Thanks, @SSchiele! I've only just come across this..

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment