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

View File

@ -14,6 +14,22 @@
{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
------------------------------------------------------------------------------}
@ -585,9 +601,12 @@ begin
//debugln('TCustomTabControl.SetPageIndex B ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated));
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
// DoChange;
//debugln(['TCustomTabControl.SetPageIndex C ',dbgsName(Self)]);
//debugln([' FOptions = ',DbgS(Foptions)]);
if ([csDesigning, csLoading, csDestroying] * ComponentState = []) and (nboDoChangeOnSetIndex in Options) then
DoChange;
end;
{$IFDEF old}

View File

@ -515,6 +515,14 @@ begin
TTabControlStrings(FTabs).TabWidth:=AValue;
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);
begin
// There are no pages, don't create a handle