* * *

Author Topic: PageControl tab color?  (Read 6829 times)

IPguy

  • Sr. Member
  • ****
  • Posts: 385
PageControl tab color?
« on: June 27, 2010, 02:48:20 pm »
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

  • Sr. Member
  • ****
  • Posts: 485
Re: PageControl tab color?
« Reply #1 on: July 01, 2010, 11:55:02 am »
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

  • New member
  • *
  • Posts: 26
Re: PageControl tab color?
« Reply #2 on: March 08, 2017, 11:58:28 am »
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

  • Jr. Member
  • **
  • Posts: 65
Re: PageControl tab color?
« Reply #3 on: March 08, 2017, 03:14:50 pm »
You can try renaming the Parameter "Active" to something like "aActive" and see if that fixes it (might conflict with the property form.active)
Getting back into programming after 8+ years.

wp

  • Hero Member
  • *****
  • Posts: 3353
Re: PageControl tab color?
« Reply #4 on: March 08, 2017, 03:28:22 pm »
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.
« Last Edit: March 08, 2017, 10:44:43 pm by wp »
Lazarus trunk / fpc 3.0.0 / Win32

Przemyslav

  • New member
  • *
  • Posts: 26
Re: PageControl tab color?
« Reply #5 on: March 08, 2017, 10:40:15 pm »
Thanks for information and help :)

Alextp

  • Sr. Member
  • ****
  • Posts: 392
    • UVViewSoft
Re: PageControl tab color?
« Reply #6 on: March 09, 2017, 09:27:58 am »
PageControl's OnDrawTab event removed (it was before). So you need another component. E.g. http://wiki.freepascal.org/ATTabs

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus