paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 18:40:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TabControl forward style

Browse Source 
git-svn-id: trunk@42560 -
This commit is contained in:
martin 2013-09-02 13:15:17 +00:00
parent aae0ab1f7b
commit ddb0e30cb0
3 changed files with 26 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/comctrls.pp
View File

@ -347,6 +347,7 @@ type
procedure AddRemovePageHandle(APage: TCustomPage); procedure AddRemovePageHandle(APage: TCustomPage);
procedure MoveTab(Sender: TObject; NewIndex: Integer); procedure MoveTab(Sender: TObject; NewIndex: Integer);
procedure SetMultiLine(const AValue: Boolean); procedure SetMultiLine(const AValue: Boolean);
procedure SetStyle(AValue: TTabStyle); virtual;
procedure WSMovePage(APage: TCustomPage; NewIndex: Integer); procedure WSMovePage(APage: TCustomPage; NewIndex: Integer);
procedure PageRemoved(Index: Integer); procedure PageRemoved(Index: Integer);
procedure SetActivePage(const Value: String); procedure SetActivePage(const Value: String);
@ -393,7 +394,7 @@ type
property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False; property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False;
property RaggedRight: Boolean read FRaggedRight write FRaggedRight default False; property RaggedRight: Boolean read FRaggedRight write FRaggedRight default False;
property ScrollOpposite: Boolean read FScrollOpposite write FScrollOpposite default False; property ScrollOpposite: Boolean read FScrollOpposite write FScrollOpposite default False;
property Style: TTabStyle read FStyle write FStyle default tsTabs; property Style: TTabStyle read FStyle write SetStyle default tsTabs;
property Tabs: TStrings read FAccess write SetPages; property Tabs: TStrings read FAccess write SetPages;
property TabHeight: Smallint read FTabHeight write FTabHeight default 0; property TabHeight: Smallint read FTabHeight write FTabHeight default 0;
property TabIndex: Integer read FPageIndex write SetPageIndex default -1; property TabIndex: Integer read FPageIndex write SetPageIndex default -1;
@ -654,6 +655,8 @@ type
private private
FNoteBook: TCustomTabControl{%H-}; FNoteBook: TCustomTabControl{%H-};
FInHandleCreated: Boolean; FInHandleCreated: Boolean;
function GetStyle: TTabStyle;
procedure SetStyle(AValue: TTabStyle);
protected protected
function Get(Index: Integer): string; override; function Get(Index: Integer): string; override;
function GetCount: Integer; override; function GetCount: Integer; override;
@ -684,6 +687,7 @@ type
procedure TabControlBoundsChange; override; procedure TabControlBoundsChange; override;
function IndexOfTabAt(X, Y: Integer): Integer; override; function IndexOfTabAt(X, Y: Integer): Integer; override;
property TabPosition: TTabPosition read GetTabPosition write SetTabPosition; property TabPosition: TTabPosition read GetTabPosition write SetTabPosition;
property Style: TTabStyle read GetStyle write SetStyle;
public public
property NoteBook: TCustomTabControl read FNoteBook; property NoteBook: TCustomTabControl read FNoteBook;
end; end;
@ -719,7 +723,7 @@ type
procedure SetOwnerDraw(const AValue: Boolean); procedure SetOwnerDraw(const AValue: Boolean);
procedure SetRaggedRight(const AValue: Boolean); procedure SetRaggedRight(const AValue: Boolean);
procedure SetScrollOpposite(const AValue: Boolean); procedure SetScrollOpposite(const AValue: Boolean);
procedure SetStyle(const AValue: TTabStyle); procedure SetStyle(AValue: TTabStyle); override;
procedure SetTabHeight(const AValue: Smallint); procedure SetTabHeight(const AValue: Smallint);
procedure SetTabPosition(AValue: TTabPosition); override; procedure SetTabPosition(AValue: TTabPosition); override;
procedure SetTabs(const AValue: TStrings); procedure SetTabs(const AValue: TStrings);

6
lcl/include/customnotebook.inc
View File

@ -626,6 +626,12 @@ begin
Options := Options - [nboMultiLine]; Options := Options - [nboMultiLine];
end; end;
procedure TCustomTabControl.SetStyle(AValue: TTabStyle);
begin
if FStyle = AValue then Exit;
FStyle := AValue;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function TCustomTabControl.FindVisiblePage(Index: Integer): Integer; function TCustomTabControl.FindVisiblePage(Index: Integer): Integer;

16
lcl/include/tabcontrol.inc
View File

@ -187,6 +187,17 @@ begin
TabControlBoundsChange; TabControlBoundsChange;
end; end;
procedure TTabControlNoteBookStrings.SetStyle(AValue: TTabStyle);
begin
FNoteBook.Style := AValue;
TabControlBoundsChange;
end;
function TTabControlNoteBookStrings.GetStyle: TTabStyle;
begin
Result := FNoteBook.Style;
end;
function TTabControlNoteBookStrings.Get(Index: Integer): string; function TTabControlNoteBookStrings.Get(Index: Integer): string;
begin begin
Result:=FNoteBook.Pages[Index]; Result:=FNoteBook.Pages[Index];
@ -453,11 +464,12 @@ begin
TTabControlStrings(FTabs).ScrollOpposite:=AValue; TTabControlStrings(FTabs).ScrollOpposite:=AValue;
end; end;
procedure TTabControl.SetStyle(const AValue: TTabStyle); procedure TTabControl.SetStyle(AValue: TTabStyle);
begin begin
inherited SetStyle(AValue);
if FStyle=AValue then exit; if FStyle=AValue then exit;
FStyle:=AValue; FStyle:=AValue;
// ToDo TTabControlNoteBookStrings(FTabs).Style := AValue;
end; end;
procedure TTabControl.SetTabHeight(const AValue: Smallint); procedure TTabControl.SetTabHeight(const AValue: Smallint);