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

LCL: Add lacking functionality for TPageControl, mostly for Windows. Issue #34867, patch from Marcin Wiazowski.

Browse Source 
git-svn-id: trunk@62201 -
This commit is contained in:
juha 2019-11-05 17:45:52 +00:00
parent 4c30be883f
commit 915d805de0
3 changed files with 34 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lcl/comctrls.pp
View File

@ -464,12 +464,6 @@ type
//Delphi compatible properties
function CanChange: 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;
property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False;
property RaggedRight: Boolean read FRaggedRight write FRaggedRight default False;
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 TabIndex: Integer read FPageIndex write SetPageIndex default -1;
property OnChange: TNotifyEvent read FOnPageChanged write FOnPageChanged;
@ -488,21 +482,27 @@ type
function PageToTabIndex(AIndex: integer): integer;
public
procedure DoCloseTabClicked(APage: TCustomPage); virtual;
property HotTrack: Boolean read FHotTrack write FHotTrack default False;
property Images: TCustomImageList read FImages write SetImages;
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
property MultiLine: Boolean read GetMultiLine write SetMultiLine default False;
property MultiSelect: Boolean read FMultiSelect write FMultiSelect default False;
property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
property OnCloseTabClicked: TNotifyEvent read FOnCloseTabClicked
write FOnCloseTabClicked;
property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex
write FOnGetImageIndex;
property Options: TCTabControlOptions read FOptions write SetOptions default [];
property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False;
property Page[Index: Integer]: TCustomPage read GetPage;
property PageCount: integer read GetPageCount;
property PageIndex: Integer read FPageIndex write SetPageIndex default -1;
//property PageList: TList read FPageList; - iff paged
property Pages: TStrings read FAccess write SetPages;
property RaggedRight: Boolean read FRaggedRight write FRaggedRight default False;
property ScrollOpposite: Boolean read FScrollOpposite write FScrollOpposite default False;
property ShowTabs: Boolean read FShowTabs write SetShowTabs default True;
property Style: TTabStyle read FStyle write SetStyle default tsTabs;
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;
@ -615,7 +615,7 @@ type
property DragMode;
property Enabled;
property Font;
//property HotTrack;
property HotTrack;
property Images;
property ImagesWidth;
property MultiLine;
@ -624,11 +624,11 @@ type
property ParentFont;
property ParentShowHint;
property PopupMenu;
//property RaggedRight;
//property ScrollOpposite;
property RaggedRight;
property ScrollOpposite;
property ShowHint;
property ShowTabs;
//property Style;
property Style;
property TabHeight;
property TabIndex;
property TabOrder;

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

@ -343,11 +343,16 @@ end;
class function TWin32WSCustomTabControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
const
TabPositionFlags: array[TTabPosition] of DWord = (
{ tpTop } 0,
{ tpBottom } TCS_BOTTOM,
{ tpLeft } TCS_VERTICAL or TCS_MULTILINE,
{ tpRight } TCS_VERTICAL or TCS_RIGHT or TCS_MULTILINE
TabPositionFlags: array[TTabPosition, Boolean] of DWord = (
{ tpTop } (0, 0),
{ tpBottom } (TCS_BOTTOM, TCS_BOTTOM),
{ tpLeft } (TCS_MULTILINE or TCS_VERTICAL, TCS_MULTILINE or TCS_VERTICAL or TCS_RIGHT),
{ tpRight } (TCS_MULTILINE or TCS_VERTICAL or TCS_RIGHT, TCS_MULTILINE or TCS_VERTICAL)
);
TabStyleFlags: array[TTabStyle] of DWord = (
{ tsTabs } TCS_TABS,
{ tsButtons } TCS_BUTTONS,
{ tsFlatButtons } TCS_BUTTONS or TCS_FLATBUTTONS
);
var
Params: TCreateWindowExParams;
@ -365,11 +370,24 @@ begin
pClassName := @ClsName[0];
end
else begin
Flags := Flags or TabPositionFlags[T.TabPosition];
Flags := Flags or TabPositionFlags[T.TabPosition, T.UseRightToLeftAlignment];
Flags := Flags or TabStyleFlags[T.Style];
if not T.TabStop then
Flags := Flags or TCS_FOCUSNEVER;
if nboMultiLine in T.Options then
Flags := Flags or TCS_MULTILINE;
if T.MultiSelect then
Flags := Flags or TCS_MULTISELECT;
if T.RaggedRight then
Flags := Flags or TCS_RAGGEDRIGHT;
if T.ScrollOpposite then
Flags := Flags or TCS_SCROLLOPPOSITE;
if T.TabWidth > 0 then
Flags := Flags or TCS_FIXEDWIDTH;
if T.HotTrack and not (csDesigning in T.ComponentState) then
Flags := Flags or TCS_HOTTRACK;
if T.OwnerDraw and not (csDesigning in T.ComponentState) then
Flags := Flags or TCS_OWNERDRAWFIXED;
pClassName := WC_TABCONTROL;
end;
end;

5
lcl/widgetset/wscomctrls.pp
View File

@ -874,11 +874,6 @@ const
begin
if Done then exit;
WSRegisterPageControl;
RegisterPropertyToSkip(TPageControl, 'Style', 'VCL compatibility property', '');
RegisterPropertyToSkip(TPageControl, 'HotTrack', 'VCL compatibility property', '');
RegisterPropertyToSkip(TPageControl, 'MultiLine', 'VCL compatibility property', '');
RegisterPropertyToSkip(TPageControl, 'TabWidth', 'VCL compatibility property', '');
RegisterPropertyToSkip(TPageControl, 'TabHeight', 'VCL compatibility property', '');
RegisterPropertyToSkip(TPageControl, 'OnPageChanged', 'Was removed in Laz 0.9.31 due to incompatibilities with OnChange, which does the same thing.', '');
// if not WSRegisterPageControl then
// RegisterWSComponent(TPageControl, TWSPageControl);