PageControl tab color?

[IPguy]

I can set the tPageControl tabsheet body color (tTabSheet.color := ...).

Is there a property to set the corresponding tab color?

Using: Lazarus: 0.9.29 (2010-06-13).

[garlar27]

In Delphi I used to set OwnerDraw Property to True in order to use the TPageControl.OnPaint event. In Lazarus these propertys and events already exist, BUT they are hidden as private or protected so they are unreachable, and I don't know why (maybe due to crossplatform issues).

It would be nice to have'em published.

[Przemyslav]

I have the same question. I would like to have color tabs on TabSheet. I have code for C++ which works very well:

Code: Pascal  [Select][+][-]

1. void __fastcall TForm1::PageControl1DrawTab(TCustomTabControl *Control,
2.       int TabIndex, const TRect &Rect, bool Active) // kolor zakladek
3. {
4.         try
5.         {
6.                 AnsiString z1; TColor f1,f2;
7.                 TTabSheet *PTab;
8.                 TCanvas *ACanvas;
9.                 TRect CRect;
10.  
11.                 CRect = Rect;
12.  
13.                 PTab = PageControl1->Pages[TabIndex];
14.                 ACanvas = Control->Canvas;
15.                 z1 = PTab->Caption;
16.  
17.                 f1 = clBtnFace; //domyslny kolor zakladek i tekstu
18.                 f2 = clWindowText;
19.  
20.                 if (Active == true)
21.                 {
22.                         f1 = clBtnFace; f2 = clWindowText; // domyslny kolor zakladek i tekstu, jesli aktywna
23.                         switch(TabIndex)
24.                         {
25.                                 // poszczegolna definicja kolorow i tekstu dla zakladek
26.                                 case 0: f1 = clSkyBlue; f2 = clBlack; break;
27.                                 case 1: f1 = clSkyBlue; f2 = clBlack; break;
28.                                 case 2: f1 = clSkyBlue; f2 = clBlack; break;
29.                                 case 3: f1 = clSkyBlue; f2 = clBlack; break;
30.                                 case 4: f1 = clMoneyGreen; f2 = clBlack; break;
31.                                 case 5: f1 = clMoneyGreen; f2 = clBlack; break;
32.                                 case 6: f1 = clMoneyGreen; f2 = clBlack; break;
33.                                 case 7: f1 = clMoneyGreen; f2 = clBlack; break;
34.                                 case 8: f1 = clMoneyGreen; f2 = clBlack; break;
35.                                 case 9: f1 = clSilver; f2 = clBlack; break;
36.                                 case 10: f1 = clSilver; f2 = clBlack; break;
37.                                 case 11: f1 = clSilver; f2 = clBlack; break;
38.                                 case 12: f1 = clSilver; f2 = clBlack; break;
39.                                 case 13: f1 = clCream; f2 = clBlack; break;
40.                         }
41.                 }
42.  
43.                 ACanvas->Brush->Color = f1;
44.                 ACanvas->Font->Color = f2;
45.  
46.                 ACanvas->Font->Name = "Segoe UI";
47.                 ACanvas->Font->Size = 8;
48.                 ACanvas->FillRect(CRect);
49.                 DrawText(ACanvas->Handle,z1.c_str(),-1,&CRect,DT_CENTER | DT_VCENTER | DT_SINGLELINE);
50.         }
51.  
52.         catch(Exception& e)
53.         {
54.                 MessageBox(NULL, e.Message.c_str(), "TForm1::PageControl1DrawTab()", MB_OK | MB_ICONERROR);
55.         }
56. }

In Lazarus I tried like this - code I found on the net for example:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls, StdCtrls, EditBtn, Menus, Buttons, Windows, Types, LCLType, Messages, ShellApi;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     PageControl1: TPageControl;
16.     TabSheet1: TTabSheet;
17.     TabSheet2: TTabSheet;
18.     TabSheet3: TTabSheet;
19.     TabSheet4: TTabSheet;
20.     procedure FormCreate(Sender: TObject);
21.     procedure PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
22.   private
23.     { private declarations }
24.   public
25.     { public declarations }
26.   end;
27.  
28. var
29.   Form1: TForm1;
30.  
31. implementation
32.  
33. {$R *.lfm}
34.  
35. { TForm1 }
36.  
37. procedure TForm1.FormCreate(Sender: TObject);
38. begin
39.    PageControl1.OwnerDraw:=true;
40.    TabSheet1.Color:= clMoneyGreen;
41. end;
42.  
43. Procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
44. TabIndex: Integer; const Rect: TRect; Active: Boolean);
45. begin
46.   case TabIndex of
47.     0: Control.Canvas.Brush.Color:=clgreen;
48.     1: Control.Canvas.Brush.Color:=clred;
49.     2: Control.Canvas.Brush.Color:=clblue;
50.     3: Control.Canvas.Brush.Color:=clYellow;
51.   end;
52.   Control.Canvas.TextOut(Rect.left+5,Rect.top+3,PageControl1.Pages[tabindex].Caption);
53.   PageControl1.Pages[TabIndex].Brush.Color:=Control.Canvas.Brush.Color;
54. end;
55.  
56. end.

But it doesn't work. I have error like:

Code: Pascal  [Select][+][-]

1. unit1.pas(21,101) Error: Duplicate identifier "Active"
2. C:\Users\pcisz\AppData\Local\Temp\unit1.pas

Could you help me?

[Girlbrush]

You can try renaming the Parameter "Active" to something like "aActive" and see if that fixes it (might conflict with the property form.active)

[wp]

In mode objfpc it is not allowed that parameters of methods have the same name as properties. Therefore, in Lazarus parameters usually are named with a prepended "A" -- "AActive" instead of "Active". Alternatively you can use mode Delphi where parameters and properties can be named equally.

But even after this modification your code will not work in Lazarus due to the widgetset-dependence of the control. In fact, the pagecontrol does not expose a canvas, and its method OnDrawTab has been removed a long time ago.

[Przemyslav]

Thanks for information and help

[AlexTP]

PageControl's OnDrawTab event removed (it was before). So you need another component. E.g. http://wiki.freepascal.org/ATTabs