Now ImageLists are working with TGradTabControl correctly

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

components/gradcontrols/src/ugradtabcontrol.pas

@@ -26,7 +26,7 @@ interface
 uses
   Classes,LResources, SysUtils, Menus, LCLType,
   LCLProc, ExtCtrls, Graphics, ugradbtn, Controls, uRotateBitmap,
-  Buttons;
+  Buttons, Forms, ImgList;
 
 type
   TGradTabControl = class;
@@ -75,78 +75,102 @@ type
   X, Y, AIndex: Integer) of object;
 
   //Properties of the Tab should be accessable from here
-  TGradTabPage = class(TCustomControl)
+   TGradTabPage = class(TCustomControl)
+   private
+      FActiveTabColor: TColor;
+      FButton : TGradTabPageButton;
+      FCaption: TCaption;
+      FGradTabControl : TGradTabControl; //Maybe needed ^.^
+      FFlags: TPageFlags;
+      FImageIndex: Integer;
+      FNormalTabColor: TColor;
+      FOwnerTabColor: Boolean;
+      FTabVisible,FCurrentlyDestroying,FShowCloseButton : Boolean;
+      function GetTabButtonLayout: TButtonLayout;
+      function GetTabColor: TColor;
+      function GetTabGlyph: TBitmap;
+      function GetTabShowGlyph: Boolean;
+      function GetTabTextAlignment: TTextAlignment;
+      function GetTabPopupMenu : TPopupMenu;
+      function GetText : TCaption;
+      procedure SetImageIndex(const AValue: Integer);
+      procedure SetTabButtonLayout(const AValue: TButtonLayout);
+      procedure SetTabColor(const AValue: TColor);
+      procedure SetTabGlyph(const AValue: TBitmap);
+      procedure SetTabPopupMenu(Value : TPopupMenu);
+      procedure SetTabShowGlyph(const AValue: Boolean);
+      procedure SetTabTextAlignment(const AValue: TTextAlignment);
+      procedure SetText(const Value: TCaption);
+      procedure SetEnabled(Value: Boolean); override;
+   protected
+      function GetPageIndex: integer;
+      procedure SetPageIndex(AValue: Integer);
+      procedure SetButton(Value : TGradTabPageButton); //Later dont needed
+      procedure SetParent(NewParent: TWinControl); override;
+      procedure SetShowCloseButton(Value: Boolean);
+      procedure SetTabVisible(Value: Boolean);
+   public
+      constructor Create(AOwner: TComponent); override;
+      destructor Destroy; override;
+      procedure DestroyHandle; override;
+      procedure Paint; override;
+      property TabButton : TGradTabPageButton read FButton;
+      function VisibleIndex: integer;
+      procedure UpdateImage;
+   published
+      //property ControlState;
+      //property ControlStyle;
+      property TabVisible : Boolean read FTabVisible write SetTabVisible default true;
+      property PageIndex : Integer read GetPageIndex write SetPageIndex;
+      property Caption : TCaption read GetText write SetText;
+      property ShowCloseButton : Boolean read FShowCloseButton write SetShowCloseButton default false;
+      property TabPopupMenu : TPopupMenu read GetTabPopupMenu write SetTabPopupMenu;
+      property Color;
+      property TabColor : TColor read GetTabColor write SetTabColor;
+      property TabTextAlignment : TTextAlignment read GetTabTextAlignment write SetTabTextAlignment default taCenter;
+      property TabGlyph : TBitmap read GetTabGlyph write SetTabGlyph;
+      property TabShowGlyph : Boolean read GetTabShowGlyph write SetTabShowGlyph;
+      property TabButtonLayout : TButtonLayout read GetTabButtonLayout write SetTabButtonLayout;
+      property ImageIndex : Integer read FImageIndex write SetImageIndex default 0;
+      property Enabled;
+      property PopupMenu;
+      property OnStartDock;
+      property OnStartDrag;
+      property OnDockDrop;
+      property OnDockOver;
+      property OnDragDrop;
+      property OnDragOver;
+      property OnEndDock;
+      property OnEndDrag;
+      property OnMouseDown;
+      property OnMouseUp;
+      property OnMouseMove;
+      property OnMouseWheel;
+      property OnMouseWheelUp;
+      property OnMouseWheelDown;
+      property ActiveTabColor : TColor read FActiveTabColor write FActiveTabColor default clGreen;
+      property NormalTabColor : TColor read FNormalTabColor write FNormalTabColor default clBlue;
+      property OwnerTabColor : Boolean read FOwnerTabColor write FOwnerTabColor default false;
+   end;
+  
+  { TFormPage }
+
+  TFormPage = class(TGradTabPage)
   private
-       FButton : TGradTabPageButton;
+       FDestroyPageAtDestroy: Boolean;
-       FCaption: TCaption;
+       FOldForm : TCustomForm;
-       FGradTabControl : TGradTabControl; //Maybe needed ^.^
+       FShowPageAtDestroy: Boolean;
-       FFlags: TPageFlags;
-       FImageIndex: Integer;
-       FTabVisible,FCurrentlyDestroying,FShowCloseButton : Boolean;
-       function GetTabButtonLayout: TButtonLayout;
-       function GetTabColor: TColor;
-       function GetTabGlyph: TBitmap;
-       function GetTabShowGlyph: Boolean;
-       function GetTabTextAlignment: TTextAlignment;
-       function GetTabPopupMenu : TPopupMenu;
-       function GetText : TCaption;
-       procedure SetImageIndex(const AValue: Integer);
-       procedure SetTabButtonLayout(const AValue: TButtonLayout);
-       procedure SetTabColor(const AValue: TColor);
-       procedure SetTabGlyph(const AValue: TBitmap);
-       procedure SetTabPopupMenu(Value : TPopupMenu);
-       procedure SetTabShowGlyph(const AValue: Boolean);
-       procedure SetTabTextAlignment(const AValue: TTextAlignment);
-       procedure SetText(const Value: TCaption);
-       procedure SetEnabled(Value: Boolean); override;
-  protected
-       function GetPageIndex: integer;
-       procedure SetPageIndex(AValue: Integer);
-       procedure SetButton(Value : TGradTabPageButton); //Later dont needed
-       procedure SetParent(NewParent: TWinControl); override;
-       procedure SetShowCloseButton(Value: Boolean);
-       procedure SetTabVisible(Value: Boolean);
   public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
-       procedure DestroyHandle; override;
+       procedure FormToPage(TheForm : TCustomForm);
-       procedure Paint; override;
+       procedure PageToForm(AShow : Boolean);
-       property TabButton : TGradTabPageButton read FButton;
-       function VisibleIndex: integer;
-       procedure UpdateImage;
   published
-       //property ControlState;
+       property TheForm : TCustomForm read FOldForm;
-       //property ControlStyle;
+       property ShowPageAtDestroy : Boolean read FShowPageAtDestroy write FShowPageAtDestroy default false;
-       property TabVisible : Boolean read FTabVisible write SetTabVisible default true;
+       property DestroyPageAtDestroy : Boolean read FDestroyPageAtDestroy write FDestroyPageAtDestroy default false;
-       property PageIndex : Integer read GetPageIndex write SetPageIndex;
-       property Caption : TCaption read GetText write SetText;
-       property ShowCloseButton : Boolean read FShowCloseButton write SetShowCloseButton default false;
-       property TabPopupMenu : TPopupMenu read GetTabPopupMenu write SetTabPopupMenu;
-       property Color;
-       property TabColor : TColor read GetTabColor write SetTabColor;
-       property TabTextAlignment : TTextAlignment read GetTabTextAlignment write SetTabTextAlignment default taCenter;
-       property TabGlyph : TBitmap read GetTabGlyph write SetTabGlyph;
-       property TabShowGlyph : Boolean read GetTabShowGlyph write SetTabShowGlyph;
-       property TabButtonLayout : TButtonLayout read GetTabButtonLayout write SetTabButtonLayout;
-       property ImageIndex : Integer read FImageIndex write SetImageIndex default 0;
-       property Enabled;
-       property PopupMenu;
-       property OnStartDock;
-       property OnStartDrag;
-       property OnDockDrop;
-       property OnDockOver;
-       property OnDragDrop;
-       property OnDragOver;
-       property OnEndDock;
-       property OnEndDrag;
-       property OnMouseDown;
-       property OnMouseUp;
-       property OnMouseMove;
-       property OnMouseWheel;
-       property OnMouseWheelUp;
-       property OnMouseWheelDown;
   end;
-  
+
   { TGradTabPagesBar }
 
   TTabs = Array of Integer;
@@ -157,6 +181,8 @@ type
   }
   TGradTabPagesBar = class(TCustomControl)
   private
+      FActiveTabColor: TColor;
+      FNormalTabColor: TColor;
       FPageList : TListWithEvent;
       FTabControl : TGradTabControl;
       FShowFromButton, FMovedTo : Integer;
@@ -200,6 +226,8 @@ type
       property OnMouseWheel;
       property OnMouseWheelUp;
       property OnMouseWheelDown;
+      property ActiveTabColor : TColor read FActiveTabColor write FActiveTabColor default clGreen;
+      property NormalTabColor : TColor read FNormalTabColor write FNormalTabColor default clBlue;
       //destructor Destroy; override;
   end;
   
@@ -260,6 +288,7 @@ type
         FPageIndex, fPageIndexOnLastChange, fPageIndexOnLastShow,
         FTabHeight, FLongWidth : Integer;
         FBar : TGradTabBar;
+        FImageChangeLink : TChangeLink;
         FPagesBar: TGradTabPagesBar;
         FPagesPopup : TPopupMenu;
         FTabPosition : TTabPosition;
@@ -267,7 +296,11 @@ type
         procedure AssignEvents(TheControl : TCustomControl);
         procedure AlignPage(APage : TGradTabPage; ARect : TRect);
         procedure AlignPages;
+        function GetActiveTabColor: TColor;
+        function GetNormalTabColor: TColor;
         procedure ImageListChange(Sender: TObject);
+        procedure SetActiveTabColor(const AValue: TColor);
+        procedure SetNormalTabColor(const AValue: TColor);
         procedure UpdateTabImages;
         //procedure AddRemovePageHandle(APage: TGradTabPage);
         //procedure DoSendPageIndex;
@@ -377,7 +410,7 @@ type
         property OnMouseWheelUp;
         property OnMouseWheelDown;
         //On*- PagesBar Events
-        property OnPagesBarDragOver : TDragOverEvent read GetPagesBarDragOver write SetPagesBarDragOver;
+        //property OnPagesBarDragOver : TDragOverEvent read GetPagesBarDragOver write SetPagesBarDragOver;
         //End
 
         property PageIndex : Integer read FPageIndex write SetCurrentPageNum;
@@ -391,7 +424,8 @@ type
         property ShowLeftTopScrollButton : Boolean read FShowLeftTopScrollButton write SetShowLeftTopScrollButton;
         property ShowRightBottomScrollButton : Boolean read FShowRightBottomScrollButton write SetShowRightBottomScrollButton;
         property Images : TImageList read FImages write SetImages;
-
+        property NormalTabColor: TColor read GetNormalTabColor write SetNormalTabColor default clBlue;
+        property ActiveTabColor: TColor read GetActiveTabColor write SetActiveTabColor default clGreen;
         //property ShowTabs : Boolean; { TODO }
   end;
   
@@ -399,6 +433,7 @@ type
   function IsAssigned(var Obj : TObject) : String;
   function BoolStr(BV : Boolean) : String;
   function IncAr(var Ar : TTabs) : Integer;
+  function Form2Page(theTabControl : TGradTabControl; theForm : TCustomForm) : TFormPage;
 
 implementation
 
@@ -451,6 +486,15 @@ begin
    Result := Length(Ar)-1;
 end;
 
+function Form2Page(theTabControl: TGradTabControl; theForm: TCustomForm
+  ): TFormPage;
+begin
+   Result := TFormPage.Create(theTabControl);
+   Result.FormToPage(theForm);
+   Result.ShowPageAtDestroy:=false;
+   Result.Parent := theTabControl;
+end;
+
 {-------------------------------------------------------------------------------
   TGradTabPageButton Create(AOwner: TComponent
  ------------------------------------------------------------------------------}
@@ -667,6 +711,10 @@ begin
      FTabVisible:=true;
      FShowCloseButton:=false;
      FImageIndex:=0;
+
+     FActiveTabColor:=clGreen;
+     FNormalTabColor:=clBlue;
+     FOwnerTabColor:=false;
 end;
 
 {-------------------------------------------------------------------------------
@@ -885,10 +933,11 @@ end;
 
 procedure TGradTabPage.SetImageIndex(const AValue: Integer);
 begin
+  if FGradTabControl=nil then Exit;
   if FImageIndex=AValue then exit;
   FImageIndex:=AValue;
 
-  if FGradTabControl.Images <> nil then
+  if (FGradTabControl.Images <> nil) AND (FImageIndex<>-1) then
   begin
       UpdateImage;
   end;
@@ -991,8 +1040,10 @@ begin
 
   FButton.Glyph.Clear;
 
-  if Assigned(FGradTabControl.Images) AND (FGradTabControl.Images.Count<>0) then begin
+  if Assigned(FGradTabControl.Images) AND (FGradTabControl.Images.Count<>0)
+  AND (ImageIndex < FGradTabControl.Images.Count) AND (ImageIndex<>-1) then begin
      FGradTabControl.Images.GetBitmap(ImageIndex,FButton.Glyph);
+     FButton.ShowGlyph:=true;
   end;
 end;
 
@@ -1016,6 +1067,9 @@ begin
      FTabControl.FLeftButton.Visible:=false;
      FTabControl.FRightButton.Visible:=false;
 
+     FActiveTabColor:=clGreen;
+     FNormalTabColor:=clBlue;
+
      {Enabled:=false;
      NotEnabledColor:=Color;
      BorderSides:=[];
@@ -1454,7 +1508,10 @@ begin
            end;
        end;
 
-       Color := clBlue;
+       if TGradTabPage(FPageList.Items[Index]).OwnerTabColor then
+          Color := TGradTabPage(FPageList.Items[Index]).NormalTabColor
+       else
+          Color := NormalTabColor;
 
        UpdatePositions;
    end;
@@ -1497,7 +1554,12 @@ begin
                 DoNext := ((Top+Height)>= Self.Height);
            end;
         end;
-        Color := clGreen;
+
+        if TGradTabPage(FPageList.Items[Index]).OwnerTabColor then
+            Color := TGradTabPage(FPageList.Items[Index]).ActiveTabColor
+        else
+            Color := ActiveTabColor;
+
     end;
 
     DebugLn('FR=%s FL=%s',[BoolStr(FTabControl.FRightButton.Visible),BoolStr(FTabControl.FLeftButton.Visible)]);
@@ -1951,6 +2013,9 @@ constructor TGradTabControl.Create(AOwner: TComponent);
 begin
     inherited;
 
+    FImageChangeLink := TChangeLink.Create;
+    FImageChangeLink.OnChange:=@ImageListChange;
+
     FTabPosition:=tpTop;
     FAutoShowScrollButton:=true;
     fCompStyle := csNoteBook;
@@ -2070,6 +2135,8 @@ begin
     DebugLn('TGradTabControl.Destroy End');
     {$ENDIF}
 
+    FImageChangeLink.Destroy;
+
     inherited;
 end;
 
@@ -2127,11 +2194,31 @@ begin
    UpdateAllDesignerFlags;
 end;
 
+function TGradTabControl.GetActiveTabColor: TColor;
+begin
+   Result := FPagesBar.ActiveTabColor;
+end;
+
+function TGradTabControl.GetNormalTabColor: TColor;
+begin
+   Result := FPagesBar.NormalTabColor;
+end;
+
 procedure TGradTabControl.ImageListChange(Sender: TObject);
 begin
    UpdateTabImages;
 end;
 
+procedure TGradTabControl.SetActiveTabColor(const AValue: TColor);
+begin
+   FPagesBar.ActiveTabColor:= AValue;
+end;
+
+procedure TGradTabControl.SetNormalTabColor(const AValue: TColor);
+begin
+   FPagesBar.NormalTabColor:=AValue;
+end;
+
 procedure TGradTabControl.UpdateTabImages;
 var
    i : Integer;
@@ -2295,17 +2382,15 @@ end;
 
 procedure TGradTabControl.SetImages(const AValue: TImageList);
 begin
-  DebugLn('FImages: ', IsAssigned(FImages));
+  //DebugLn('FImages: ', IsAssigned(FImages));
   if FImages=AValue then exit;
+  if (AValue = nil) AND (FImages<>nil) then
+     FImages.UnRegisterChanges(FImageChangeLink);
+
   FImages:=AValue;
 
-  DebugLn('FImages: ', IsAssigned(FImages));
-  DebugLn('FImages: ', IsAssigned(Images));
-
-  //DebugLn('AValue: ', IsAssigned(AValue));
-
   if FImages <> nil then
-     FImages.OnChange := @ImageListChange;
+     FImages.RegisterChanges(FImageChangeLink);
 
   UpdateTabImages;
 end;
@@ -3107,6 +3192,61 @@ begin
   end;
 end;
 
+{ TFormPage }
+
+constructor TFormPage.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FShowPageAtDestroy:=false;
+  FDestroyPageAtDestroy:=false;
+end;
+
+destructor TFormPage.Destroy;
+var
+   FOld : TCustomForm;
+begin
+  if FDestroyPageAtDestroy AND (FOldForm <> nil) then begin
+     FOld := FOldForm;
+     PageToForm(false);
+     FOld.Free;
+     FOld := nil;
+  end else
+  PageToForm(FShowPageAtDestroy);
+
+  inherited Destroy;
+end;
+
+procedure TFormPage.FormToPage(TheForm: TCustomForm);
+var
+   i : Integer;
+begin
+   if FOldForm = TheForm then Exit;
+   FOldForm := TheForm;
+
+   for i := TheForm.ControlCount-1 downto 0 do begin
+       TheForm.Controls[i].Parent := Self;
+   end;
+
+   Caption:=TheForm.Caption;
+
+   if TheForm.Visible then
+      TheForm.Close;
+end;
+
+procedure TFormPage.PageToForm(AShow : Boolean);
+var
+   i : Integer;
+begin
+   for i := ControlCount-1 downto 0 do begin
+       Controls[i].Parent := FOldForm;
+   end;
+
+   if AShow then
+      FOldForm.Show;
+   FOldForm := nil;
+end;
+
 initialization
   {$I ugradtabcontrol.lrs}