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
2009-06-26 18:43:15 +00:00
parent 2ac2f77e12
commit 8ce72fb2cd
7 changed files with 136 additions and 67 deletions
--- a/components/gradcontrols/examples/Forms/unit1.lfm
+++ b/components/gradcontrols/examples/Forms/unit1.lfm
@ -1,27 +1,27 @@
 object Form1: TForm1
-  Left = 253
-  Height = 492
-  Top = 145
+  Left = 275
+  Height = 493
+  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
--- a/components/gradcontrols/examples/Forms/unit1.lrs
+++ b/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
-  +'Width'#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
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#19#1#6'Height'#3#237#1#3'Top'#3#161#0#5'W'
+  +'idth'#3't'#3#7'Caption'#6#25'TGradTabControl-Testsuite'#12'ClientHeight'#3
+  +#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'
-  +'n'#6#6'Panel1'#12'ClientHeight'#3#236#1#11'ClientWidth'#3#134#2#8'TabOrder'
-  +#2#0#0#15'TGradTabControl'#15'GradTabControl1'#4'Left'#2#1#6'Height'#3#234#1
+  +'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#237#1#11'ClientWidth'#3#134#2#8'TabOrder'
+  +#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
-  +#3'Top'#2#0#5'Width'#3#238#0#5'Align'#7#7'alRight'#12'ClientHeight'#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#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'
--- a/components/gradcontrols/examples/gradcontroltest.lpi
+++ b/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"/>
-        <MinVersion Major="1" Valid="True"/>
+        <PackageName Value="gradtabcontrol_with_multilog"/>
      </Item1>
      <Item2>
-        <PackageName Value="gradtabcontrol"/>
+        <PackageName Value="multiloglaz"/>
      </Item2>
      <Item3>
-        <PackageName Value="gradbutton"/>
-        <MinVersion Major="1" Minor="2" Valid="True"/>
+        <PackageName Value="FCL"/>
+        <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>
--- a/components/gradcontrols/examples/gradcontroltest.lpr
+++ b/components/gradcontrols/examples/gradcontroltest.lpr
@ -7,8 +7,8 @@ uses
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
-  Forms
-  { you can add units after this }, unit1;
+  Forms, multiloglaz
+  { you can add units after this }, unit1, gradtabcontrol_with_multilog;

 {$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}

--- a/components/gradcontrols/src/gradbuttonstyle.pas
+++ b/components/gradcontrols/src/gradbuttonstyle.pas
@ -0,0 +1,16 @@
+unit gradbuttonstyle; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+
+implementation
+
+uses
+  ugradbtn;
+
+end.
+
--- a/components/gradcontrols/src/gradtabstyle.pas
+++ b/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;
-  if AIndex = FGradTabControl.PageIndex then
+  FGradTabControl := nil;
+
+  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;
--- a/components/gradcontrols/src/ugradtabcontrol.pas
+++ b/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}
-   DebugLn('GetViewedTabs');
-   DebugLn('Width=%d Height=%d',[Width,Height]);
-   {$ENDIF}
-   for i := 0 to FPageList.Count-1 do
-   begin
-      with TGradTabPage(FPageList.Items[i]).TabButton do
+  {$IFDEF DEBUGTAB}
+    DebugLn('GetViewedTabs');
+    DebugLn('Width=%d Height=%d',[Width,Height]);
+  {$ENDIF}
+  for i := 0 to FPageList.Count-1 do
+  begin
+    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
-           ((TabPosition in [tpLeft, tpRight]) AND (Top >= 0) {AND (Top <=(Self.Height-10))} AND (Top+Height < Self.Height)) then
-        begin
-           l := IncAr(Result);
-           {$IFDEF DEBUGTAB}
-           DebugLn('L=%d T=%d W=%d H=%d Caption=%s',[Left, Top, Width, Height, Caption]);
-           DebugLn('%d. Value: %d',[l,i]);
-           {$ENDIF}
-           Result[l] := i;
-        end;
+        l := IncAr(Result);
+        {$IFDEF DEBUGTAB}
+          DebugLn('L=%d T=%d W=%d H=%d Caption=%s',[Left, Top, Width, Height, Caption]);
+          DebugLn('%d. Value: %d',[l,i]);
+        {$ENDIF}
+        Result[l] := i;
      end;
-   end;
-   {$IFDEF DEBUGTAB}
-      DebugLn('GetViewedTabs End');
-   {$ENDIF}
+    end;
+  end;
+  {$IFDEF DEBUGTAB}
+    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