View Issue Details

IDProjectCategoryView StatusLast Update
0008665LazarusLCLpublic2017-01-10 22:33
ReporterAntônio GalvãoAssigned ToMichl 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version0.9.22Product Build 
Target Version1.6.4Fixed in Version1.7 (SVN) 
Summary0008665: TMemo methods scroll the control
DescriptionEvery changes in the control contents
(cut, paste, load) scrolls the control.

The problem is with the property SelText, which is
used in those methods to alter the contents of
control. SetSelText method of this prroperty is inherited
from TCustomEdit, which is a single line control.

The way of implementing SetSelText method could
use Windows API calls.

So, the control scrolls because its contents is
being entirely replaced, have a look at
the Scrollbar while cutting or pasting.
TagsNo tags attached.
Fixed in Revisionr53886, r53887, r53888
LazTarget1.6.4
WidgetsetWin32/Win64
Attached Files
  • LazPad.zip (347,254 bytes)
  • LazPad2.zip (344,004 bytes)
  • memoseltext.zip (65,613 bytes)
  • memo_pst.diff (685 bytes)
    Index: lcl/include/custommemo.inc
    ===================================================================
    --- lcl/include/custommemo.inc	(revision 53703)
    +++ lcl/include/custommemo.inc	(working copy)
    @@ -204,10 +204,18 @@
     end;
     
     procedure TCustomMemo.SetSelText(const Val: string);
    +var
    +  PosV, PosH: integer;
     begin
    +  // todo: make precise keeping of memo's scroll pos on paste
    +  // currently: on paste, caret scrolls to bottom edge
       Lines.BeginUpdate;
       try
    +    PosV := VertScrollBar.Position;
    +    PosH := HorzScrollBar.Position;
         inherited SetSelText(Val);
    +    VertScrollBar.Position := PosV;
    +    HorzScrollBar.Position := PosH;
       finally
         Lines.EndUpdate;
       end;
    
    memo_pst.diff (685 bytes)
  • memo_set.diff (2,960 bytes)
    Index: lcl/include/custommemo.inc
    ===================================================================
    --- lcl/include/custommemo.inc	(revision 53719)
    +++ lcl/include/custommemo.inc	(working copy)
    @@ -204,10 +204,19 @@
     end;
     
     procedure TCustomMemo.SetSelText(const Val: string);
    +var
    +  PosV, PosH: integer;
     begin
    +  if HandleAllocated and (not (csLoading in ComponentState)) then
    +    if TWSCustomMemoClass(WidgetSetClass).SetSelText(Self, Val) then exit;
    +
       Lines.BeginUpdate;
       try
    +    PosV := VertScrollBar.Position;
    +    PosH := HorzScrollBar.Position;
         inherited SetSelText(Val);
    +    VertScrollBar.Position := PosV;
    +    HorzScrollBar.Position := PosH;
       finally
         Lines.EndUpdate;
       end;
    Index: lcl/interfaces/win32/win32wsstdctrls.pp
    ===================================================================
    --- lcl/interfaces/win32/win32wsstdctrls.pp	(revision 53719)
    +++ lcl/interfaces/win32/win32wsstdctrls.pp	(working copy)
    @@ -200,6 +200,7 @@
         class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
         class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
         class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
    +    class function SetSelText(const ACustomEdit: TCustomEdit; const AText: string): boolean; override;
       end;
     
       { TWin32WSEdit }
    @@ -1445,6 +1446,12 @@
       SendMessage(AWinControl.Handle, EM_LINESCROLL, -DeltaX, -DeltaY);
     end;
     
    +class function TWin32WSCustomMemo.SetSelText(const ACustomEdit: TCustomEdit; const AText: string): boolean;
    +begin
    +  SendMessageW(ACustomEdit.Handle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(UTF8Decode(AText))));
    +  Result := True;
    +end;
    +
     { TWin32WSCustomStaticText }
     
     function StaticTextWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
    Index: lcl/widgetset/wsstdctrls.pp
    ===================================================================
    --- lcl/widgetset/wsstdctrls.pp	(revision 53719)
    +++ lcl/widgetset/wsstdctrls.pp	(working copy)
    @@ -159,6 +159,7 @@
         class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); virtual;
         class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); virtual;
         class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); virtual;
    +    class function SetSelText(const ACustomEdit: TCustomEdit; const AText: string): boolean; virtual;
         class procedure SetTextHint(const ACustomEdit: TCustomEdit; const ATextHint: string); virtual;
         class function CreateEmulatedTextHintFont(const ACustomEdit: TCustomEdit): TFont; virtual;
     
    @@ -575,6 +576,12 @@
     begin
     end;
     
    +class function TWSCustomEdit.SetSelText(const ACustomEdit: TCustomEdit;
    +  const AText: string): boolean;
    +begin
    +  Result := False;
    +end;
    +
     class procedure TWSCustomEdit.Cut(const ACustomEdit: TCustomEdit);
     begin
       ACustomEdit.CopyToClipboard;
    
    memo_set.diff (2,960 bytes)

Relationships

has duplicate 0008657 closedVincent Snijders TMemo methods scroll the control 

Activities

2007-04-10 16:38

 

LazPad.zip (347,254 bytes)

Vincent Snijders

2007-04-10 17:12

manager   ~0012188

Can not compile the project due to missing components: WinXPStyle and LazRichView.

These are non standard components. You cannot expect them to be present on a Lazarus developers computer.

2007-04-11 05:45

 

LazPad2.zip (344,004 bytes)

Antônio Galvão

2007-04-11 05:48

reporter   ~0012192

This is not a bug report anymore, but a propose of solution. See the first executable file for the bug itself.

Bart Broersma

2016-09-07 15:26

developer   ~0094459

Last edited: 2016-09-07 15:36

View 4 revisions

Both 0008665 and 0008657 are resolved as duplicate (of eachother), while the issue at hand is not resolved.

See: http://forum.lazarus.freepascal.org/index.php/topic,33919.0.html

I'l attach a sample project demonstrating the issue with TMemo.SelText.

[Edit]
Attached memoseltext.zip
Unzip, build and run.
Scroll the scrollbar to the middle of the Memo.
Select some text
Press "Set Seltext" speedbutton.
Observed behaviour: Memo scrolls to top, the inserted '[New SelText]' is scrolled out of view.
Expected behaviour: Memo does not scroll, the inserted '[New SelText]' is not scrolled out of view. (This is how Delphi (7) behaves).

[Edit2]
Tested with Lazarus 1.7 r52754 FPC 3.0.0 32-bit on Win7-64.

Bart Broersma

2016-09-07 15:27

developer  

memoseltext.zip (65,613 bytes)

Bart Broersma

2016-09-07 17:48

developer   ~0094462

On Linux/QT and Linux/GTK2, them memo scrolls in such a way the '[New SelText]' is at the bottom line.

Bart Broersma

2016-09-08 13:42

developer   ~0094479

Maybe SetSelText implementation should be moved to widgetset implementation?

Alexey Tor.

2016-12-17 22:56

reporter   ~0096866

Last edited: 2016-12-17 22:56

View 2 revisions

Its possible to make fix(partial) by saving Vert/Horz scrollbar pos, before paste, then setting them back.
Will make a dif

Alexey Tor.

2016-12-17 23:03

reporter  

memo_pst.diff (685 bytes)
Index: lcl/include/custommemo.inc
===================================================================
--- lcl/include/custommemo.inc	(revision 53703)
+++ lcl/include/custommemo.inc	(working copy)
@@ -204,10 +204,18 @@
 end;
 
 procedure TCustomMemo.SetSelText(const Val: string);
+var
+  PosV, PosH: integer;
 begin
+  // todo: make precise keeping of memo's scroll pos on paste
+  // currently: on paste, caret scrolls to bottom edge
   Lines.BeginUpdate;
   try
+    PosV := VertScrollBar.Position;
+    PosH := HorzScrollBar.Position;
     inherited SetSelText(Val);
+    VertScrollBar.Position := PosV;
+    HorzScrollBar.Position := PosH;
   finally
     Lines.EndUpdate;
   end;
memo_pst.diff (685 bytes)

Alexey Tor.

2016-12-17 23:03

reporter   ~0096867

Last edited: 2016-12-17 23:05

View 2 revisions

Diff added:
only a partial fix, coz caret scrolls to bottom edge, by SetSelText

Bart Broersma

2016-12-18 13:18

developer   ~0096894

I think moving it to WS would be better.

Alexey Tor.

2016-12-18 22:26

reporter  

memo_set.diff (2,960 bytes)
Index: lcl/include/custommemo.inc
===================================================================
--- lcl/include/custommemo.inc	(revision 53719)
+++ lcl/include/custommemo.inc	(working copy)
@@ -204,10 +204,19 @@
 end;
 
 procedure TCustomMemo.SetSelText(const Val: string);
+var
+  PosV, PosH: integer;
 begin
+  if HandleAllocated and (not (csLoading in ComponentState)) then
+    if TWSCustomMemoClass(WidgetSetClass).SetSelText(Self, Val) then exit;
+
   Lines.BeginUpdate;
   try
+    PosV := VertScrollBar.Position;
+    PosH := HorzScrollBar.Position;
     inherited SetSelText(Val);
+    VertScrollBar.Position := PosV;
+    HorzScrollBar.Position := PosH;
   finally
     Lines.EndUpdate;
   end;
Index: lcl/interfaces/win32/win32wsstdctrls.pp
===================================================================
--- lcl/interfaces/win32/win32wsstdctrls.pp	(revision 53719)
+++ lcl/interfaces/win32/win32wsstdctrls.pp	(working copy)
@@ -200,6 +200,7 @@
     class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
     class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
     class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
+    class function SetSelText(const ACustomEdit: TCustomEdit; const AText: string): boolean; override;
   end;
 
   { TWin32WSEdit }
@@ -1445,6 +1446,12 @@
   SendMessage(AWinControl.Handle, EM_LINESCROLL, -DeltaX, -DeltaY);
 end;
 
+class function TWin32WSCustomMemo.SetSelText(const ACustomEdit: TCustomEdit; const AText: string): boolean;
+begin
+  SendMessageW(ACustomEdit.Handle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(UTF8Decode(AText))));
+  Result := True;
+end;
+
 { TWin32WSCustomStaticText }
 
 function StaticTextWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
Index: lcl/widgetset/wsstdctrls.pp
===================================================================
--- lcl/widgetset/wsstdctrls.pp	(revision 53719)
+++ lcl/widgetset/wsstdctrls.pp	(working copy)
@@ -159,6 +159,7 @@
     class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); virtual;
     class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); virtual;
     class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); virtual;
+    class function SetSelText(const ACustomEdit: TCustomEdit; const AText: string): boolean; virtual;
     class procedure SetTextHint(const ACustomEdit: TCustomEdit; const ATextHint: string); virtual;
     class function CreateEmulatedTextHintFont(const ACustomEdit: TCustomEdit): TFont; virtual;
 
@@ -575,6 +576,12 @@
 begin
 end;
 
+class function TWSCustomEdit.SetSelText(const ACustomEdit: TCustomEdit;
+  const AText: string): boolean;
+begin
+  Result := False;
+end;
+
 class procedure TWSCustomEdit.Cut(const ACustomEdit: TCustomEdit);
 begin
   ACustomEdit.CopyToClipboard;
memo_set.diff (2,960 bytes)

Alexey Tor.

2016-12-18 22:27

reporter   ~0096919

Memo_set.diff-- Code adds WS function SetSelText, win32 [yet only] uses it.

Alexey Tor.

2017-01-03 15:49

reporter   ~0097270

@Bart, @Juha
What do you think about diff

Bart Broersma

2017-01-03 17:31

developer   ~0097272

Maybe we need a new TLCLCapability and not (ab)use the WS implementtion result to query wether the WS supports this?
(Like e.g. for TextHint implementation)

Juha, whats your opinion?

Juha Manninen

2017-01-04 12:26

developer   ~0097286

Why you people ask me? I know nothing about this issue.
Please solve it as you see fit. I am struggling with other issues right now.

Alexey Tor.

2017-01-04 12:43

reporter   ~0097287

Bart,
maybe it is too tiny LCLCapability: MemoSupportsNativeSetText. I can do capability.

Bart Broersma

2017-01-04 16:00

developer   ~0097291

> Why you people ask me? I know nothing about this issue.
Sorry, I somehow had the idea you were involved.

Juha Manninen

2017-01-04 17:17

developer   ~0097293

> Sorry, I somehow had the idea you were involved.

Heh! I have applied (and rejected) many patches from AlexeyT. Maybe I am his only hope sometimes. :)
I would be happy if all developers paid more attention to patches.

Michl

2017-01-05 20:32

developer   ~0097319

> What do you think about diff

Thank you for the patch! I modified it a bit. In this case, it isn't needed to implement a function, if a widgetset provide a own implementation of SetSelText. The widgetsets simply overwrite such a function, if a own one is used.


Please test and close if ok.

Alexey Tor.

2017-01-06 05:03

reporter   ~0097326

Not ok-
  SendMessageW(ACustomEdit.Handle, EM_REPLACESEL, WPARAM(1), LPARAM(PWideChar(WideString(NewSelText))));
You cast string to widestring. Need Utf8Decode(NewSelText)

Alexey Tor.

2017-01-06 05:06

reporter   ~0097327

TWin32WSCustomEdit.SetSelText(const ACustomEdit: TCustomEdit; NewSelText: string);

Pls "const-parameter"

Michl

2017-01-06 08:22

developer   ~0097329

Last edited: 2017-01-06 08:23

View 2 revisions

> You cast string to widestring. Need Utf8Decode(NewSelText)

You are right, the string magic can be used with FPC 3.0.0 but we need compatibility to FPC 2.6.4, we have to convert it manually. As nearly everywhere UTF8ToUTF16 (not UTF8Decode) is used for converting in the WSXXX classes, I changed it for SelText and also for TextHint (both work again for FPC 2.6.4).

> Pls "const-parameter"

:) Yes, a copy + paste bug.

I changed it in revision 53887.

Thank you very much for your hints! Please try and report, if I miss something again.

Alexey Tor.

2017-01-06 09:15

reporter   ~0097330

found:
<win32wsspin.pp>: 0000001
<(196)>: Window := CreateWindowExW(FlagsEx, WideChar(WideString(EditClsName)),
<win32int.pp>: 0000001
<(219)>: EditClsName: array[0..4] of char = 'Edit'#0;

Michl

2017-01-06 14:03

developer   ~0097338

No, this is correct, try this code with FPC 2.6.4 to FPC 3.1.1:

program Project1;
uses sysutils;
var
  EditClsName: array[0..4] of char = 'Edit'#0;
  ws: WideString;
begin
  ws := WideString(EditClsName);
  WriteLn(ws, ' [', IntToHex(PByte(Pointer(ws))^, 4), ' ',
                    IntToHex(PByte(Pointer(ws) + 2)^, 4), ' ',
                    IntToHex(PByte(Pointer(ws) + 4)^, 4), ' ',
                    IntToHex(PByte(Pointer(ws) + 6)^, 4), ' ',
                    IntToHex(PByte(Pointer(ws) + 8)^, 4), ']');
  ReadLn;
end.

The result is always the same. So no problem here.

BTW, what I mean with "Please try and report, if I miss something again" is a bug report related issue, for all other things, please open a new bug report (if there is a problem) ;)

Alexey Tor.

2017-01-09 17:51

reporter   ~0097374

Okay; can close it, seems.

Issue History

Date Modified Username Field Change
2007-04-10 16:38 Antônio Galvão New Issue
2007-04-10 16:38 Antônio Galvão File Added: LazPad.zip
2007-04-10 16:38 Antônio Galvão Widgetset => Win32
2007-04-10 16:45 Vincent Snijders Relationship added has duplicate 0008657
2007-04-10 17:12 Vincent Snijders Status new => resolved
2007-04-10 17:12 Vincent Snijders Resolution open => unable to reproduce
2007-04-10 17:12 Vincent Snijders Assigned To => Vincent Snijders
2007-04-10 17:12 Vincent Snijders Note Added: 0012188
2007-04-11 05:31 Antônio Galvão Status resolved => feedback
2007-04-11 05:31 Antônio Galvão Resolution unable to reproduce => reopened
2007-04-11 05:45 Antônio Galvão File Added: LazPad2.zip
2007-04-11 05:48 Antônio Galvão Note Added: 0012192
2007-04-11 13:40 Vincent Snijders LazTarget => 1.0
2007-04-11 13:40 Vincent Snijders Assigned To Vincent Snijders =>
2007-04-11 13:40 Vincent Snijders Status feedback => acknowledged
2007-04-19 12:19 Vincent Snijders Fixed in Revision => 8702
2007-04-19 12:19 Vincent Snijders Status acknowledged => resolved
2007-04-19 12:19 Vincent Snijders Resolution reopened => duplicate
2007-04-19 12:19 Vincent Snijders Assigned To => Vincent Snijders
2007-09-02 00:22 Marc Weustink Status resolved => closed
2008-04-24 10:08 Vincent Snijders Target Version => 1.0.0
2016-09-07 15:26 Bart Broersma Note Added: 0094459
2016-09-07 15:26 Bart Broersma Status closed => assigned
2016-09-07 15:26 Bart Broersma Resolution duplicate => reopened
2016-09-07 15:27 Bart Broersma File Added: memoseltext.zip
2016-09-07 15:31 Bart Broersma Note Edited: 0094459 View Revisions
2016-09-07 15:36 Bart Broersma Note Edited: 0094459 View Revisions
2016-09-07 15:36 Bart Broersma Note Edited: 0094459 View Revisions
2016-09-07 17:48 Bart Broersma Note Added: 0094462
2016-09-08 13:42 Bart Broersma Note Added: 0094479
2016-10-24 09:37 Vincent Snijders LazTarget 1.0 => -
2016-10-24 09:37 Vincent Snijders Assigned To Vincent Snijders =>
2016-10-24 09:37 Vincent Snijders Status assigned => acknowledged
2016-10-24 09:37 Vincent Snijders Target Version 1.0.0 =>
2016-12-17 22:56 Alexey Tor. Note Added: 0096866
2016-12-17 22:56 Alexey Tor. Note Edited: 0096866 View Revisions
2016-12-17 23:03 Alexey Tor. File Added: memo_pst.diff
2016-12-17 23:03 Alexey Tor. Note Added: 0096867
2016-12-17 23:05 Alexey Tor. Note Edited: 0096867 View Revisions
2016-12-18 13:18 Bart Broersma Note Added: 0096894
2016-12-18 22:26 Alexey Tor. File Added: memo_set.diff
2016-12-18 22:27 Alexey Tor. Note Added: 0096919
2017-01-03 15:49 Alexey Tor. Note Added: 0097270
2017-01-03 17:31 Bart Broersma Note Added: 0097272
2017-01-04 12:26 Juha Manninen Note Added: 0097286
2017-01-04 12:43 Alexey Tor. Note Added: 0097287
2017-01-04 16:00 Bart Broersma Note Added: 0097291
2017-01-04 17:17 Juha Manninen Note Added: 0097293
2017-01-04 18:50 Bart Broersma Assigned To => Bart Broersma
2017-01-04 18:50 Bart Broersma Status acknowledged => assigned
2017-01-05 18:07 Bart Broersma Assigned To Bart Broersma => Michl
2017-01-05 20:32 Michl Fixed in Revision 8702 => r53886
2017-01-05 20:32 Michl LazTarget - => 1.6.4
2017-01-05 20:32 Michl Note Added: 0097319
2017-01-05 20:32 Michl Status assigned => resolved
2017-01-05 20:32 Michl Fixed in Version => 1.7 (SVN)
2017-01-05 20:32 Michl Resolution reopened => fixed
2017-01-05 20:32 Michl Target Version => 1.6.4
2017-01-06 05:03 Alexey Tor. Note Added: 0097326
2017-01-06 05:06 Alexey Tor. Note Added: 0097327
2017-01-06 08:22 Michl Note Added: 0097329
2017-01-06 08:22 Michl Status resolved => feedback
2017-01-06 08:23 Michl Note Edited: 0097329 View Revisions
2017-01-06 08:24 Michl Fixed in Revision r53886 => r53886, r53887
2017-01-06 09:15 Alexey Tor. Note Added: 0097330
2017-01-06 14:03 Michl Note Added: 0097338
2017-01-09 17:51 Alexey Tor. Note Added: 0097374
2017-01-10 22:33 Michl Fixed in Revision r53886, r53887 => r53886, r53887, r53888
2017-01-10 22:33 Michl Status feedback => resolved