GradTabConGradTabControl: Added Style-Support for the Left-/Right-Navigation Buttons

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@865 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/gradcontrols/examples/Forms/unit1.lfm

@@ -1,27 +1,27 @@
 object Form1: TForm1
-  Left = 253
+  Left = 275
-  Height = 492
+  Height = 493
-  Top = 145
+  Top = 161
   Width = 884
   Caption = 'TGradTabControl-Testsuite'
-  ClientHeight = 492
+  ClientHeight = 493
   ClientWidth = 884
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   LCLVersion = '0.9.27'
   object Panel1: TPanel
     Left = 0
-    Height = 492
+    Height = 493
     Top = 0
     Width = 646
     Align = alClient
     Caption = 'Panel1'
-    ClientHeight = 492
+    ClientHeight = 493
     ClientWidth = 646
     TabOrder = 0
     object GradTabControl1: TGradTabControl
       Left = 1
-      Height = 490
+      Height = 491
       Top = 1
       Width = 644
       Align = alClient
@@ -143,7 +143,7 @@ object Form1: TForm1
       end
       object GradTabPage1: TGradTabPage
         Left = 2
-        Height = 466
+        Height = 467
         Top = 22
         Width = 640
         PageIndex = 0
@@ -192,7 +192,7 @@ object Form1: TForm1
         TabButtonLayout = blGlyphLeft
         object Memo1: TMemo
           Left = 312
-          Height = 466
+          Height = 467
           Top = 0
           Width = 328
           Align = alRight
@@ -207,11 +207,11 @@ object Form1: TForm1
   end
   object Panel2: TPanel
     Left = 646
-    Height = 492
+    Height = 493
     Top = 0
     Width = 238
     Align = alRight
-    ClientHeight = 492
+    ClientHeight = 493
     ClientWidth = 238
     TabOrder = 1
     object Label1: TLabel

components/gradcontrols/examples/Forms/unit1.lrs

@@ -1,13 +1,13 @@
 { Das ist eine automatisch erzeugte Lazarus-Ressourcendatei }
 
 LazarusResources.Add('TForm1','FORMDATA',[
-  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#253#0#6'Height'#3#236#1#3'Top'#3#145#0#5
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#19#1#6'Height'#3#237#1#3'Top'#3#161#0#5'W'
-  +'Width'#3't'#3#7'Caption'#6#25'TGradTabControl-Testsuite'#12'ClientHeight'#3
+  +'idth'#3't'#3#7'Caption'#6#25'TGradTabControl-Testsuite'#12'ClientHeight'#3
-  +#236#1#11'ClientWidth'#3't'#3#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11
+  +#237#1#11'ClientWidth'#3't'#3#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11
   +'FormDestroy'#10'LCLVersion'#6#6'0.9.27'#0#6'TPanel'#6'Panel1'#4'Left'#2#0#6
-  +'Height'#3#236#1#3'Top'#2#0#5'Width'#3#134#2#5'Align'#7#8'alClient'#7'Captio'
+  +'Height'#3#237#1#3'Top'#2#0#5'Width'#3#134#2#5'Align'#7#8'alClient'#7'Captio'
-  +'n'#6#6'Panel1'#12'ClientHeight'#3#236#1#11'ClientWidth'#3#134#2#8'TabOrder'
+  +'n'#6#6'Panel1'#12'ClientHeight'#3#237#1#11'ClientWidth'#3#134#2#8'TabOrder'
-  +#2#0#0#15'TGradTabControl'#15'GradTabControl1'#4'Left'#2#1#6'Height'#3#234#1
+  +#2#0#0#15'TGradTabControl'#15'GradTabControl1'#4'Left'#2#1#6'Height'#3#235#1
   +#3'Top'#2#1#5'Width'#3#132#2#5'Align'#7#8'alClient'#10'ActivePage'#7#12'Grad'
   +'TabPage1'#20'OnTabButtonMouseDown'#7'!GradTabControl1TabButtonMouseDown'#18
   +'OnTabButtonMouseUp'#7#31'GradTabControl1TabButtonMouseUp'#20'OnTabButtonMou'
@@ -118,7 +118,7 @@ LazarusResources.Add('TForm1','FORMDATA',[
   +#10'q'#161#162'$:'#159#189#158'1'#159#193#188'.'#159#195#211'+'#158#196#234
   +'+'#159#195#236'-'#159#195#214'0'#159#195#191'7'#160#192#164'^'#161#173'1'#0
   +#0'#'#0#0#0'#'#0#12'TabShowGlyph'#9#15'TabButtonLayout'#7#11'blGlyphLeft'#0#0
-  +#12'TGradTabPage'#12'GradTabPage1'#4'Left'#2#2#6'Height'#3#210#1#3'Top'#2#22
+  +#12'TGradTabPage'#12'GradTabPage1'#4'Left'#2#2#6'Height'#3#211#1#3'Top'#2#22
   +#5'Width'#3#128#2#9'PageIndex'#2#0#7'Caption'#6#9'Some Memo'#15'ShowCloseBut'
   +'ton'#9#5'Color'#7#10'clGrayText'#8'TabColor'#7#7'clGreen'#16'TabTextAlignme'
   +'nt'#7#13'taLeftJustify'#13'TabGlyph.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0
@@ -168,10 +168,10 @@ LazarusResources.Add('TForm1','FORMDATA',[
   +#10'q'#161#162'$:'#159#189#158'1'#159#193#188'.'#159#195#211'+'#158#196#234
   +'+'#159#195#236'-'#159#195#214'0'#159#195#191'7'#160#192#164'^'#161#173'1'#0
   +#0'#'#0#0#0'#'#0#12'TabShowGlyph'#9#15'TabButtonLayout'#7#11'blGlyphLeft'#0#5
-  +'TMemo'#5'Memo1'#4'Left'#3'8'#1#6'Height'#3#210#1#3'Top'#2#0#5'Width'#3'H'#1
+  +'TMemo'#5'Memo1'#4'Left'#3'8'#1#6'Height'#3#211#1#3'Top'#2#0#5'Width'#3'H'#1
   +#5'Align'#7#7'alRight'#13'Lines.Strings'#1#6#9'Some Memo'#6#7'alRight'#0#8'T'
-  +'abOrder'#2#0#0#0#0#0#0#6'TPanel'#6'Panel2'#4'Left'#3#134#2#6'Height'#3#236#1
+  +'abOrder'#2#0#0#0#0#0#0#6'TPanel'#6'Panel2'#4'Left'#3#134#2#6'Height'#3#237#1
-  +#3'Top'#2#0#5'Width'#3#238#0#5'Align'#7#7'alRight'#12'ClientHeight'#3#236#1
+  +#3'Top'#2#0#5'Width'#3#238#0#5'Align'#7#7'alRight'#12'ClientHeight'#3#237#1
   +#11'ClientWidth'#3#238#0#8'TabOrder'#2#1#0#6'TLabel'#6'Label1'#4'Left'#2#16#6
   +'Height'#2#16#3'Top'#3#160#0#5'Width'#2'9'#7'Caption'#6#9'TabHeight'#11'Pare'
   +'ntColor'#8#0#0#9'TComboBox'#9'ComboBox1'#4'Left'#2#16#6'Height'#2#23#3'Top'

components/gradcontrols/examples/gradcontroltest.lpi

@@ -16,7 +16,7 @@
     <VersionInfo>
       <UseVersionInfo Value="True"/>
       <AutoIncrementBuild Value="True"/>
-      <CurrentBuildNr Value="1135"/>
+      <CurrentBuildNr Value="1161"/>
       <ProjectVersion Value="0.0.0.0"/>
     </VersionInfo>
     <PublishOptions>
@@ -31,21 +31,24 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="4">
+    <RequiredPackages Count="5">
       <Item1>
-        <PackageName Value="FCL"/>
+        <PackageName Value="gradtabcontrol_with_multilog"/>
-        <MinVersion Major="1" Valid="True"/>
       </Item1>
       <Item2>
-        <PackageName Value="gradtabcontrol"/>
+        <PackageName Value="multiloglaz"/>
       </Item2>
       <Item3>
-        <PackageName Value="gradbutton"/>
+        <PackageName Value="FCL"/>
-        <MinVersion Major="1" Minor="2" Valid="True"/>
+        <MinVersion Major="1" Valid="True"/>
       </Item3>
       <Item4>
-        <PackageName Value="LCL"/>
+        <PackageName Value="gradbutton"/>
+        <MinVersion Major="1" Minor="2" Valid="True"/>
       </Item4>
+      <Item5>
+        <PackageName Value="LCL"/>
+      </Item5>
     </RequiredPackages>
     <Units Count="3">
       <Unit0>

components/gradcontrols/examples/gradcontroltest.lpr

@@ -7,8 +7,8 @@ uses
   cthreads,
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms
+  Forms, multiloglaz
-  { you can add units after this }, unit1;
+  { you can add units after this }, unit1, gradtabcontrol_with_multilog;
 
 {$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
 

components/gradcontrols/src/gradbuttonstyle.pas

@@ -0,0 +1,16 @@
+unit gradbuttonstyle; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+
+implementation
+
+uses
+  ugradbtn;
+
+end.
+

components/gradcontrols/src/gradtabstyle.pas

@@ -40,6 +40,7 @@ type
     procedure TabButtonBorder(Sender: TCustomControl; AIndex: Integer;
       Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
     procedure TabLeftRightButton(Sender: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
+    procedure TabLeftRightBorderButton(Sender: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
     procedure PrepareButton(Button: TGradButton); virtual;
     property TheTabControl : TCustomControl read FTheTabControl write FTheTabControl;
     property HasTabButtonPaint : Boolean read GetHasTabButtonPaint;
@@ -82,6 +83,10 @@ type
       Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState: TButtonState); override;
     procedure TabButtonBorder(Sender: TCustomControl; AIndex: Integer;
       Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); override;
+    procedure TabLeftRightButton(Sender: TGradButton; TargetCanvas: TCanvas;
+      R: TRect; BState: TButtonState); override;
+    procedure TabLeftRightBorderButton(Sender: TGradButton; TargetCanvas: TCanvas;
+      R: TRect; BState: TButtonState); override;
     procedure PrepareButton(Button: TGradButton); override;
   end;
 
@@ -146,7 +151,7 @@ constructor TGradTabVistaStyle.Create;
 begin
   inherited Create;
 
-  FOptions:=[sbTabButton, sbBorderButton, sbCloseButton];
+  FOptions:=[sbTabButton, sbBorderButton, sbCloseButton, sbLeftRightButton];
 
   with Normal do
   begin
@@ -203,8 +208,13 @@ var
   FGradTabControl : TGradTabControl;
   FGradientDirection : TGradientDirection;
 begin
-  FGradTabControl := Sender as TGradTabControl;
+  FGradTabControl := nil;
-  if AIndex = FGradTabControl.PageIndex then
+
+  if Sender <> nil then
+    FGradTabControl := Sender as TGradTabControl;
+
+  if (FGradTabControl <> nil)
+  and (AIndex = FGradTabControl.PageIndex) then
     BState := bsDown;
 
   case BState of
@@ -313,6 +323,24 @@ begin
   end;
 end;
 
+procedure TGradTabVistaStyle.TabLeftRightButton(Sender: TGradButton;
+  TargetCanvas: TCanvas; R: TRect; BState: TButtonState);
+begin
+  if BState = bsDown then
+     BState := bsHot;
+
+  TabButton(Sender.Owner as TCustomControl, 0, Sender, TargetCanvas, R, BState);
+end;
+
+procedure TGradTabVistaStyle.TabLeftRightBorderButton(Sender: TGradButton;
+  TargetCanvas: TCanvas; R: TRect; BState: TButtonState);
+begin
+  if BState = bsDown then
+     BState := bsHot;
+
+  TabButtonBorder(Sender.Owner as TCustomControl, 0, Sender, TargetCanvas, R, BState);
+end;
+
 procedure TGradTabVistaStyle.PrepareButton(Button: TGradButton);
 begin
   Button.Font.Color:=clBlack;

components/gradcontrols/src/ugradtabcontrol.pas

@@ -3,7 +3,7 @@ unit ugradtabcontrol;
 {-------------------------------------------------------------------------------
  @name GradTabControl
  @author Eugen Bolz
- @lastchange 07.10.2008
+ @lastchange 26.06.2009 (DD.MM.YYYY)
  @version 0.1
  @comments TGradTabControl is based on TNotebook/TPageControl/TTabControl
  @license http://creativecommons.org/licenses/LGPL/2.1/
@@ -11,14 +11,15 @@ unit ugradtabcontrol;
 
 {$mode objfpc}{$H+}
 
-{.$DEFINE DEBUGTAB}
-
 interface
 
 uses
   Classes,LResources, SysUtils, Menus, LCLType,
   LCLProc, LCLIntf,ExtCtrls, Graphics, ugradbtn, Controls, uRotateBitmap,
-  Buttons, Forms, ImgList, gradtabstyle;
+  Buttons, Forms, ImgList, gradtabstyle
+  {$IFDEF DEBUGTAB}
+  , sharedloggerlcl
+  {$ENDIF};
 
 type
   TGradTabControl = class;
@@ -1231,7 +1232,6 @@ begin
   with AButton do
   begin
     Left                   := -123;
-    Parent                 := Self;
     ShowFocusBorder        := false;
     TextAlignment          := taCenter;
     BorderSides            := [bsTopLine,bsRightLine,bsLeftLine];
@@ -1272,12 +1272,12 @@ begin
   if Assigned(PopupMenu) then
     AButton.PopupMenu := PopupMenu;
 
-  if (Index >= 1) AND (FPageList.Count>=1) then
+  {if (Index >= 1) AND (FPageList.Count>=1) then
     UnFocusButton(Index-1);
 
   FocusButton(Index);
 
-  OrderButtons;
+  OrderButtons;}
 
   {$IFDEF DEBUGTAB}WriteLn('TGradTabPagesBar.InsertButton');{$ENDIF}
 end;
@@ -1414,6 +1414,7 @@ begin
 
   FActiveIndex:=FTabControl.PageIndex;
 
+
   for i := 0 to FPageList.Count - 1 do
   begin
     B := TGradTabPage(FPageList.Items[i]).TabButton;
@@ -1517,6 +1518,9 @@ begin
          DebugLn('End I: %d W: %d H: %d L: %d T: %d, BW: %d, BH: %d',[i,B.Width,B.Height,B.Left,B.Top,BarWidth,BarHeight]);
       {$ENDIF}
     end;
+
+    if B.Parent <> Self then
+      B.Parent := Self;
   end;
 
   {$IFDEF DEBUGTAB}
@@ -1701,31 +1705,31 @@ end;
 
 function TGradTabPagesBar.GetViewedTabs: TTabs;
 var
-   i,l : Integer;
+  i,l : Integer;
 begin
-   {$IFDEF DEBUGTAB}
+  {$IFDEF DEBUGTAB}
-   DebugLn('GetViewedTabs');
+    DebugLn('GetViewedTabs');
-   DebugLn('Width=%d Height=%d',[Width,Height]);
+    DebugLn('Width=%d Height=%d',[Width,Height]);
-   {$ENDIF}
+  {$ENDIF}
-   for i := 0 to FPageList.Count-1 do
+  for i := 0 to FPageList.Count-1 do
-   begin
+  begin
-      with TGradTabPage(FPageList.Items[i]).TabButton do
+    with TGradTabPage(FPageList.Items[i]).TabButton do
+    begin
+      if ((TabPosition in [tpTop, tpBottom]) AND (Left >= 0) {AND (Left <=(Self.Width-10))} AND (Left+Width < Self.Width)) OR
+        ((TabPosition in [tpLeft, tpRight]) AND (Top >= 0) {AND (Top <=(Self.Height-10))} AND (Top+Height < Self.Height)) then
       begin
-        if ((TabPosition in [tpTop, tpBottom]) AND (Left >= 0) {AND (Left <=(Self.Width-10))} AND (Left+Width < Self.Width)) OR
+        l := IncAr(Result);
-           ((TabPosition in [tpLeft, tpRight]) AND (Top >= 0) {AND (Top <=(Self.Height-10))} AND (Top+Height < Self.Height)) then
+        {$IFDEF DEBUGTAB}
-        begin
+          DebugLn('L=%d T=%d W=%d H=%d Caption=%s',[Left, Top, Width, Height, Caption]);
-           l := IncAr(Result);
+          DebugLn('%d. Value: %d',[l,i]);
-           {$IFDEF DEBUGTAB}
+        {$ENDIF}
-           DebugLn('L=%d T=%d W=%d H=%d Caption=%s',[Left, Top, Width, Height, Caption]);
+        Result[l] := i;
-           DebugLn('%d. Value: %d',[l,i]);
-           {$ENDIF}
-           Result[l] := i;
-        end;
       end;
-   end;
+    end;
-   {$IFDEF DEBUGTAB}
+  end;
-      DebugLn('GetViewedTabs End');
+  {$IFDEF DEBUGTAB}
-   {$ENDIF}
+    DebugLn('GetViewedTabs End');
+  {$ENDIF}
 end;
 
 function TGradTabPagesBar.GetViewableTabs(FromIndex: Integer): TTabs;
@@ -1876,6 +1880,8 @@ begin
       end;
     end;
   end;
+
+
 end;
 
 {-------------------------------------------------------------------------------
@@ -2323,6 +2329,23 @@ begin
   // Update all Tab Paintings
   InvPaint;
   PagesBar.NewStyle;
+
+  if FStyle.HasLeftRightButtonPaint then
+  begin
+    FLeftButton.OnNormalBackgroundPaint  := @FStyle.TabLeftRightButton;
+    FLeftButton.OnDownBackgroundPaint    := @FStyle.TabLeftRightButton;
+    FLeftButton.OnHotBackgroundPaint     := @FStyle.TabLeftRightButton;
+    FLeftButton.OnBorderBackgroundPaint  := @FStyle.TabLeftRightBorderButton;
+
+    FLeftButton.OwnerBackgroundDraw      := true;
+
+    FRightButton.OnNormalBackgroundPaint := @FStyle.TabLeftRightButton;
+    FRightButton.OnDownBackgroundPaint   := @FStyle.TabLeftRightButton;
+    FRightButton.OnHotBackgroundPaint    := @FStyle.TabLeftRightButton;
+    FRightButton.OnBorderBackgroundPaint := @FStyle.TabLeftRightBorderButton;
+
+    FRightButton.OwnerBackgroundDraw     := true;
+  end;
   PagesBar.UpdateAllButtons;
 end;
 
@@ -2704,7 +2727,6 @@ begin
    if FPageIndex <> -1 then UnShowPage(FPageIndex);
 
    ShowPage(Value);
-   FPagesBar.FocusButton(Value);
 
    FPageIndex := Value;
 
@@ -2750,14 +2772,13 @@ begin
 
     if (Index<0) or (Index>=fPageList.Count) then Exit;
 
-    // Focus the TabButton
+    // Unfocus the TabButton
     FPagesBar.UnFocusButton(Index);
 
     UpdateDesignerFlags(Index);
 
      with TGradTabPage(FPageList.Items[Index]) do
        Visible:=false;
-
 end;
 
 {------------------------------------------------------------------------------
@@ -2806,10 +2827,11 @@ begin
     Exclude(APage.FFlags,pfInserting);
     APage.Parent := Self;
 
-    FPagesBar.InsertButton(APage.TabButton, Index);
     if APage.Caption = '' then
        APage.Caption:=APage.Name;
 
+    FPagesBar.InsertButton(APage.TabButton, Index);
+
     if NewZPosition>=0 then
       SetControlIndex(APage,NewZPosition);
     if PageIndex = -1 then