Merge branch 'jmarcl_tabsheet' into fixes_1.4

2 files changed, 94 insertions, 22 deletions

diff --git a/examples/gui/tabtest/tabtest.lpr b/examples/gui/tabtest/tabtest.lpr
index 3675e29a..d5bac5b9 100644
--- a/examples/gui/tabtest/tabtest.lpr
+++ b/examples/gui/tabtest/tabtest.lpr
@@ -22,6 +22,7 @@ type
     btn2, btn3: TfpgButton;
     chkSort: TfpgCheckBox;
     cbTabPos: TfpgComboBox;
+    lblHeight: TfpgLabel;
     edtHeight: TfpgEditInteger;
     lbl: TfpgLabel;
     procedure   TabSheet4Painting(Sender: TObject);
@@ -106,6 +107,8 @@ begin
   pcMain.Width    := Width - 20;
   pcMain.Height   := 300;
   pcMain.Anchors  := [anLeft, anTop, anRight, anBottom];
+  pcMain.ActiveTabColor:= clOrangeRed;
+  pcMain.ActiveTabTextColor:= clYellow;
 //  pcMain.FixedTabWidth:=150;
 
   // Tab One
@@ -124,6 +127,9 @@ begin
   // Tab Three
   tsThree := TfpgTabSheet.Create(pcMain);
   tsThree.Text := 'Tab Three';
+  tsThree.BackgroundColor:= clWheat;
+  tsThree.TabColor:= clLightBlue;
+  tsThree.TabTextColor:= clWhite;
   CreateLabel(tsThree, 80, 50, 'TabSheet Three');
   
   // Tab Four
@@ -156,9 +162,11 @@ begin
   cbTabPos.Hint := 'Tab position';
   cbTabPos.OnChange := @cbTabPosChanged;
 
-  CreateLabel(self, 390, 325, 'Height:');
+  lblHeight := CreateLabel(self, 390, 325, 'Height:');
+  lblHeight.Anchors := [anBottom, anLeft];
   edtHeight := CreateEditInteger(self, 435, 320, 30, 24, False);
   edtHeight.Value := 0;
+  edtHeight.Anchors := [anBottom, anLeft];
   edtHeight.Hint := 'Tab height';
   edtHeight.OnChange := @edtHeightChanged;
 end;
diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas
index 414c89a2..f15b59fa 100644
--- a/src/gui/fpg_tab.pas
+++ b/src/gui/fpg_tab.pas
@@ -1,7 +1,7 @@
 {
     fpGUI  -  Free Pascal GUI Toolkit
 
-    Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+    Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
     distribution, for details of the copyright.
 
     See the file COPYING.modifiedLGPL, included in this distribution,
@@ -55,6 +55,8 @@ type
     FPageControl: TfpgPageControl;
     FText: string;
     FTabVisible: boolean;
+    FTabColor: TfpgColor;
+    FTabTextColor: TfpgColor;
     function    GetPageControl: TfpgPageControl;
     function    GetPageIndex: Integer;
     function    GetText: string;
@@ -72,6 +74,8 @@ type
     property    PageIndex: Integer read GetPageIndex write SetPageIndex;
     property    PageControl: TfpgPageControl read FPageControl write SetPageControl;
     property    TabVisible: boolean read FTabVisible write FTabVisible;
+    property    TabColor: Tfpgcolor read FTabColor write FTabColor;
+    property    TabTextColor: TfpgColor read FTabTextColor write FTabTextColor;
   published
     property    BackgroundColor;
     property    Enabled;
@@ -105,6 +109,7 @@ type
     FLastRClickPos: TfpgPoint;
     FUpdateCount: Integer;
     FActiveTabColor: TfpgColor;
+    FActiveTabTextColor: TfpgColor;
     function    GetActivePageIndex: integer;
     function    GetPage(AIndex: integer): TfpgTabSheet;
     function    GetPageCount: Integer;
@@ -130,10 +135,12 @@ type
     procedure   SetTabPosition(const AValue: TfpgTabPosition);
     procedure   DoPageChange(ATabSheet: TfpgTabSheet);
     procedure   DoTabSheetClosing(ATabSheet: TfpgTabSheet);
-    function    DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
+    function    DrawTab(const ATabSheet: TfpgTabSheet; const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
     procedure   pmCloseTab(Sender: TObject);
     function    GetActiveTabColor: TfpgColor;
     procedure   SetActiveTabColor(AValue: TfpgColor);
+    function    GetActiveTabTextColor: TfpgColor;
+    procedure   SetActiveTabTextColor(AValue: TfpgColor);
   protected
     procedure   SetBackgroundColor(const AValue: TfpgColor); override;
     procedure   OrderSheets; // currently using bubblesort
@@ -159,7 +166,8 @@ type
     property    OnClosingTabSheet: TTabSheetClosing read FOnClosingTabSheet write FOnClosingTabSheet;
   published
     property    ActivePageIndex: integer read GetActivePageIndex write SetActivePageIndex default 0;
-    property    ActiveTabColor: TfpgColor read GetActiveTabColor write SetActiveTabColor default clWindowBackground;
+    property    ActiveTabColor: TfpgColor read GetActiveTabColor write SetActiveTabColor default clDefault;
+    property    ActiveTabTextColor: TfpgColor read GetActiveTabTextColor write SetActiveTabTextColor default clDefault;
     property    Align;
     property    BackgroundColor;
     property    Enabled;
@@ -257,6 +265,7 @@ begin
   FTabVisible:= True;
   FFocusable := True;
   FBackgroundColor := Parent.BackgroundColor;
+  FTabColor  := Parent.BackgroundColor;
   FTextColor := Parent.TextColor;
   FIsContainer := True;
 end;
@@ -656,10 +665,22 @@ begin
 end;
 
 { Mode = 1 means the background tabs. Mode = 2 means the Active Tab }
-function TfpgPageControl.DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
+function TfpgPageControl.DrawTab(const ATabSheet: TfpgTabSheet; const rect: TfpgRect; const Selected: Boolean = False;
+  const Mode: Integer = 1): TfpgRect;
 var
   r: TfpgRect;
+
+  procedure ApplyCorrectTabColorToCanvas;
+  begin
+    if ActiveTabColor = clDefault then
+      Canvas.SetColor(ATabSheet.TabColor)
+    else
+      Canvas.SetColor(ActiveTabColor);
+  end;
+
 begin
+  if not Assigned(ATabSheet) then
+    raise Exception.Create('DrawTab parameter error. ATabSheet may not be nil.');
   r := rect;
   if Selected then
   begin
@@ -673,10 +694,10 @@ begin
     r.Height -= 1;
     if TabPosition = tpBottom then
       r.Top += 1;
-    Canvas.SetColor(ActiveTabColor);
+    ApplyCorrectTabColorToCanvas;
   end
   else
-    Canvas.SetColor(BackgroundColor);
+    Canvas.SetColor(ATabSheet.TabColor);
 
   case TabPosition of
     tpTop:
@@ -708,7 +729,7 @@ begin
         Canvas.DrawLine(r.Right, r.Bottom-2, r.Right, r.Top-1);       // right outer edge
         if Mode = 2 then  { selected tab }
         begin
-          Canvas.SetColor(ActiveTabColor);
+          ApplyCorrectTabColorToCanvas;
           Canvas.DrawLine(r.Left+1, r.Top-1, r.Right-1, r.Top-1);
         end;
       end;
@@ -788,6 +809,20 @@ begin
   end;
 end;
 
+function TfpgPageControl.GetActiveTabTextColor: TfpgColor;
+begin
+  Result := FActiveTabTextColor;
+end;
+
+procedure TfpgPageControl.SetActiveTabTextColor(AValue: TfpgColor);
+begin
+  if FActiveTabTextColor <> AValue then
+  begin
+    FActiveTabTextColor := AValue;
+    RePaint;
+  end;
+end;
+
 procedure TfpgPageControl.SetBackgroundColor(const AValue: TfpgColor);
 var
   lWasMatch: boolean;
@@ -816,6 +851,15 @@ var
   toffset: integer;
   lTxtFlags: TfpgTextFlags;
   ActivePageVisible: Boolean;
+
+  procedure ApplyCorrectTabTextColorToCanvas(ATab: TfpgTabSheet);
+  begin
+    if ActiveTabTextColor = clDefault then
+      Canvas.SetTextColor(ATab.TabTextColor)
+    else
+      Canvas.SetTextColor(ActiveTabTextColor);
+  end;
+
 begin
   if not HasHandle then
     Exit; //==>
@@ -823,10 +867,10 @@ begin
   if PageCount = 0 then
     Exit; //==>
 
-  TabW:=FixedTabWidth;
-  TabH:=FixedTabHeight;
+  TabW := FixedTabWidth;
+  TabH := FixedTabHeight;
   ActivePageVisible := false;
-  If TabH = 0 then
+  if TabH <= 1 then
     TabH := TAB_HEIGHT;
   h := TfpgTabSheet(FPages.First);
   if h = nil then
@@ -837,7 +881,6 @@ begin
   if not Enabled then
     Include(lTxtFlags, txtDisabled);
 
-
   if TabPosition in [tpTop, tpBottom] then
   begin
     if MaxButtonWidthSum > (Width-(FMargin*2)) then
@@ -936,12 +979,14 @@ begin
           end;
           // paint tab button
           r2.Width := ButtonWidth(h.Text);
-          r3 := DrawTab(r2, h = ActivePage);
+          r3 := DrawTab(h, r2, h = ActivePage);
           // paint text on non-active tabs
           if h <> ActivePage then
+          begin
+            Canvas.SetTextColor(h.TabTextColor);
             Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
                 Height-TabH+toffset, GetTabText(h.Text), lTxtFlags);
-
+          end;
           r2.Left := r2.Left + r2.Width;
           lp := lp + ButtonWidth(h.Text);
           if h <> TfpgTabSheet(FPages.Last) then
@@ -955,8 +1000,11 @@ begin
         r2.Width   := Width;
         r2.Height  := Height - TabH;
         Canvas.DrawButtonFace(r2, []);
+
         // Draw text of ActivePage, because we didn't before.
-        DrawTab(r3, false, 2);
+        h := self.ActivePage;
+        DrawTab(h, r3, false, 2);
+        ApplyCorrectTabTextColorToCanvas(h);
         Canvas.DrawText(r3.Left+4, r3.Top+5, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
       end;
 
@@ -980,11 +1028,14 @@ begin
           end;
           // paint tab button
           r2.Width := ButtonWidth(h.Text);
-          r3 := DrawTab(r2, h = ActivePage);
+          r3 := DrawTab(h, r2, h = ActivePage);
           // paint text on non-active tabs
           if h <> ActivePage then
+          begin
+            Canvas.SetTextColor(h.TabTextColor);
             Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
                 FMargin+toffset, GetTabText(h.Text), lTxtFlags);
+          end;
           r2.Left := r2.Left + r2.Width;
           lp := lp + ButtonWidth(h.Text);
           if h <> TfpgTabSheet(FPages.Last) then
@@ -1000,7 +1051,9 @@ begin
         Canvas.DrawButtonFace(r2, []);
 
         // Draw text of ActivePage, because we didn't before.
-        DrawTab(r3, false, 2);
+        h := self.ActivePage;
+        DrawTab(h, r3, false, 2);
+        ApplyCorrectTabTextColorToCanvas(h);
         Canvas.DrawText(r3.Left+4, r3.Top+3, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
       end;
 
@@ -1025,11 +1078,14 @@ begin
             h.SetPosition(FMargin+2, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2));
           end;
           // paint tab button
-          r3 := DrawTab(r2, h = ActivePage);
+          r3 := DrawTab(h, r2, h = ActivePage);
 
           // paint text on non-active tabs
           if h <> ActivePage then
+          begin
+            Canvas.SetTextColor(h.TabTextColor);
             Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+          end;
           r2.Top += r2.Height;
           lp := r2.Top;
           if h <> TfpgTabSheet(FPages.Last) then
@@ -1045,7 +1101,9 @@ begin
         Canvas.DrawButtonFace(r2, []);
 
         // Draw text of ActivePage, because we didn't before.
-        DrawTab(r3, false, 2);
+        h := self.ActivePage;
+        DrawTab(h, r3, false, 2);
+        ApplyCorrectTabTextColorToCanvas(h);
         Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
       end;
 
@@ -1070,11 +1128,14 @@ begin
             h.SetPosition(FMargin+2+TabW, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2));
           end;
           // paint tab button
-          r3 := DrawTab(r2, h = ActivePage);
+          r3 := DrawTab(h, r2, h = ActivePage);
 
           // paint text on non-active tabs
           if h <> ActivePage then
+          begin
+            Canvas.SetTextColor(h.TabTextColor);
             Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+          end;
           r2.Top += r2.Height;
           lp := r2.Top;
           if h <> TfpgTabSheet(FPages.Last) then
@@ -1090,7 +1151,9 @@ begin
         Canvas.DrawButtonFace(r2, []);
 
         // Draw text of ActivePage, because we didn't before.
-        DrawTab(r3, false, 2);
+        h := self.ActivePage;
+        DrawTab(h, r3, false, 2);
+        ApplyCorrectTabTextColorToCanvas(h);
         Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
       end;
   end; { case }
@@ -1223,7 +1286,8 @@ begin
 
   FTextColor        := Parent.TextColor;
   FBackgroundColor  := Parent.BackgroundColor;
-  FActiveTabColor   := FBackgroundColor;
+  FActiveTabColor   := clDefault;
+  FActiveTabTextColor := clDefault;
   FFocusable        := True;
   FOnChange         := nil;
   FFixedTabWidth    := 0;