Virtuelles Keyboard für ein bestimmtes Control deaktivieren

[DeddyH]

Ich habe hier für eine Fummellösung (immer noch die Scanner-Geschichte) ein Edit, das zwar den Fokus erhalten soll, aber ohne dass dabei die virtuelle Tastatur hochklappt. Auf SO habe ich diesen Thread dazu gefunden. Ausprobiert, funktioniert. Was mich ein wenig dabei stört: man muss das virtuelle Keyboard komplett deaktivieren (VKAutoShowMode auf TVKAutoShowMode.Never) und es dann bei jedem anderen eingabefähigen Control manuell aufrufen, andersherum scheint es nicht zu funktionieren. Mache ich etwas falsch, oder ist das dann eben so?

[HolgerX]

Kenne mich mit den Tastaturen zwar nicht aus,

aber kannst du beim OnEnter in dieses Edit die Tastatur nicht deaktivieren und beim OnExit wieder aktivieren?

Von der Logic also umgedreht zu dem Beispiel in deinem Link.

Dort wird die Tastatur generell ausgeschaltet und beim OnEnter aktiviert...

Nur so ne Idee.. ;)

[DeddyH]

Exakt das habe ich ja versucht, leider tut das nicht so wie gewollt. Das war ja meine Frage ;)

[Sir Rufo]

Dieses VK ist schon als ein ganz übler Timer-Dschungel konzipiert. Da bleibt nur die Option, diese Automatik auszuschalten und selber zu implementieren.

Hier mal so ein VirtualKeyboardService. Der läuft auf Android (nach einem kurzen Test) recht brauchbar und auf Windows kann der sich auch schon mal verhaspeln (allerdings auch nicht mehr, als es das Standard-Verhalten auch macht).

Delphi-Quellcode:

unit Common.FMX.VirtualKeyboardService;

interface

uses
  FMX.Types,
  FMX.VirtualKeyboard,
  System.Generics.Collections,
  System.Classes,
  System.Messaging;

type
  TVirtualKeyboardService = class( TComponent )
  private type
    TVKState = ( Hidden, Showing, Visible, Hiding );
  private
    FVKSvc: IFMXVirtualKeyboardService;
    FState: TVKState;
    FObjects: TList<TFmxObject>;
    constructor Create( AOwner: TComponent );
    class constructor Create;

    procedure DoWork( );

    procedure HandleIdleMessage( const Sender: TObject; const M: System.Messaging.TMessage );
    procedure HandleVKStateChangeMessage( const Sender: TObject; const M: System.Messaging.TMessage );
  protected
    procedure Notification( AComponent: TComponent; Operation: TOperation ); override;
  public
    class function Current: TVirtualKeyboardService;
    destructor Destroy; override;

    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

    procedure AddOverrideObject( AObject: TFmxObject );
    procedure RemoveOverrideObject( AObject: TFmxObject );
    function IsOverriddenObject( AObject: TFmxObject ): Boolean;
  private
    class var _current: TVirtualKeyboardService;
  end;

implementation

uses
  System.SysUtils,
  FMX.Forms,
  FMX.Platform;

{ TVirtualKeyboardService }

constructor TVirtualKeyboardService.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  if TPlatformServices.Current.SupportsPlatformService( IFMXVirtualKeyboardService, FVKSvc ) then
    VKAutoShowMode := TVKAutoShowMode.Never;
  FObjects := TList<TFmxObject>.Create;
end;

procedure TVirtualKeyboardService.AddOverrideObject( AObject: TFmxObject );
begin
  if Supports( AObject, IVirtualKeyboardControl ) and not FObjects.Contains( AObject ) then
  begin
    FObjects.Add( AObject );
    Self.FreeNotification( AObject );
  end;
end;

procedure TVirtualKeyboardService.AfterConstruction;
begin
  inherited;
  TMessageManager.DefaultManager.SubscribeToMessage( TVKStateChangeMessage, HandleVKStateChangeMessage );
  TMessageManager.DefaultManager.SubscribeToMessage( TIdleMessage, HandleIdleMessage );
end;

procedure TVirtualKeyboardService.BeforeDestruction;
begin
  TMessageManager.DefaultManager.Unsubscribe( TIdleMessage, HandleIdleMessage );
  TMessageManager.DefaultManager.Unsubscribe( TVKStateChangeMessage, HandleVKStateChangeMessage );
  inherited;
end;

class constructor TVirtualKeyboardService.Create;
begin
  TVirtualKeyboardService._current := TVirtualKeyboardService.Create( Application );
end;

class function TVirtualKeyboardService.Current: TVirtualKeyboardService;
begin
  Result := _current;
end;

destructor TVirtualKeyboardService.Destroy;
begin
  FObjects.Free;
  inherited;
end;

procedure TVirtualKeyboardService.DoWork;
var
  LCurrentObject: TFmxObject;
  LNewState: TVKState;
begin
  if not Assigned( FVKSvc ) or not( VKAutoShowMode = TVKAutoShowMode.Never ) then
    Exit;

  LCurrentObject := nil;
  if Assigned( Screen.ActiveForm ) and Assigned( Screen.ActiveForm.Focused ) then
    LCurrentObject := Screen.ActiveForm.Focused.GetObject;

  if ( LCurrentObject = nil ) or not Supports( LCurrentObject, IVirtualKeyboardControl ) or FObjects.Contains( LCurrentObject ) then
    LNewState := TVKState.Hidden
  else
    LNewState := TVKState.Visible;

  if FState <> LNewState then
  begin
    if ( LNewState = TVKState.Hidden ) and ( FState = TVKState.Hiding ) then
      Exit;
    if ( LNewState = TVKState.Visible ) and ( FState = TVKState.Showing ) then
      Exit;

    case LNewState of
      Hidden:
        begin
          FVKSvc.HideVirtualKeyboard;
          FState := TVKState.Hiding;
        end;
      Visible:
        begin
          FVKSvc.ShowVirtualKeyboard( LCurrentObject );
          FState := TVKState.Showing;
        end;
    end;
  end;
end;

procedure TVirtualKeyboardService.HandleIdleMessage( const Sender: TObject; const M: System.Messaging.TMessage );
begin
  DoWork( );
end;

procedure TVirtualKeyboardService.HandleVKStateChangeMessage( const Sender: TObject; const M: System.Messaging.TMessage );
var
  LMsg: TVKStateChangeMessage absolute M;
begin
  if LMsg.KeyboardVisible then
    FState := TVKState.Visible
  else
    FState := TVKState.Hidden;
end;

function TVirtualKeyboardService.IsOverriddenObject( AObject: TFmxObject ): Boolean;
begin
  Result := FObjects.Contains( AObject );
end;

procedure TVirtualKeyboardService.Notification( AComponent: TComponent; Operation: TOperation );
begin
  inherited;
  if ( Operation = opRemove ) and ( AComponent is TFmxObject ) then
  begin
    RemoveOverrideObject( AComponent as TFmxObject );
  end;
end;

procedure TVirtualKeyboardService.RemoveOverrideObject( AObject: TFmxObject );
begin
  if FObjects.Contains( AObject ) then
  begin
    FObjects.Remove( AObject );
    Self.RemoveFreeNotification( AObject );
  end;
end;

end.

Die Verwendung ist eigentlich recht simpel:

Delphi-Quellcode:

unit Form.MainForm;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.Edit, FMX.StdCtrls, FMX.ScrollBox, FMX.Memo,
  FMX.Layouts, FMX.ListBox;

type
  TMainForm = class( TForm )
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
  private
  public
    procedure AfterConstruction; override;

  end;

var
  MainForm: TMainForm;

implementation

{$R *.fmx}

uses
  Common.FMX.VirtualKeyboardService;

procedure TMainForm.AfterConstruction;
begin
  inherited;
  TVirtualKeyboardService.Current.AddOverrideObject( Edit2 );
end;

end.

Und schon hat

Delphi-Quellcode:

Edit2

kein VirtualKeyboard mehr ...

[DeddyH]

Herzlichen Dank, das probiere ich gleich aus (Android genügt mir erstmal völlig).

[edit] Funktioniert in ersten Tests ganz hervorragend. Hat das einen Grund, dass Du den Konstruktor verdeckt und in den private-Abschnitt verschoben hast? Ich habe ihn mal überschrieben und wieder unter public verschoben, ohne dass ich irgendwelche negativen Folgen beobachten konnte. [/edit]

[Sir Rufo]

Ja, der Grund dafür ist, dass es sich um ein Singleton handelt und es von diesem Service nicht mehr als einen geben sollte.

Das Verschieben des Konstruktors ist daher Selbstschutz und Dokumentation für: Achtung, ein Singleton!

Allerdings habe ich festgestellt, dass ich das viel zu kompliziert angegangen bin und eine Umsetzung viel schonender erfolgen kann.

Delphi-Quellcode:

unit Common.FMX.VirtualKeyboardService;

interface

uses
  System.Classes,
  System.Generics.Collections,
  FMX.Types,
  FMX.VirtualKeyboard;

type
  TVirtualKeyboardService = class( TComponent, IFMXVirtualKeyboardService )
  private
    FObjects: TList<TFmxObject>;
    FOriginalService: IFMXVirtualKeyboardService;
    constructor Create( AOwner: TComponent );
    class constructor Create;
  protected
    function GetVirtualKeyboardState: TVirtualKeyboardStates;
    function HideVirtualKeyboard: Boolean;
    procedure SetTransientState( Value: Boolean );
    function ShowVirtualKeyboard( const AControl: TFmxObject ): Boolean;
    procedure Notification( AComponent: TComponent; Operation: TOperation ); override;
  public
    class function Current: TVirtualKeyboardService;
    destructor Destroy; override;

    procedure AddOverrideObject( AObject: TFmxObject );
    procedure RemoveOverrideObject( AObject: TFmxObject );
    function IsOverriddenObject( AObject: TFmxObject ): Boolean;
  private
    class var _current: TVirtualKeyboardService;
  end;

implementation

uses
  FMX.Forms,
  FMX.Platform,
  System.SysUtils;

{ TVirtualKeyboardService }

constructor TVirtualKeyboardService.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );

  FObjects := TList<TFmxObject>.Create;

  if TPlatformServices.Current.SupportsPlatformService( IFMXVirtualKeyboardService, FOriginalService ) then
  begin
    TPlatformServices.Current.RemovePlatformService( IFMXVirtualKeyboardService );
    TPlatformServices.Current.AddPlatformService( IFMXVirtualKeyboardService, Self );
  end;
end;

procedure TVirtualKeyboardService.AddOverrideObject( AObject: TFmxObject );
begin
  if Supports( AObject, IVirtualKeyboardControl ) and not FObjects.Contains( AObject ) then
  begin
    FObjects.Add( AObject );
    Self.FreeNotification( AObject );
  end;
end;

class constructor TVirtualKeyboardService.Create;
begin
  TVirtualKeyboardService._current := TVirtualKeyboardService.Create( Application );
end;

class function TVirtualKeyboardService.Current: TVirtualKeyboardService;
begin
  Result := TVirtualKeyboardService._current;
end;

destructor TVirtualKeyboardService.Destroy;
begin
  if Assigned( FOriginalService ) then
  begin
    TPlatformServices.Current.RemovePlatformService( IFMXVirtualKeyboardService );
    TPlatformServices.Current.AddPlatformService( IFMXVirtualKeyboardService, FOriginalService );
  end;
  FObjects.Free;
  inherited;
end;

function TVirtualKeyboardService.GetVirtualKeyboardState: TVirtualKeyboardStates;
begin
  Result := FOriginalService.VirtualKeyboardState;
end;

function TVirtualKeyboardService.HideVirtualKeyboard: Boolean;
begin
  Result := FOriginalService.HideVirtualKeyboard;
end;

function TVirtualKeyboardService.IsOverriddenObject( AObject: TFmxObject ): Boolean;
begin
  Result := FObjects.Contains( AObject );
end;

procedure TVirtualKeyboardService.Notification( AComponent: TComponent; Operation: TOperation );
begin
  inherited;
  if ( Operation = opRemove ) and ( AComponent is TFmxObject ) then
  begin
    RemoveOverrideObject( AComponent as TFmxObject );
  end;
end;

procedure TVirtualKeyboardService.RemoveOverrideObject( AObject: TFmxObject );
begin
  if FObjects.Contains( AObject ) then
  begin
    FObjects.Remove( AObject );
    Self.RemoveFreeNotification( AObject );
  end;
end;

procedure TVirtualKeyboardService.SetTransientState( Value: Boolean );
begin
  FOriginalService.SetTransientState( Value );
end;

function TVirtualKeyboardService.ShowVirtualKeyboard( const AControl: TFmxObject ): Boolean;
begin
  if IsOverriddenObject( AControl ) then
  begin
    HideVirtualKeyboard;
    Result := False;
  end
  else
    Result := FOriginalService.ShowVirtualKeyboard( AControl );
end;

end.

[Mavarik]

Nicht das ich die Routine nicht Cool finde, aber was macht man mit einer Eingabe die keine Tastatur hoch bringt?

[Union]

Und ich frage mich, die wievielte individuelle Implementierung ich davon sehe ;)

[Sir Rufo]

Zitat:

Zitat von Union (Beitrag 1309995)

Und ich frage mich, die wievielte individuelle Implementierung ich davon sehe ;)

Stimmt, ich hätte noch eine Implementierung, die auch sehr fix zu machen ist:

Delphi-Quellcode:

// No Virtual Keyboard when ReadOnly
Edit1.ReadOnly := True;

Aber dann ist es eben ein ReadOnly-Edit ;)

[Mavarik]

Zitat:

Zitat von Sir Rufo (Beitrag 1309998)

Zitat:

Zitat von Union (Beitrag 1309995)

Und ich frage mich, die wievielte individuelle Implementierung ich davon sehe ;)

Stimmt, ich hätte noch eine Implementierung, die auch sehr fix zu machen ist:

Delphi-Quellcode:

// No Virtual Keyboard when ReadOnly
Edit1.ReadOnly := True;

Aber dann ist es eben ein ReadOnly-Edit ;)

Ist ja egal hast eh keine Tastatur zum tippen... :stupid: