Merge branch 'fixes_1.4'HEADmaster

1 files changed, 102 insertions, 48 deletions

diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas
index 8846a7e1..5f0e7fbf 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;
@@ -183,11 +191,6 @@ implementation
 uses
   fpg_stringutils;
 
-const
-  DFL_TAB_HEIGHT = 21;
-  DFL_TAB_WIDTH = 0;
-  
-  
 // compare function used by FPages.Sort
 
 function SortCompare(Item1, Item2: Pointer): integer;
@@ -262,6 +265,7 @@ begin
   FTabVisible:= True;
   FFocusable := True;
   FBackgroundColor := Parent.BackgroundColor;
+  FTabColor  := Parent.BackgroundColor;
   FTextColor := Parent.TextColor;
   FIsContainer := True;
 end;
@@ -409,7 +413,6 @@ var
   wd: integer;  { width delta }
   h: integer;
   hd: integer;  { height delta }
-  msg: TfpgMessageParams;
 begin
   // PageControl has bevelled edges in some themes
   r := fpgStyle.GetControlFrameBorders;
@@ -662,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
@@ -679,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:
@@ -714,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;
@@ -794,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;
@@ -820,10 +849,17 @@ var
   h: TfpgTabSheet;
   lp: integer;
   toffset: integer;
-  TextLeft, TextTop: Integer;
-  dx: 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; //==>
@@ -831,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
@@ -845,7 +881,6 @@ begin
   if not Enabled then
     Include(lTxtFlags, txtDisabled);
 
-
   if TabPosition in [tpTop, tpBottom] then
   begin
     if MaxButtonWidthSum > (Width-(FMargin*2)) then
@@ -944,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
@@ -963,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;
 
@@ -988,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
@@ -1008,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;
 
@@ -1033,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
@@ -1053,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;
 
@@ -1078,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
@@ -1098,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 }
@@ -1188,26 +1243,24 @@ var
   i: integer;
 begin
   i := ActivePageIndex;
-  if ssAlt in shiftstate then
-  case keycode of
-    keyLeft:
-        begin
-          if ActivePage <> TfpgTabSheet(FPages.First) then
-          begin
-            ActivePage := TfpgTabSheet(FPages[i-1]);
-            consumed := True;
-          end;
-        end;
 
-    keyRight:
-        begin
-          if ActivePage <> TfpgTabSheet(FPages.Last) then
-          begin
-            ActivePage := TfpgTabSheet(FPages[i+1]);
-            consumed := True;
-          end;
-        end;
-  end;  { case/else }
+  if (shiftstate = [ssCtrl]) and (keycode = keyTab) then
+  begin
+    consumed := True;
+    if ActivePage <> TfpgTabSheet(FPages.Last) then
+      ActivePage := TfpgTabSheet(FPages[i+1])
+    else
+      ActivePage := TfpgTabSheet(FPages.First); // loop back to the front
+  end
+  else if (shiftstate = [ssCtrl, ssShift]) and (keycode = keyTab) then
+  begin
+    consumed := True;
+    if ActivePage <> TfpgTabSheet(FPages.First) then
+      ActivePage := TfpgTabSheet(FPages[i-1])
+    else
+      ActivePage := TfpgTabSheet(FPages.Last);  // loop back to the end
+  end;
+
   if not consumed then
     inherited HandleKeyPress(keycode, shiftstate, consumed);
 end;
@@ -1231,7 +1284,8 @@ begin
 
   FTextColor        := Parent.TextColor;
   FBackgroundColor  := Parent.BackgroundColor;
-  FActiveTabColor   := FBackgroundColor;
+  FActiveTabColor   := clDefault;
+  FActiveTabTextColor := clDefault;
   FFocusable        := True;
   FOnChange         := nil;
   FFixedTabWidth    := 0;