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

LCL: TCustomTabControl: Win32: Allow setting tab width and tab height. Issue #31109, patch from AlexeyT.

Browse Source 
git-svn-id: trunk@54002 -
This commit is contained in:
michl 2017-01-25 17:42:06 +00:00
parent 14145bdd4a
commit 6a9b9d4d9e
12 changed files with 143 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/lazcontrols/extendedtabcontrols.pas
View File

@ -642,7 +642,7 @@ begin
case TabControl.TabPosition of
tpTop,tpBottom:
begin
NewHeight:=TabHeight;
NewHeight:=TabControl.TabHeight;
if NewHeight<=0 then
NewHeight:=NoteBook.GetMinimumTabHeight;
NewHeight:=min(TabControl.ClientHeight,NewHeight);
@ -682,7 +682,7 @@ begin
tpLeft,tpRight:
begin
NewWidth := TabWidth;
NewWidth := TabControl.TabWidth;
if NewWidth<=0 then
NewWidth:=NoteBook.GetMinimumTabWidth;
NewWidth:=Min(TabControl.ClientWidth,NewWidth);

33
lcl/comctrls.pp
View File

@ -361,7 +361,9 @@ type
nboShowCloseButtons, nboMultiLine, nboHidePageListPopup,
nboKeyboardTabSwitch, nboShowAddTabButton, nboDoChangeOnSetIndex);
TCTabControlOptions = set of TCTabControlOption;
TCTabControlCapability = (nbcShowCloseButtons, nbcMultiLine, nbcPageListPopup, nbcShowAddTabButton);
TCTabControlCapability = (
nbcShowCloseButtons, nbcMultiLine, nbcPageListPopup, nbcShowAddTabButton,
nbcTabsSizeable);
TCTabControlCapabilities = set of TCTabControlCapability;
// Don't use anymore the old names of these types
// TNotebook is unrelated to CustomTabControl, so the types were renamed to
@ -401,6 +403,7 @@ type
procedure DoSendPageIndex;
procedure DoSendShowTabs;
procedure DoSendTabPosition;
procedure DoSendTabSize;
procedure DoImageListChange(Sender: TObject);
function GetActivePage: String;
function GetActivePageComponent: TCustomPage;
@ -419,7 +422,9 @@ type
procedure SetPageIndex(AValue: Integer);
procedure SetPages(AValue: TStrings);
procedure SetShowTabs(AValue: Boolean);
procedure SetTabHeight(AValue: Smallint);
procedure SetTabPosition(tabPos: TTabPosition); virtual;
procedure SetTabWidth(AValue: Smallint);
procedure ShowCurrentPage;
procedure UpdateAllDesignerFlags;
procedure UpdateDesignerFlags(APageIndex: integer);
@ -467,9 +472,7 @@ type
property ScrollOpposite: Boolean read FScrollOpposite write FScrollOpposite default False;
property Style: TTabStyle read FStyle write SetStyle default tsTabs;
property Tabs: TStrings read FAccess write SetPages;
property TabHeight: Smallint read FTabHeight write FTabHeight default 0;
property TabIndex: Integer read FPageIndex write SetPageIndex default -1;
property TabWidth: Smallint read FTabWidth write FTabWidth default 0;
property OnChange: TNotifyEvent read FOnPageChanged write FOnPageChanged;
property OnDrawTab: TDrawTabEvent read FOnDrawTab write FOnDrawTab; deprecated 'Will be deleted in Lazarus 1.8';
public
@ -502,7 +505,9 @@ type
//property PageList: TList read FPageList; - iff paged
property Pages: TStrings read FAccess write SetPages;
property ShowTabs: Boolean read FShowTabs write SetShowTabs default True;
property TabHeight: Smallint read FTabHeight write SetTabHeight default 0;
property TabPosition: TTabPosition read FTabPosition write SetTabPosition default tpTop;
property TabWidth: Smallint read FTabWidth write SetTabWidth default 0;
published
property TabStop default true;
end;
@ -625,12 +630,12 @@ type
property ShowHint;
property ShowTabs;
//property Style;
//property TabHeight;
property TabHeight;
property TabIndex;
property TabOrder;
property TabPosition;
property TabStop;
//property TabWidth;
property TabWidth;
property Visible;
property OnChange;
property OnChanging;
@ -676,8 +681,6 @@ type
FRaggedRight: Boolean;
FScrollOpposite: Boolean;
FTabControl: TTabControl;
FTabHeight: Smallint;
FTabWidth: Smallint;
FUpdateCount: integer;
protected
function GetTabIndex: integer; virtual; abstract;
@ -688,9 +691,7 @@ type
procedure SetOwnerDraw(const AValue: Boolean); virtual;
procedure SetRaggedRight(const AValue: Boolean); virtual;
procedure SetScrollOpposite(const AValue: Boolean); virtual;
procedure SetTabHeight(const AValue: Smallint); virtual;
procedure SetTabIndex(const AValue: integer); virtual; abstract;
procedure SetTabWidth(const AValue: Smallint); virtual;
public
constructor Create(TheTabControl: TTabControl); virtual;
function GetHitTestInfoAt(X, Y: Integer): THitTests; virtual;
@ -716,8 +717,6 @@ type
property RaggedRight: Boolean read FRaggedRight write SetRaggedRight;
property ScrollOpposite: Boolean read FScrollOpposite
write SetScrollOpposite;
property TabHeight: Smallint read FTabHeight write SetTabHeight;
property TabWidth: Smallint read FTabWidth write SetTabWidth;
end;
{ TNoteBookStringsTabControl }
@ -765,9 +764,7 @@ type
procedure SetMultiLine(const AValue: Boolean); override;
procedure SetTabIndex(const AValue: integer); override;
procedure SetUpdateState(Updating: Boolean); override;
procedure SetTabHeight(const AValue: Smallint); override;
procedure SetTabPosition(AValue: TTabPosition);
procedure SetTabWidth(const AValue: Smallint); override;
public
constructor Create(TheTabControl: TTabControl); override;
destructor Destroy; override;
@ -805,11 +802,9 @@ type
function GetOwnerDraw: Boolean;
function GetRaggedRight: Boolean;
function GetScrollOpposite: Boolean;
function GetTabHeight: Smallint;
function GetTabIndex: Integer;
function GetTabRectWithBorder: TRect;
function GetTabStop: Boolean;
function GetTabWidth: Smallint;
procedure SetHotTrack(const AValue: Boolean);
procedure SetImages(const AValue: TCustomImageList);
procedure SetMultiLine(const AValue: Boolean);
@ -818,11 +813,11 @@ type
procedure SetRaggedRight(const AValue: Boolean);
procedure SetScrollOpposite(const AValue: Boolean);
procedure SetStyle(AValue: TTabStyle); override;
procedure SetTabHeight(const AValue: Smallint);
procedure SetTabHeight(AValue: Smallint);
procedure SetTabPosition(AValue: TTabPosition); override;
procedure SetTabs(const AValue: TStrings);
procedure SetTabStop(const AValue: Boolean);
procedure SetTabWidth(const AValue: Smallint);
procedure SetTabWidth(AValue: Smallint);
protected
procedure SetOptions(const AValue: TCTabControlOptions); override;
procedure AddRemovePageHandle(APage: TCustomPage); override;
@ -873,12 +868,12 @@ type
property ScrollOpposite: Boolean read GetScrollOpposite
write SetScrollOpposite default False;
property Style default tsTabs;
property TabHeight: Smallint read GetTabHeight write SetTabHeight default 0;
property TabPosition default tpTop;
property TabWidth: Smallint read GetTabWidth write SetTabWidth default 0;
property TabHeight: Smallint read FTabHeight write SetTabHeight default 0;
property TabIndex: Integer read GetTabIndex write SetTabIndex default -1;
property Tabs: TStrings read FTabs write SetTabs;
property TabStop: Boolean read GetTabStop write SetTabStop default true; // workaround, see #30305
property TabWidth: Smallint read FTabWidth write SetTabWidth default 0;
//
property Align;
property Anchors;

30
lcl/include/customnotebook.inc
View File

@ -849,6 +849,17 @@ begin
DoSendShowTabs;
end;
{------------------------------------------------------------------------------
TCustomTabControl SetTabHeight
------------------------------------------------------------------------------}
procedure TCustomTabControl.SetTabHeight(AValue: Smallint);
begin
if FTabHeight = AValue then Exit;
if not (nbcTabsSizeable in GetCapabilities) then Exit;
FTabHeight := AValue;
DoSendTabSize;
end;
{------------------------------------------------------------------------------
TCustomTabControl SetTabPosition
------------------------------------------------------------------------------}
@ -859,6 +870,17 @@ begin
DoSendTabPosition;
end;
{------------------------------------------------------------------------------
TCustomTabControl SetTabWidth
------------------------------------------------------------------------------}
procedure TCustomTabControl.SetTabWidth(AValue: Smallint);
begin
if FTabWidth = AValue then Exit;
if not (nbcTabsSizeable in GetCapabilities) then Exit;
FTabWidth := AValue;
DoSendTabSize;
end;
{------------------------------------------------------------------------------
procedure TCustomTabControl.UpdateAllDesignerFlags;
------------------------------------------------------------------------------}
@ -1155,6 +1177,14 @@ begin
TWSCustomTabControlClass(WidgetSetClass).SetTabPosition(Self, FTabPosition);
end;
procedure TCustomTabControl.DoSendTabSize;
begin
if not HandleAllocated or (csLoading in ComponentState) then exit;
TWSCustomTabControlClass(WidgetSetClass).SetTabSize(Self, FTabWidth, FTabHeight);
DoSendTabPosition;
Invalidate;
end;
procedure TCustomTabControl.DoImageListChange(Sender: TObject);
begin
if HandleAllocated then

58
lcl/include/tabcontrol.inc
View File

@ -59,18 +59,6 @@ begin
FScrollOpposite:=AValue;
end;
procedure TTabControlStrings.SetTabHeight(const AValue: Smallint);
begin
if FTabHeight=AValue then exit;
FTabHeight:=AValue;
end;
procedure TTabControlStrings.SetTabWidth(const AValue: Smallint);
begin
if FTabWidth=AValue then exit;
FTabWidth:=AValue;
end;
constructor TTabControlStrings.Create(TheTabControl: TTabControl);
begin
inherited Create;
@ -81,8 +69,6 @@ begin
FOwnerDraw:=false;
FRaggedRight:=false;
FScrollOpposite:=false;
FTabHeight:=0;
FTabWidth:=0;
end;
procedure TTabControlStrings.TabControlBoundsChange;
@ -322,20 +308,6 @@ begin
FNoteBook.Pages.EndUpdate;
end;
procedure TTabControlNoteBookStrings.SetTabHeight(const AValue: Smallint);
begin
if TabHeight=AValue then exit;
inherited SetTabHeight(AValue);
TabControlBoundsChange;
end;
procedure TTabControlNoteBookStrings.SetTabWidth(const AValue: Smallint);
begin
if TabWidth=AValue then exit;
inherited SetTabWidth(AValue);
TabControlBoundsChange;
end;
function TTabControlNoteBookStrings.GetTabIndex: integer;
begin
Result:=FNoteBook.PageIndex;
@ -401,7 +373,7 @@ begin
case TabControl.TabPosition of
tpTop,tpBottom:
begin
NewHeight:=TabHeight;
NewHeight:=TabControl.TabHeight;
if NewHeight<=0 then
NewHeight:=FNoteBook.GetMinimumTabHeight;
NewHeight:=Min(TabControl.ClientHeight,NewHeight);
@ -414,9 +386,7 @@ begin
tpLeft,tpRight:
begin
NewWidth:=TabWidth;
if NewWidth<=0 then
NewWidth:=FNoteBook.GetMinimumTabWidth;
NewWidth:=Max(TabControl.TabHeight,FNoteBook.GetMinimumTabWidth);
NewWidth:=Min(TabControl.Width,NewWidth);
if TabControl.TabPosition=tpLeft then
FNoteBook.SetBounds(0,0,NewWidth,TabControl.ClientHeight)
@ -487,21 +457,11 @@ begin
Result:=TTabControlStrings(FTabs).ScrollOpposite;
end;
function TTabControl.GetTabHeight: Smallint;
begin
Result:=TTabControlStrings(FTabs).TabHeight;
end;
function TTabControl.GetTabIndex: Integer;
begin
Result:=TTabControlStrings(FTabs).TabIndex;
end;
function TTabControl.GetTabWidth: Smallint;
begin
Result:=TTabControlStrings(FTabs).TabWidth;
end;
procedure TTabControl.SetHotTrack(const AValue: Boolean);
begin
TTabControlStrings(FTabs).HotTrack:=AValue;
@ -551,9 +511,12 @@ begin
TTabControlNoteBookStrings(FTabs).Style := AValue;
end;
procedure TTabControl.SetTabHeight(const AValue: Smallint);
procedure TTabControl.SetTabHeight(AValue: Smallint);
begin
TTabControlStrings(FTabs).TabHeight:=AValue;
if FTabHeight = AValue then exit;
if not (nbcTabsSizeable in GetCapabilities) then Exit;
FTabHeight := AValue;
TTabControlNoteBookStrings(FTabs).NoteBook.TabHeight := AValue;
end;
procedure TTabControl.SetTabPosition(AValue: TTabPosition);
@ -574,9 +537,12 @@ begin
TTabControlNoteBookStrings(FTabs).NoteBook.TabStop := AValue;
end;
procedure TTabControl.SetTabWidth(const AValue: Smallint);
procedure TTabControl.SetTabWidth(AValue: Smallint);
begin
TTabControlStrings(FTabs).TabWidth:=AValue;
if FTabWidth = AValue then Exit;
if not (nbcTabsSizeable in GetCapabilities) then Exit;
FTabWidth := AValue;
TTabControlNoteBookStrings(FTabs).NoteBook.TabWidth := AValue;
end;
procedure TTabControl.SetOptions(const AValue: TCTabControlOptions);

12
lcl/interfaces/carbon/issues.xml
View File

@ -126,9 +126,21 @@ After obtaining a CGImageRef, the next step to implement the RawImage_fromDevice
<issue name="TPageControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TPageControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TPageControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TTabControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TTabControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TTabControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TMenu.OwnerDraw">
<short>not supported</short>
</issue>

12
lcl/interfaces/gtk/issues.xml
View File

@ -13,6 +13,12 @@
<issue name="TPageControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TPageControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TPageControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TPrinter.FileName">
<short>The format of generated file is system dependant</short>
<descr>The content of file created by using this property depends of the printer backend used, for example when using CUPS (mainly under Unix type systems) it will be postscript while under Windows it will be in a printer unspecified format</descr>
@ -20,6 +26,12 @@
<issue name="TTabControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TTabControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TTabControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TMenu.OwnerDraw">
<short>not supported</short>
</issue>

12
lcl/interfaces/gtk2/issues.xml
View File

@ -25,6 +25,12 @@
<issue name="TPageControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TPageControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TPageControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TPrinter.FileName">
<short>The format of generated file is system dependant</short>
<descr>The content of file created by using this property depends of the printer backend used, for example when using CUPS (mainly under Unix type systems) it will be postscript while under Windows it will be in a printer unspecified format</descr>
@ -32,6 +38,12 @@
<issue name="TTabControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TTabControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TTabControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TDateEdit.CalendarDisplaySettings.dsStartMon">
<short>TDateEdit.CalendarDisplaySettings.dsStartMon is ignored in GTK+ since 2.4</short>
<descr>Since GTK+ 2.4, this option is deprecated and ignored by GTK+. The information on which day the calendar week starts is derived from the locale.</descr>

12
lcl/interfaces/qt/issues.xml
View File

@ -24,9 +24,21 @@
<issue name="TPageControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TPageControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TPageControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TTabControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TTabControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TTabControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TListBox.Columns">
<short>Multiple columns is not supported</short>
</issue>

12
lcl/interfaces/qt5/issues.xml
View File

@ -24,9 +24,21 @@
<issue name="TPageControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TPageControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TPageControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TTabControl.MultiLine">
<short>MultiLine property is not supported</short>
</issue>
<issue name="TTabControl.TabHeight">
<short>Changing of default tab height is not supported</short>
</issue>
<issue name="TTabControl.TabWidth">
<short>Changing of default tab width is not supported</short>
</issue>
<issue name="TListBox.Columns">
<short>Multiple columns is not supported</short>
</issue>

19
lcl/interfaces/win32/win32pagecontrol.inc
View File

@ -304,6 +304,8 @@ begin
Flags := Flags or TabPositionFlags[TCustomTabControl(AWinControl).TabPosition];
if nboMultiLine in TCustomTabControl(AWinControl).Options then
Flags := Flags or TCS_MULTILINE;
if TCustomTabControl(AWinControl).TabWidth > 0 then
Flags := Flags or TCS_FIXEDWIDTH;
pClassName := WC_TABCONTROL;
end;
end;
@ -320,6 +322,10 @@ begin
Params.WindowInfo^.ParentMsgHandler := @TabControlParentMsgHandler;
Params.WindowInfo^.needParentPaint := false;
Params.WindowInfo^.ClientOffsetProc := @TabControlClientOffset;
SendMessage(Result, TCM_SETITEMSIZE, 0, MakeLParam(
TCustomTabControl(AWinControl).TabWidth,
TCustomTabControl(AWinControl).TabHeight));
end;
end;
@ -565,7 +571,7 @@ end;
class function TWin32WSCustomTabControl.GetCapabilities: TCTabControlCapabilities;
begin
Result:=[nbcMultiLine];
Result:=[nbcMultiLine, nbcTabsSizeable];
end;
class function TWin32WSCustomTabControl.GetDesignInteractive(
@ -586,6 +592,17 @@ begin
Result := (AIndex <> -1) and (AIndex <> ACurIndex);
end;
class procedure TWin32WSCustomTabControl.SetTabSize(
const ATabControl: TCustomTabControl;
const ATabWidth, ATabHeight: integer);
begin
if ATabControl is TTabControl then
exit;
Windows.SendMessage(ATabControl.Handle, TCM_SETITEMSIZE,
0, MakeLParam(ATabWidth, ATabHeight));
end;
class procedure TWin32WSCustomTabControl.SetImageList(
const ATabControl: TCustomTabControl; const AImageList: TCustomImageList);
begin

1
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -69,6 +69,7 @@ type
class function GetTabRect(const ATabControl: TCustomTabControl; const AIndex: Integer): TRect; override;
class function GetCapabilities: TCTabControlCapabilities;override;
class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
class procedure SetTabSize(const ATabControl: TCustomTabControl; const ATabWidth, ATabHeight: integer); override;
class procedure SetImageList(const ATabControl: TCustomTabControl; const AImageList: TCustomImageList); override;
class procedure SetPageIndex(const ATabControl: TCustomTabControl; const AIndex: integer); override;
class procedure SetTabPosition(const ATabControl: TCustomTabControl; const ATabPosition: TTabPosition); override;

6
lcl/widgetset/wscomctrls.pp
View File

@ -65,6 +65,7 @@ type
class function GetTabIndexAtPos(const ATabControl: TCustomTabControl; const AClientPos: TPoint): integer; virtual;
class function GetTabRect(const ATabControl: TCustomTabControl; const AIndex: Integer): TRect; virtual;
class function GetCapabilities: TCTabControlCapabilities; virtual;
class procedure SetTabSize(const ATabControl: TCustomTabControl; const ATabWidth, ATabHeight: integer); virtual;
class procedure SetImageList(const ATabControl: TCustomTabControl; const AImageList: TCustomImageList); virtual;
class procedure SetPageIndex(const ATabControl: TCustomTabControl; const AIndex: integer); virtual;
class procedure SetTabCaption(const ATabControl: TCustomTabControl; const AChild: TCustomPage; const AText: string); virtual;
@ -360,6 +361,11 @@ begin
Result:=[];
end;
class procedure TWSCustomTabControl.SetTabSize(
const ATabControl: TCustomTabControl; const ATabWidth, ATabHeight: integer);
begin
end;
class procedure TWSCustomTabControl.SetImageList(
const ATabControl: TCustomTabControl; const AImageList: TCustomImageList);
begin