View Issue Details

IDProjectCategoryView StatusLast Update
0033720LazarusLCLpublic2019-01-04 12:21
ReporterBłażej RoszkowskiAssigned ToBart Broersma 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product VersionProduct Build 
Target Version2.0Fixed in Version2.0 
Summary0033720: TTabControl/TCustomTabControl OnChanging triggers from code but shouldn't
DescriptionThe OnChange event used to be triggered by code but it now isn't.
This is explained by change in 1.8.x to be compatible with Delphi: http://wiki.freepascal.org/Lazarus_1.8.0_release_notes#TCustomTabControl_setting_TabIndex_or_PageIndex_by_code

The problem is that OnChanging still triggers so it leads to weird situation where I get that event (to save stuff in current tab in) but then don't get an OnChange (to change tab contents to new stuff) after it.

I could reproduce it on an old (24-25-ish, I can't recall) and new Fedora 28 and on an old and fresh installation Windows 10 with 1.8.2 (using Gtk2 and WinAPI LCL respectively).

I believe neither should trigger by default and both should if the flag in Options is set.

Delphi Tokyo docs use same wording in 'Note' about in code triggering for both events:
http://docwiki.embarcadero.com/Libraries/Tokyo/en/Vcl.ComCtrls.TCustomTabControl.OnChange
http://docwiki.embarcadero.com/Libraries/Tokyo/en/Vcl.ComCtrls.TCustomTabControl.OnChanging

I'm not sure if I'm right since I'm very weak at Delphi/Pascal but this came up in this thread and wp has told me to report this (ignore posts by jamie): https://forum.lazarus.freepascal.org/index.php/topic,41164.msg285177.html

I also don't own a copy of any modern Delphi and I don't want to register and use up my trial period for this so I can't check it myself easily.
TagsNo tags attached.
Fixed in Revisionr59985
LazTarget2.0
Widgetset
Attached Files
  • tabcontrol.onchanging.diff (3,573 bytes)
    Index: lcl/comctrls.pp
    ===================================================================
    --- lcl/comctrls.pp	(revision 59933)
    +++ lcl/comctrls.pp	(working copy)
    @@ -463,7 +463,7 @@
         procedure InsertPage(APage: TCustomPage; Index: Integer); virtual;
         procedure RemovePage(Index: Integer); virtual;
       //Delphi compatible properties
    -    function CanChange: Boolean; virtual;
    +    function CanChange(User: Boolean = True): Boolean; virtual;
         property DisplayRect: TRect read GetDisplayRect;
         property HotTrack: Boolean read FHotTrack write FHotTrack default False;
         property MultiSelect: Boolean read FMultiSelect write FMultiSelect default False;
    @@ -481,7 +481,7 @@
         function GetImageIndex(ThePageIndex: Integer): Integer; virtual;
         function IndexOf(APage: TPersistent): integer; virtual;
         function CustomPage(Index: integer): TCustomPage;
    -    function CanChangePageIndex: boolean; virtual;
    +    function CanChangePageIndex(User: Boolean = True): boolean; virtual;
         function GetMinimumTabWidth: integer; virtual;
         function GetMinimumTabHeight: integer; virtual;
         function GetCapabilities: TCTabControlCapabilities; virtual;
    @@ -821,7 +821,7 @@
       protected
         procedure SetOptions(const AValue: TCTabControlOptions); override;
         procedure AddRemovePageHandle(APage: TCustomPage); override;
    -    function CanChange: Boolean; override;
    +    function CanChange(User: Boolean = True): Boolean; override;
         function CanShowTab(ATabIndex: Integer): Boolean; virtual;
         procedure Change; override;
         procedure CreateWnd; override;
    Index: lcl/include/customnotebook.inc
    ===================================================================
    --- lcl/include/customnotebook.inc	(revision 59933)
    +++ lcl/include/customnotebook.inc	(working copy)
    @@ -389,15 +389,16 @@
       Result:=GetPage(Index);
     end;
     
    -function TCustomTabControl.CanChangePageIndex: boolean;
    +function TCustomTabControl.CanChangePageIndex(User: Boolean = True): boolean;
     begin
    -  Result := CanChange;
    +  Result := CanChange(User);
     end;
     
    -function TCustomTabControl.CanChange: Boolean;
    +function TCustomTabControl.CanChange(User: Boolean = True): Boolean;
     begin
       Result := True;
    -  if ([csDesigning, csDestroying] * ComponentState = []) and Assigned(OnChanging) then
    +  if ([csDesigning, csDestroying] * ComponentState = []) and Assigned(OnChanging)
    +    and (User or (nboDoChangeOnSetIndex in Options)) then
         OnChanging(Self, Result);
     end;
     
    @@ -581,7 +582,7 @@
       if (AValue < -1) or (AValue >= PageCount) then Exit;
       //debugln('TCustomTabControl.SetPageIndex A ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated),' ',dbgs(ComponentState));
       if FPageIndex = AValue then exit;
    -  if not CanChangePageIndex then exit;
    +  if not CanChangePageIndex(False) then exit;
       //debugln('TCustomTabControl.SetPageIndex B ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated));
     
       InternalSetPageIndex(AValue);
    Index: lcl/include/tabcontrol.inc
    ===================================================================
    --- lcl/include/tabcontrol.inc	(revision 59933)
    +++ lcl/include/tabcontrol.inc	(working copy)
    @@ -558,7 +558,7 @@
       // There are no pages, don't create a handle
     end;
     
    -function TTabControl.CanChange: Boolean;
    +function TTabControl.CanChange(User: Boolean = True): Boolean;
     begin
       Result:=true;
       if FTabControlCreating then exit;
    

Relationships

related to 0025554 resolvedBart Broersma pagecontrol onchange event 

Activities

Vojtech Cihak

2018-05-10 15:42

reporter   ~0108225

I just tested: old Delphi 7 does not trigger OnChanging event when TabIndex is changed by code.

wp

2018-05-10 16:23

developer   ~0108226

Forgotten when the OnChange event was fixed (issue 0025554)?

Bart Broersma

2018-05-10 21:55

developer   ~0108233

Yeah, probably (so, my fault then).

Bart Broersma

2019-01-02 12:54

developer   ~0113089

OnChanging is called in CanChange, which unfortunately is also called when user changes tabs by clicking with the mouse.

Bart Broersma

2019-01-02 13:22

developer   ~0113090

http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/ComCtrls_TCustomTabControl_CanChange.html

CanChange is called automatically when an attempt is made to change the selected tab. CanChange generates an OnChanging event so that an OnChanging event handler can prevent the selection from changing. If there is no OnChanging event handler, CanChange returns true, allowing the change.

Does that mean that CanChange is NOT called when Tab is changed by code?

Bart Broersma

2019-01-03 23:19

developer  

tabcontrol.onchanging.diff (3,573 bytes)
Index: lcl/comctrls.pp
===================================================================
--- lcl/comctrls.pp	(revision 59933)
+++ lcl/comctrls.pp	(working copy)
@@ -463,7 +463,7 @@
     procedure InsertPage(APage: TCustomPage; Index: Integer); virtual;
     procedure RemovePage(Index: Integer); virtual;
   //Delphi compatible properties
-    function CanChange: Boolean; virtual;
+    function CanChange(User: Boolean = True): Boolean; virtual;
     property DisplayRect: TRect read GetDisplayRect;
     property HotTrack: Boolean read FHotTrack write FHotTrack default False;
     property MultiSelect: Boolean read FMultiSelect write FMultiSelect default False;
@@ -481,7 +481,7 @@
     function GetImageIndex(ThePageIndex: Integer): Integer; virtual;
     function IndexOf(APage: TPersistent): integer; virtual;
     function CustomPage(Index: integer): TCustomPage;
-    function CanChangePageIndex: boolean; virtual;
+    function CanChangePageIndex(User: Boolean = True): boolean; virtual;
     function GetMinimumTabWidth: integer; virtual;
     function GetMinimumTabHeight: integer; virtual;
     function GetCapabilities: TCTabControlCapabilities; virtual;
@@ -821,7 +821,7 @@
   protected
     procedure SetOptions(const AValue: TCTabControlOptions); override;
     procedure AddRemovePageHandle(APage: TCustomPage); override;
-    function CanChange: Boolean; override;
+    function CanChange(User: Boolean = True): Boolean; override;
     function CanShowTab(ATabIndex: Integer): Boolean; virtual;
     procedure Change; override;
     procedure CreateWnd; override;
Index: lcl/include/customnotebook.inc
===================================================================
--- lcl/include/customnotebook.inc	(revision 59933)
+++ lcl/include/customnotebook.inc	(working copy)
@@ -389,15 +389,16 @@
   Result:=GetPage(Index);
 end;
 
-function TCustomTabControl.CanChangePageIndex: boolean;
+function TCustomTabControl.CanChangePageIndex(User: Boolean = True): boolean;
 begin
-  Result := CanChange;
+  Result := CanChange(User);
 end;
 
-function TCustomTabControl.CanChange: Boolean;
+function TCustomTabControl.CanChange(User: Boolean = True): Boolean;
 begin
   Result := True;
-  if ([csDesigning, csDestroying] * ComponentState = []) and Assigned(OnChanging) then
+  if ([csDesigning, csDestroying] * ComponentState = []) and Assigned(OnChanging)
+    and (User or (nboDoChangeOnSetIndex in Options)) then
     OnChanging(Self, Result);
 end;
 
@@ -581,7 +582,7 @@
   if (AValue < -1) or (AValue >= PageCount) then Exit;
   //debugln('TCustomTabControl.SetPageIndex A ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated),' ',dbgs(ComponentState));
   if FPageIndex = AValue then exit;
-  if not CanChangePageIndex then exit;
+  if not CanChangePageIndex(False) then exit;
   //debugln('TCustomTabControl.SetPageIndex B ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated));
 
   InternalSetPageIndex(AValue);
Index: lcl/include/tabcontrol.inc
===================================================================
--- lcl/include/tabcontrol.inc	(revision 59933)
+++ lcl/include/tabcontrol.inc	(working copy)
@@ -558,7 +558,7 @@
   // There are no pages, don't create a handle
 end;
 
-function TTabControl.CanChange: Boolean;
+function TTabControl.CanChange(User: Boolean = True): Boolean;
 begin
   Result:=true;
   if FTabControlCreating then exit;

Bart Broersma

2019-01-03 23:20

developer   ~0113138

Possible patch attached, which unfortunately is not Delphi compatible, since it changes the signature of CanChange().

Bart Broersma

2019-01-04 12:21

developer   ~0113151

Thanks for reporting.
Please test and close if OK.

Issue History

Date Modified Username Field Change
2018-05-10 14:10 Błażej Roszkowski New Issue
2018-05-10 15:42 Vojtech Cihak Note Added: 0108225
2018-05-10 16:21 wp Relationship added related to 0025554
2018-05-10 16:23 wp Note Added: 0108226
2018-05-10 21:55 Bart Broersma Note Added: 0108233
2019-01-02 12:54 Bart Broersma Note Added: 0113089
2019-01-02 13:22 Bart Broersma Note Added: 0113090
2019-01-02 13:35 Bart Broersma Assigned To => Bart Broersma
2019-01-02 13:35 Bart Broersma Status new => assigned
2019-01-03 23:19 Bart Broersma File Added: tabcontrol.onchanging.diff
2019-01-03 23:20 Bart Broersma Note Added: 0113138
2019-01-04 12:21 Bart Broersma Fixed in Revision => r59985
2019-01-04 12:21 Bart Broersma LazTarget => 2.0
2019-01-04 12:21 Bart Broersma Note Added: 0113151
2019-01-04 12:21 Bart Broersma Status assigned => resolved
2019-01-04 12:21 Bart Broersma Fixed in Version => 2.0
2019-01-04 12:21 Bart Broersma Resolution open => fixed
2019-01-04 12:21 Bart Broersma Target Version => 2.0