View Issue Details

IDProjectCategoryView StatusLast Update
0034867PackagesLCLpublic2019-11-05 19:19
ReporterMarcin WiazowskiAssigned ToJuha Manninen 
PrioritynormalSeverityminorReproducibilityalways
Status assignedResolutionopen 
Product Version2.1 (SVN)Product Build60076 
Target VersionFixed in Version 
Summary0034867: TPageControl: lacking functionality added
DescriptionSome Delphi properties were missing in TPageControl - in particular: HotTrack, RaggedRight, ScrollOpposite and Style (Style is very important, because it chooses the control's visual style).


Moreover, some of the already existing properties were working improperly - in particular: TabStop and UseRightToLeftAlignment.


Fortunately, adding/fixing these functionalities is quite easy - just by setting some flags properly in TWin32WSCustomTabControl.CreateHandle implementation. So I'm attaching a patch that fixes the issues.


Some more detailed description of changes that the patch makes:

A) TPageControl: lacking properties have been published (by uncommenting them)

B) In TWin32WSCustomTabControl.CreateHandle implementation:

- Since TWin32WSCustomTabControl is not a TCustomTabControl's descendant, it cannot access TCustomTabControl's protected fields - but we must read them, so THookCustomTabControl has been declared and is used instead of TCustomTabControl.

- TabPositionFlags array now uses also the UseRightToLeftAlignment setting - so page control works properly on RTL systems, and its behavior is now consistent with Delphi.

- A newly introduced TabStyleFlags array handles the Style setting.

- The OwnerDraw setting is also handled properly now (although OwnerDraw property is still not published in TPageControl - because this functionality is not currently supported by the LCL implementation at all; however, the user may create his own TCustomTabControl's descendant, so TWin32WSCustomTabControl.CreateHandle should handle the OwnerDraw setting properly).

- All other newly introduced code just sets the needed flags in the Flags variable.


Regards
TagsNo tags attached.
Fixed in Revision
LazTarget
WidgetsetWin32/Win64
Attached Files
  • patch.diff (3,383 bytes)
    Index: lcl/comctrls.pp
    ===================================================================
    --- lcl/comctrls.pp	(revision 60076)
    +++ lcl/comctrls.pp	(working copy)
    @@ -616,7 +616,7 @@
         property DragMode;
         property Enabled;
         property Font;
    -    //property HotTrack;
    +    property HotTrack;
         property Images;
         property ImagesWidth;
         property MultiLine;
    @@ -625,11 +625,11 @@
         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;
    Index: lcl/interfaces/win32/win32pagecontrol.inc
    ===================================================================
    --- lcl/interfaces/win32/win32pagecontrol.inc	(revision 60076)
    +++ lcl/interfaces/win32/win32pagecontrol.inc	(working copy)
    @@ -342,20 +342,29 @@
       Result := WindowProc(Window, Msg, WParam, LParam);
     end;
     
    +type
    +  THookCustomTabControl = class(TCustomTabControl)
    +  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;
    -  T: TCustomTabControl;
    +  T: THookCustomTabControl; // Some fields are declared as protected in TCustomTabControl, but we must access them
     begin
    -  T := TCustomTabControl(AWinControl);
    +  T := THookCustomTabControl(AWinControl);
       // general initialization of Params
       PrepareCreateWindow(AWinControl, AParams, Params);
       // customization of Params
    @@ -367,11 +376,24 @@
           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;
    
    patch.diff (3,383 bytes)
  • Test.zip (3,954 bytes)
  • Test.png (41,561 bytes)
    Test.png (41,561 bytes)
  • patch2.diff (969 bytes)
    Index: lcl/widgetset/wscomctrls.pp
    ===================================================================
    --- lcl/widgetset/wscomctrls.pp	(revision 60086)
    +++ lcl/widgetset/wscomctrls.pp	(working copy)
    @@ -815,11 +815,6 @@
     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);
    
    patch2.diff (969 bytes)

Activities

Marcin Wiazowski

2019-01-13 22:15

reporter  

patch.diff (3,383 bytes)
Index: lcl/comctrls.pp
===================================================================
--- lcl/comctrls.pp	(revision 60076)
+++ lcl/comctrls.pp	(working copy)
@@ -616,7 +616,7 @@
     property DragMode;
     property Enabled;
     property Font;
-    //property HotTrack;
+    property HotTrack;
     property Images;
     property ImagesWidth;
     property MultiLine;
@@ -625,11 +625,11 @@
     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;
Index: lcl/interfaces/win32/win32pagecontrol.inc
===================================================================
--- lcl/interfaces/win32/win32pagecontrol.inc	(revision 60076)
+++ lcl/interfaces/win32/win32pagecontrol.inc	(working copy)
@@ -342,20 +342,29 @@
   Result := WindowProc(Window, Msg, WParam, LParam);
 end;
 
+type
+  THookCustomTabControl = class(TCustomTabControl)
+  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;
-  T: TCustomTabControl;
+  T: THookCustomTabControl; // Some fields are declared as protected in TCustomTabControl, but we must access them
 begin
-  T := TCustomTabControl(AWinControl);
+  T := THookCustomTabControl(AWinControl);
   // general initialization of Params
   PrepareCreateWindow(AWinControl, AParams, Params);
   // customization of Params
@@ -367,11 +376,24 @@
       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;
patch.diff (3,383 bytes)

Marcin Wiazowski

2019-01-13 22:15

reporter  

Test.zip (3,954 bytes)

Marcin Wiazowski

2019-01-13 22:16

reporter  

Test.png (41,561 bytes)
Test.png (41,561 bytes)

Bart Broersma

2019-01-13 22:38

developer   ~0113385

So this is a Windows only addition of features?

Marcin Wiazowski

2019-01-13 23:00

reporter   ~0113386

Yes.

Other platforms are not affected by this patch - with one exception: newly published HotTrack, RaggedRight and ScrollOpposite properties will be available also under all other platforms - but they will do nothing on them (exactly as Style property on Windows platform now - it is available, but does nothing and is ignored).

Regards

Martin Friebe

2019-01-13 23:14

manager   ~0113387

The featured that got uncommented already existed, but accessible from code only.

The published propertise (all or most of them) were added as comments in the initial addition of TPageControl (in 2003). Back then there was no implementation.
They later got added to the baseclass, but never uncommented. r31686, r42560 (No idea why they where not published)

From the above they probably should be published.
However they may not work with all widgetsets.
So for each of them, it has to be established under which widgetsets they work, and for all others they need to be added to the OI's restriction tab.

-------------
Not a fan of another forced (THook) class access. I know there are others...
Currently haven't got the time to look for alternatives

Marcin Wiazowski

2019-01-15 01:35

reporter   ~0113418

> However they may not work with all widgetsets. So for each of them, it has to be established under which widgetsets they work

I searched through the whole LCL code and I can confirm, that currently no widgeset makes use of the Style, HotTrack, RaggedRight and ScrollOpposite properties (available in TCustomTabControl). There is only some stub code, that effectively only reads from or writes to FStyle, FHotTrack, FRaggedRight and FScrollOpposite fields - without making any other use of them.

So, after applying the patch, only the Windows widgeset will effectively use them. This isn't in fact surprising, since these properties have been created to handle Windows-specific behavior.



I also realized, that one more change should be done along with applying patch.diff - in wscomctrls.pp, in RegisterPageControl procedure, the following lines should be removed:

RegisterPropertyToSkip(TPageControl, 'Style' ... - since it will become available
RegisterPropertyToSkip(TPageControl, 'HotTrack' ... - since it will become available
RegisterPropertyToSkip(TPageControl, 'MultiLine' ... - since it IS ALREADY available
RegisterPropertyToSkip(TPageControl, 'TabWidth' ... - since it IS ALREADY available
RegisterPropertyToSkip(TPageControl, 'TabHeight' ... - since it IS ALREADY available

So I'm attaching patch2.diff for this purpose.

Regards

Marcin Wiazowski

2019-01-15 01:36

reporter  

patch2.diff (969 bytes)
Index: lcl/widgetset/wscomctrls.pp
===================================================================
--- lcl/widgetset/wscomctrls.pp	(revision 60086)
+++ lcl/widgetset/wscomctrls.pp	(working copy)
@@ -815,11 +815,6 @@
 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);
patch2.diff (969 bytes)

Alexey Tor.

2019-01-15 13:09

reporter   ~0113426

Good work, thank you.

Juha Manninen

2019-11-05 19:19

developer   ~0119080

I applied a modified version of the patches in r62201.
I made the protected properties public. I don't see good reasons against it. If they are needed publicly then they must be public.
I will update the OI's restriction tab if I find out how to do it ... but honestly it feels a little useless. Who really reads the tab and makes decisions based on it?
Supporting those extra goodies now for Windows is a good compromise as the original component was wrapped around Windows PageControl. It does not break the other widgetsets even if the extras do not works.

Issue History

Date Modified Username Field Change
2019-01-13 22:15 Marcin Wiazowski New Issue
2019-01-13 22:15 Marcin Wiazowski File Added: patch.diff
2019-01-13 22:15 Marcin Wiazowski File Added: Test.zip
2019-01-13 22:16 Marcin Wiazowski File Added: Test.png
2019-01-13 22:38 Bart Broersma Note Added: 0113385
2019-01-13 23:00 Marcin Wiazowski Note Added: 0113386
2019-01-13 23:14 Martin Friebe Note Added: 0113387
2019-01-15 01:35 Marcin Wiazowski Note Added: 0113418
2019-01-15 01:36 Marcin Wiazowski File Added: patch2.diff
2019-01-15 13:09 Alexey Tor. Note Added: 0113426
2019-03-16 19:28 Juha Manninen Assigned To => Juha Manninen
2019-03-16 19:28 Juha Manninen Status new => assigned
2019-11-05 19:19 Juha Manninen Note Added: 0119080