TEdit (FMX) pastefromClipboard verhindern

[Rollo62]

Man könnte das auf diese Art versuchen, indem man ein neues, StyledControl dafür anlegt.
Ich kombiniere sowas gerne mit Interposern, um dann dem Edit neue Funktionalität zu geben.
Ansonsten müsste man ein CustomControl anlegen, aber das ist mir zu viel Aufwand.
Man muss das mal mit allen Platformen Testen, das hier sollte erstmal mit Windows Ctrl-V funktionieren.


TStyledEditNoPaste

Delphi-Quellcode:

unit S4.FMX.Edit.Style;

interface

uses
    System.Classes
  , System.UITypes
  //
  , FMX.Edit.Style
  //
  , S4.FMX.Edit
  ;



//##
//## !! Custom Styled control
//##
type
     // custom Styled edit
     TStyledEditNoPaste = class( FMX.Edit.Style.TStyledEdit )
        private
            FPasteAllowed : Boolean;

        protected
            procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override;

        public
          constructor Create(AOwner: TComponent); override;

          property PasteAllowed : Boolean read FPasteAllowed  write FPasteAllowed;
     end;








implementation

Uses
    FMX.Controls
  , FMX.Presentation.Style
  , FMX.Presentation.Factory
  ;



{ TStyledEditNoPaste }

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

    FPasteAllowed := True;  // Default as normal Edit
end;

procedure TStyledEditNoPaste.KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState);
var
    LIsCtrlOrCmd : Boolean;
begin

    LIsCtrlOrCmd := Shift * [ssCtrl, ssCommand] <> [];

    case Key of
      vkV:
          if LIsCtrlOrCmd then
          begin
              //Edit.PasteFromClipboard;
              if not FPasteAllowed then
              begin
                  //if KeyHandled then
                  Key     :=  0;
                  KeyChar := #0;

                  Exit; //<====================================================
              end;
          end;
    end;


    inherited;
end;


initialization
    TPresentationProxyFactory.Current.Register(  'Edit-no-paste',              TStyledPresentationProxy< TStyledEditNoPaste > );

finalization
    TPresentationProxyFactory.Current.Unregister( 'Edit-no-paste',             TStyledPresentationProxy< TStyledEditNoPaste > );

end.

Ein Interposer TEdit, welcher die neue Funktionalität dabei hat

Delphi-Quellcode:

unit S4.FMX.Edit;

interface

uses
    System.SysUtils
  , System.Classes
  , System.UITypes
  , System.Types
  //
  , FMX.Types
  , FMX.Controls
  , FMX.Edit
  ;



//##
//## !! Class devive and override, to allow usage with fields in class helper
//##
type
     // type interposer for TEdit
     TEdit = class( FMX.Edit.TEdit )
  private
       function  GetPasteAllowed              : Boolean;
       procedure SetPasteAllowed( const Value : Boolean );

     protected
        function  DefinePresentationName                           : string; override;

     public
        constructor Create(AOwner: TComponent); override;
        destructor  Destroy;                    override;

        property  PasteAllowed : Boolean read GetPasteAllowed  write SetPasteAllowed;
     end;








implementation

Uses
    S4.FMX.Edit.Style
  ;



{ TEdit }

constructor TEdit.Create(AOwner: TComponent);
begin
    inherited;
end;


destructor TEdit.Destroy;
begin
    inherited;
end;


function TEdit.DefinePresentationName : string;
begin
    Result := 'Edit-no-paste';
end;


function TEdit.GetPasteAllowed : Boolean;
var
    LProxy : TStyledEditNoPaste;
    LCtrl  : TControl;
begin
    Result := False;

    if not HasPresentationProxy then
    begin
        Exit;
    end;

    if not Assigned( Self.Presentation ) then
    begin
        Exit;
    end;

    if not ( Self.Presentation is TStyledEditNoPaste ) then
    begin
        Exit;
    end;

    LProxy := Self.Presentation as TStyledEditNoPaste;

    Result := LProxy.PasteAllowed;
end;

procedure TEdit.SetPasteAllowed( const Value : Boolean );
var
    LProxy : TStyledEditNoPaste;
    LCtrl  : TControl;
begin

    if not HasPresentationProxy then
    begin
        Exit;
    end;

    if not Assigned( Presentation ) then
    begin
        Exit;
    end;

    if not ( Self.Presentation is TStyledEditNoPaste ) then
    begin
        Exit;
    end;

    LProxy := Self.Presentation as TStyledEditNoPaste;

    LProxy.PasteAllowed := Value;
end;


end.

Benutzt werden kann es dann so, wenn in den Uses der Interposer immer hinter den System-Units kommt,
dann kann die neue Funktion genutzt werden.
Das Edit kann normal im Designer benutzt werden, ist ja noch dasselbe,
ist jetzt nur um eine neue Funktionalität ergänzt.

Delphi-Quellcode:

unit Unit1;

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.StdCtrls, FMX.Layouts, FMX.Memo.Types,
  FMX.ScrollBox, FMX.Memo, FMX.Edit
  //
  , S4.FMX.Edit      //<= INTERPOSER IMMER HINTER SYSTEM UNITS =================
  ;

type
  TForm1 = class(TForm)
    Layout1: TLayout;
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
    Edit1.PasteAllowed := not Edit1.PasteAllowed;  //<== NEUE FUNKTIONALITÄT ========

    if Edit1.PasteAllowed then
        Memo1.Lines.Insert( 0, 'Edit1 can paste '    + FormatDateTime( 'hh:nn:ss', Now )  )
    else
        Memo1.Lines.Insert( 0, 'Edit1 cannot paste ' + FormatDateTime( 'hh:nn:ss', Now )  );

end;

end.