View Issue Details

IDProjectCategoryView StatusLast Update
0037277LazarusLCLpublic2020-06-29 09:47
ReporterJoeny Ang Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Product Version2.1 (SVN) 
Summary0037277: GTK2: TCustomEdit.NumbersOnly not implemented
DescriptionCan't find anything on GTK to do this. Here are 2 ways to attain this:
v1. Override TWinControl.UTF8KeyPress() and filter key presses there. This will affect all widgetsets, and will override their implementations.
v2. Override TWinControl.UTF8KeyPress(), introduce TWSWidgetSet.DoUTF8KeyPress() and call this from the former. This will allow widgetsets to implement their own DoUTF8KeyPress().

Observations when NumbersOnly is True:
Win32 (Windows XP):
  - only numeric chars are allowed via keyboard
  - when a non-numeric char is pressed, will display a popup message (Unacceptable Character...)
  - strings containing non-numeric chars can still be assigned to the Text property
QT5:
  - if Text is purely numeric, only numeric chars are allowed via keyboard; if not, all chars are allowed
  - strings containing non-numeric chars can still be assigned to the Text property

The patches will have the following behavior for GTK2:
  - only numeric chars are allowed via keyboard
  - strings containing non-numeric chars can still be assigned to the Text property
TagsNo tags attached.
Fixed in Revision
LazTarget
WidgetsetGTK 2
Attached Files

Activities

Joeny Ang

2020-06-27 11:20

reporter  

tcustomedit-numbersonly-v1.patch (1,060 bytes)   
--- lcl/stdctrls.pp
+++ lcl/stdctrls.pp
@@ -805,6 +805,7 @@
     function ChildClassAllowed(ChildClass: TClass): boolean; override;
     class function GetControlClassDefaultSize: TSize; override;
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override;
+    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
     procedure RealSetText(const AValue: TCaption); override;
     function  RealGetText: TCaption; override;
     procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override;
--- lcl/include/customedit.inc
+++ lcl/include/customedit.inc
@@ -557,6 +557,13 @@
       if (SelText = Text) then FAutoSelected := True;
     end;//End if (FAutoSelect and not FAutoSelected)
   end;//End if (Button = mbLeft)
+end;
+
+procedure TCustomEdit.UTF8KeyPress(var UTF8Key: TUTF8Char);
+begin
+  inherited UTF8KeyPress(UTF8Key);
+  if FNumbersOnly and (Length(UTF8Key) = 1) and not CharInSet(UTF8Key[1], ['0'..'9']) then
+    UTF8Key := '';
 end;
 
 procedure TCustomEdit.RealSetText(const AValue: TCaption);

tcustomedit-numbersonly-v2.patch (3,000 bytes)   
--- lcl/stdctrls.pp
+++ lcl/stdctrls.pp
@@ -805,6 +805,7 @@
     function ChildClassAllowed(ChildClass: TClass): boolean; override;
     class function GetControlClassDefaultSize: TSize; override;
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override;
+    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
     procedure RealSetText(const AValue: TCaption); override;
     function  RealGetText: TCaption; override;
     procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override;
--- lcl/include/customedit.inc
+++ lcl/include/customedit.inc
@@ -557,6 +557,13 @@
       if (SelText = Text) then FAutoSelected := True;
     end;//End if (FAutoSelect and not FAutoSelected)
   end;//End if (Button = mbLeft)
+end;
+
+procedure TCustomEdit.UTF8KeyPress(var UTF8Key: TUTF8Char);
+begin
+  inherited UTF8KeyPress(UTF8Key);
+  if HandleAllocated then
+    TWSCustomEditClass(WidgetSetClass).DoUTF8KeyPress(Self, UTF8Key);
 end;
 
 procedure TCustomEdit.RealSetText(const AValue: TCaption);
--- lcl/widgetset/wsstdctrls.pp
+++ lcl/widgetset/wsstdctrls.pp
@@ -35,7 +35,7 @@
 //    the uses clause of the XXXintf.pp
 ////////////////////////////////////////////////////
 uses
-  Classes,
+  Classes, LCLType,
 ////////////////////////////////////////////////////
 // To get as little as possible circles,
 // uncomment only when needed for registration
@@ -170,6 +170,8 @@
     class procedure Copy(const ACustomEdit: TCustomEdit); virtual;
     class procedure Paste(const ACustomEdit: TCustomEdit); virtual;
     class procedure Undo(const ACustomEdit: TCustomEdit); virtual;
+
+    class procedure DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char); virtual;
   end;
   TWSCustomEditClass = class of TWSCustomEdit;
 
@@ -649,6 +651,11 @@
   // nothing
 end;
 
+class procedure TWSCustomEdit.DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char);
+begin
+  // nothing
+end;
+
 { TWSCustomMemo }
 
 class procedure TWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; const AText: string);
--- lcl/interfaces/gtk2/gtk2wsstdctrls.pp
+++ lcl/interfaces/gtk2/gtk2wsstdctrls.pp
@@ -219,6 +219,8 @@
     class procedure Copy(const ACustomEdit: TCustomEdit); override;
     class procedure Paste(const ACustomEdit: TCustomEdit); override;
     class procedure Undo(const ACustomEdit: TCustomEdit); override;
+
+    class procedure DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char); override;
   end;
 
   { TGtk2WSCustomMemo }
@@ -1474,6 +1476,13 @@
     Exit;
   //TODO: I cannot find anything usefull in gtk2 to do this, seem
   //that we have to make our own implementation.
+end;
+
+class procedure TGtk2WSCustomEdit.DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char);
+begin
+  if ACustomEdit.NumbersOnly and
+    (Length(UTF8Key) = 1) and not CharInSet(UTF8Key[1], ['0'..'9']) then
+    UTF8Key := '';
 end;
 
 class procedure TGtk2WSCustomComboBox.ReCreateCombo(

Bart Broersma

2020-06-27 15:06

developer   ~0123619

Last edited: 2020-06-28 16:10

View 3 revisions

NumbersOnly is implemented by the WidgetSet.
It was added as Delphi compatibility (at the request of several users), because Windows offers that concept (but as usual, MS implemented it in a crappy way, AFAIK -1 is a number, but MS disagrees with me).
We will not adjust (Utf8)KeyPress to make this work on all platforms.

It's trival to implenet on the user side, it's even more simple to just use a TSpinEdit (and hide the spinners if you want).

If at some point GTKx will support this, it can be implemented there.

In hindsight, we should not have added this property at all IMHO.

Bart Broersma

2020-06-27 22:28

developer   ~0123634

B.t.w.: does that patch actually work.
I ask this because of 0026116

Bart Broersma

2020-06-28 16:09

developer   ~0123650

Also Windows won't let you paste something in the TEdit if it isn't a number (which your patch doesn't implement).

Joeny Ang

2020-06-29 09:47

reporter   ~0123663

Yes it is simple enough to implement on the user side, and more flexible too. I just thought that it should work across widgetsets.

The 2nd patch does not interfere with the widgetsets' native implementations (if they exists) like in Win32.

This is somewhat similar to TCustomEdit.CharCase. GTK2 does not have native upper/lower case modes either, but it works, and the implementation is found in TCustomEdit.TextChanged().

Updated the patch to check clipboard paste via keyboard and PasteFromClipboard() function.
tcustomedit-numbersonly-v3.patch (4,977 bytes)   
--- lcl/stdctrls.pp
+++ lcl/stdctrls.pp
@@ -805,6 +805,7 @@
     function ChildClassAllowed(ChildClass: TClass): boolean; override;
     class function GetControlClassDefaultSize: TSize; override;
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override;
+    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
     procedure RealSetText(const AValue: TCaption); override;
     function  RealGetText: TCaption; override;
     procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override;
--- lcl/include/customedit.inc
+++ lcl/include/customedit.inc
@@ -524,7 +524,8 @@
 
 procedure TCustomEdit.WndProc(var Message: TLMessage);
 begin
-  if not((Message.msg=CM_TEXTCHANGED) and (FEmulatedTextHintStatus<>thsHidden)) then //eat CM_TEXTCHANGED
+  if not ((Message.msg = LM_PASTE) and HandleAllocated and not TWSCustomEditClass(WidgetSetClass).AllowPaste(Self)) and
+    not((Message.msg=CM_TEXTCHANGED) and (FEmulatedTextHintStatus<>thsHidden)) then //eat CM_TEXTCHANGED
     inherited WndProc(Message);
 end;
 
@@ -557,6 +558,13 @@
       if (SelText = Text) then FAutoSelected := True;
     end;//End if (FAutoSelect and not FAutoSelected)
   end;//End if (Button = mbLeft)
+end;
+
+procedure TCustomEdit.UTF8KeyPress(var UTF8Key: TUTF8Char);
+begin
+  inherited UTF8KeyPress(UTF8Key);
+  if HandleAllocated then
+    TWSCustomEditClass(WidgetSetClass).DoUTF8KeyPress(Self, UTF8Key);
 end;
 
 procedure TCustomEdit.RealSetText(const AValue: TCaption);
--- lcl/widgetset/wsstdctrls.pp
+++ lcl/widgetset/wsstdctrls.pp
@@ -35,7 +35,7 @@
 //    the uses clause of the XXXintf.pp
 ////////////////////////////////////////////////////
 uses
-  Classes,
+  Classes, LCLType,
 ////////////////////////////////////////////////////
 // To get as little as possible circles,
 // uncomment only when needed for registration
@@ -170,6 +170,9 @@
     class procedure Copy(const ACustomEdit: TCustomEdit); virtual;
     class procedure Paste(const ACustomEdit: TCustomEdit); virtual;
     class procedure Undo(const ACustomEdit: TCustomEdit); virtual;
+
+    class function AllowPaste(const ACustomEdit: TCustomEdit): Boolean; virtual;
+    class procedure DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char); virtual;
   end;
   TWSCustomEditClass = class of TWSCustomEdit;
 
@@ -649,6 +652,16 @@
   // nothing
 end;
 
+class function TWSCustomEdit.AllowPaste(const ACustomEdit: TCustomEdit): Boolean;
+begin
+  Result := True;
+end;
+
+class procedure TWSCustomEdit.DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char);
+begin
+  // nothing
+end;
+
 { TWSCustomMemo }
 
 class procedure TWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; const AText: string);
--- lcl/interfaces/gtk2/gtk2wsstdctrls.pp
+++ lcl/interfaces/gtk2/gtk2wsstdctrls.pp
@@ -219,6 +219,9 @@
     class procedure Copy(const ACustomEdit: TCustomEdit); override;
     class procedure Paste(const ACustomEdit: TCustomEdit); override;
     class procedure Undo(const ACustomEdit: TCustomEdit); override;
+
+    class function AllowPaste(const ACustomEdit: TCustomEdit): Boolean; override;
+    class procedure DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char); override;
   end;
 
   { TGtk2WSCustomMemo }
@@ -1450,6 +1453,15 @@
     gtk_editable_copy_clipboard({%H-}PGtkEditable(ACustomEdit.Handle));
 end;
 
+function ClipIsNumber: Boolean;
+var
+  FResult, FTemp: Integer;
+begin
+  FResult := -1;
+  val(gtk_clipboard_wait_for_text(gtk_clipboard_get(GDK_SELECTION_CLIPBOARD)), FTemp, FResult);
+  Result := FResult = 0;
+end;
+
 class procedure TGtk2WSCustomEdit.Paste(const ACustomEdit: TCustomEdit);
 var
   ATextView: PGtkTextView;
@@ -1464,7 +1476,7 @@
     if ABuffer <> nil then
       gtk_text_buffer_paste_clipboard(ABuffer,
         gtk_clipboard_get(GDK_SELECTION_CLIPBOARD), nil, not ACustomEdit.ReadOnly);
-  end else
+  end else if (ACustomEdit.NumbersOnly and ClipIsNumber) or not ACustomEdit.NumbersOnly then
     gtk_editable_paste_clipboard({%H-}PGtkEditable(ACustomEdit.Handle));
 end;
 
@@ -1474,6 +1486,26 @@
     Exit;
   //TODO: I cannot find anything usefull in gtk2 to do this, seem
   //that we have to make our own implementation.
+end;
+
+class function TGtk2WSCustomEdit.AllowPaste(const ACustomEdit: TCustomEdit): Boolean;
+var
+  Widget: PGtkWidget;
+begin
+  Result := inherited AllowPaste(ACustomEdit);
+  if ACustomEdit.NumbersOnly and not ClipIsNumber then
+  begin
+    Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomEdit.Handle))^.CoreWidget;
+    g_signal_stop_emission_by_name(PGObject(Widget), 'paste-clipboard');
+    Result := False;
+  end;
+end;
+
+class procedure TGtk2WSCustomEdit.DoUTF8KeyPress(const ACustomEdit: TCustomEdit; var UTF8Key: TUTF8Char);
+begin
+  if ACustomEdit.NumbersOnly and
+    (Length(UTF8Key) = 1) and not CharInSet(UTF8Key[1], ['0'..'9']) then
+    UTF8Key := '';
 end;
 
 class procedure TGtk2WSCustomComboBox.ReCreateCombo(

Issue History

Date Modified Username Field Change
2020-06-27 11:20 Joeny Ang New Issue
2020-06-27 11:20 Joeny Ang File Added: tcustomedit-numbersonly-v1.patch
2020-06-27 11:20 Joeny Ang File Added: tcustomedit-numbersonly-v2.patch
2020-06-27 15:06 Bart Broersma Note Added: 0123619
2020-06-27 22:28 Bart Broersma Note Added: 0123634
2020-06-28 16:09 Bart Broersma Note Added: 0123650
2020-06-28 16:09 Bart Broersma Note Edited: 0123619 View Revisions
2020-06-28 16:10 Bart Broersma Note Edited: 0123619 View Revisions
2020-06-29 09:47 Joeny Ang Note Added: 0123663
2020-06-29 09:47 Joeny Ang File Added: tcustomedit-numbersonly-v3.patch