LCL: Implement nboDoChangeOnSetIndex option for TCustomTabControl.

If set, it will cause OnChange to be fired when PageIndex is changed by code.
This will make it easier to repair user programs that are affected by r53089 #78830476ff.

git-svn-id: trunk@53387 -
This commit is contained in:
bart 2016-11-19 16:45:40 +00:00
parent 9e44e73f08
commit 1cec552aa5
3 changed files with 34 additions and 5 deletions

View File

@ -356,7 +356,7 @@ type
// These are LCL additions // These are LCL additions
TCTabControlOption = ( TCTabControlOption = (
nboShowCloseButtons, nboMultiLine, nboHidePageListPopup, nboShowCloseButtons, nboMultiLine, nboHidePageListPopup,
nboKeyboardTabSwitch, nboShowAddTabButton); nboKeyboardTabSwitch, nboShowAddTabButton, nboDoChangeOnSetIndex);
TCTabControlOptions = set of TCTabControlOption; TCTabControlOptions = set of TCTabControlOption;
TCTabControlCapability = (nbcShowCloseButtons, nbcMultiLine, nbcPageListPopup, nbcShowAddTabButton); TCTabControlCapability = (nbcShowCloseButtons, nbcMultiLine, nbcPageListPopup, nbcShowAddTabButton);
TCTabControlCapabilities = set of TCTabControlCapability; TCTabControlCapabilities = set of TCTabControlCapability;
@ -413,7 +413,6 @@ type
procedure SetActivePage(const Value: String); procedure SetActivePage(const Value: String);
procedure SetActivePageComponent(const AValue: TCustomPage); procedure SetActivePageComponent(const AValue: TCustomPage);
procedure SetImages(const AValue: TCustomImageList); procedure SetImages(const AValue: TCustomImageList);
procedure SetOptions(const AValue: TCTabControlOptions);
procedure SetPageIndex(AValue: Integer); procedure SetPageIndex(AValue: Integer);
procedure SetPages(AValue: TStrings); procedure SetPages(AValue: TStrings);
procedure SetShowTabs(AValue: Boolean); procedure SetShowTabs(AValue: Boolean);
@ -425,6 +424,7 @@ type
PageClass: TCustomPageClass; PageClass: TCustomPageClass;
function GetPageClass: TCustomPageClass; virtual; function GetPageClass: TCustomPageClass; virtual;
function GetListClass: TNBBasePagesClass; virtual; function GetListClass: TNBBasePagesClass; virtual;
procedure SetOptions(const AValue: TCTabControlOptions); virtual;
procedure AddRemovePageHandle(APage: TCustomPage); virtual; procedure AddRemovePageHandle(APage: TCustomPage); virtual;
procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY; procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY;
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
@ -805,6 +805,7 @@ type
procedure SetTabStop(const AValue: Boolean); procedure SetTabStop(const AValue: Boolean);
procedure SetTabWidth(const AValue: Smallint); procedure SetTabWidth(const AValue: Smallint);
protected protected
procedure SetOptions(const AValue: TCTabControlOptions); override;
procedure AddRemovePageHandle(APage: TCustomPage); override; procedure AddRemovePageHandle(APage: TCustomPage); override;
function CanChange: Boolean; override; function CanChange: Boolean; override;
function CanShowTab(ATabIndex: Integer): Boolean; virtual; function CanShowTab(ATabIndex: Integer): Boolean; virtual;
@ -3924,6 +3925,7 @@ const
function CompareExpandedNodes(Data1, Data2: Pointer): integer; function CompareExpandedNodes(Data1, Data2: Pointer): integer;
function CompareTextWithExpandedNode(Key, Data: Pointer): integer; function CompareTextWithExpandedNode(Key, Data: Pointer): integer;
function DbgS(Opt: TCTabControlOptions): String; overload;
procedure Register; procedure Register;

View File

@ -14,6 +14,22 @@
{off $DEFINE NOTEBOOK_DEBUG} {off $DEFINE NOTEBOOK_DEBUG}
const
TabControlOptionStr: Array[TCTabControlOption] of String = (
'nboShowCloseButtons', 'nboMultiLine', 'nboHidePageListPopup',
'nboKeyboardTabSwitch', 'nboShowAddTabButton', 'nboDoChangeOnSetIndex'
);
function DbgS(Opt: TCTabControlOptions): String; overload;
var
O: TCTabControlOption;
begin
Result := '';
for O in Opt do Result := Result + TabControlOptionStr[O] + ',';
if (Length(Result) > 0) then System.Delete(Result, Length(Result), 1);
Result := '[' + Result + ']';
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
TNBPages Constructor TNBPages Constructor
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
@ -585,9 +601,12 @@ begin
//debugln('TCustomTabControl.SetPageIndex B ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated)); //debugln('TCustomTabControl.SetPageIndex B ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated));
InternalSetPageIndex(AValue); InternalSetPageIndex(AValue);
//Delphi does not do this. In future we might make this configurable, so for the time being I commented it out
//if ([csDesigning, csLoading, csDestroying] * ComponentState = []) then //debugln(['TCustomTabControl.SetPageIndex C ',dbgsName(Self)]);
// DoChange; //debugln([' FOptions = ',DbgS(Foptions)]);
if ([csDesigning, csLoading, csDestroying] * ComponentState = []) and (nboDoChangeOnSetIndex in Options) then
DoChange;
end; end;
{$IFDEF old} {$IFDEF old}

View File

@ -515,6 +515,14 @@ begin
TTabControlStrings(FTabs).TabWidth:=AValue; TTabControlStrings(FTabs).TabWidth:=AValue;
end; end;
procedure TTabControl.SetOptions(const AValue: TCTabControlOptions);
begin
inherited SetOptions(AValue);
//propagate the changes to FTabs.NoteBook, this is needed in TCustomTabControl.SetPageIndex
//since SetTabIndex eventually does FTabs.NoteBook.SetPageIndex
TTabControlNoteBookStrings(FTabs).NoteBook.Options := AValue;
end;
procedure TTabControl.AddRemovePageHandle(APage: TCustomPage); procedure TTabControl.AddRemovePageHandle(APage: TCustomPage);
begin begin
// There are no pages, don't create a handle // There are no pages, don't create a handle