HeidiSQL/source/vcl-styles-utils/Vcl.Styles.ColorTabs.pas

//**************************************************************************************************
//                                                                                                  
// Unit Vcl.Styles.ColorTabs                                                                        
// unit for the VCL Styles Utils                                                                    
// https://github.com/RRUZ/vcl-styles-utils/                                                       
//                                                                                                  
// The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); 
// you may not use this file except in compliance with the License. You may obtain a copy of the    
// License at http://www.mozilla.org/MPL/                                                           
//                                                                                                  
// Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   
// ANY KIND, either express or implied. See the License for the specific language governing rights  
// and limitations under the License.                                                               
//                                                                                                  
// The Original Code is Vcl.Styles.ColorTabs                                                        
//                                                                                                  
// The Initial Developer of the Original Code is Rodrigo Ruz V.                                     
// Portions created by Rodrigo Ruz V. are Copyright (C) 2012-2016 Rodrigo Ruz V.
// All Rights Reserved.                                                                             
//                                                                                                  
//**************************************************************************************************
unit Vcl.Styles.ColorTabs;

interface

uses
  Winapi.Messages,
  Vcl.Graphics,
  Vcl.ComCtrls;

type
  TTabSheet = class(Vcl.ComCtrls.TTabSheet)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  end;

  TTabColorControlStyleHook= class(TTabControlStyleHook)
  private
    class var FUseBorder : Boolean;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
  protected
    class constructor Create;
    procedure PaintBackground(Canvas: TCanvas); override;
    procedure Paint(Canvas: TCanvas); override;
    procedure DrawTab(Canvas: TCanvas; Index: Integer); override;
    class property  UseBorder : Boolean read FUseBorder write FUseBorder;
  end;

implementation

uses
 System.Classes,
 System.SysUtils,
 System.Types,
 System.Rtti,
 System.Generics.Collections,
 Winapi.Windows,
 Vcl.Styles,
 Vcl.Themes,
 Vcl.Controls;

type
  TStyleHookList = TList<TStyleHookClass>;

  TPageControlHelper = class helper for TPageControl
  public
    procedure UpdateTab2(Page: Vcl.ComCtrls.TTabSheet);
  end;

  TWinControlClass = class(TWinControl);
  TCustomTabControlClass = class(TCustomTabControl);

  TTabControlStyleHookHelper = class helper for TTabControlStyleHook
  public
    procedure AngleTextOut2(Canvas: TCanvas; Angle: Integer; X, Y: Integer; const Text: string);
  end;

  TStyleHookDictionary = TDictionary<TClass, TStyleHookList>;
  TCustomStyleEngineHelper = Class Helper for TCustomStyleEngine
  public
    class function GetRegisteredStyleHooks : TStyleHookDictionary;
  End;


class function TCustomStyleEngineHelper.GetRegisteredStyleHooks: TStyleHookDictionary;
var
  p : Pointer;
begin
  {$IF (CompilerVersion <31)}
  Result:= Self.FRegisteredStyleHooks;
  {$ELSE}
   {
   TCustomStyleEngine.FRegisteredStyleHooks:
   00651030 3052AA           xor [edx-$56],dl
   00651033 02F7             add dh,bh
   00651035 097623           or [esi+$23],esi
   TCustomStyleEngine.$ClassInitFlag:
   00651038 FFFF             db $ff $ff
   0065103A FFFF             db $ff $ff
   TCustomStyleEngine.FRegSysStylesList:
   0065103C D037             shl [edi],1
    }
  {$IFDEF CPUX64}
   p      := Pointer(PByte(@Self.FRegSysStylesList) - 24);
  {$ELSE}
   p      := Pointer(PByte(@Self.FRegSysStylesList) - 12);
  {$ENDIF CPUX64}
  Result := TStyleHookDictionary(p^);
  {$IFEND}
end;


function GetBorderColorTab: TColor;
begin
 result:=clBlack;
end;

function GetColorTab(Index : Integer) : TColor;
Const
  MaxColors =9;
  Colors : Array [0..MaxColors-1] of TColor = (6512214,16755712,8355381,1085522,115885,1098495,1735163,2248434,4987610);
begin
  Result:=Colors[Index mod MaxColors];
end;


function GetColorTextTab(ThemedTab  : TThemedTab) : TColor;
Const
 ColorSelected = clYellow;
 ColorHot      = clGray;
 ColorNormal   = clWhite;
begin
    Result:=ColorNormal;
    case ThemedTab of
       ttTabItemSelected,
       ttTabItemLeftEdgeSelected,
       ttTabItemBothEdgeSelected,
       ttTabItemRightEdgeSelected : Result:= ColorSelected;

       ttTabItemHot,
       ttTabItemLeftEdgeHot,
       ttTabItemBothEdgeHot,
       ttTabItemRightEdgeHot      : Result := ColorHot;

       ttTabItemNormal,
       ttTabItemLeftEdgeNormal,
       ttTabItemBothEdgeNormal,
       ttTabItemRightEdgeNormal  : Result := ColorNormal;
    end;
end;


function  IsStyleHookRegistered(ControlClass: TClass; StyleHookClass: TStyleHookClass) : Boolean;
var
  List    : TStyleHookList;
begin
 Result:=False;
    if TCustomStyleEngine.GetRegisteredStyleHooks.ContainsKey(ControlClass) then
    begin
      List := TCustomStyleEngine.GetRegisteredStyleHooks[ControlClass];
      Result:=List.IndexOf(StyleHookClass) <> -1;
    end;
end;


{ TTabSheet }

procedure TTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  LRect  : TRect;
  LSize  : Integer;
  LCanvas: TCanvas;
begin
  //check if the TTabColorControlStyleHook is registered
  if (not IsStyleHookRegistered(TCustomTabControl, TTabColorControlStyleHook)) and (not IsStyleHookRegistered(TTabControl, TTabColorControlStyleHook)) then
    inherited
  else
  if (PageControl <> nil) and StyleServices.Enabled and TStyleManager.IsCustomStyleActive then
  begin
    GetWindowRect(Handle, LRect);
    OffsetRect(LRect, -LRect.Left, -LRect.Top);
    LSize := ClientToParent(Point(0, 0)).X;
    InflateRect(LRect, LSize, LSize); // remove border
    //create a TCanvas for erase the background, using the DC of the message
    LCanvas := TCanvas.Create;
    try
      LCanvas.Handle := Message.DC;
      LCanvas.Brush.Color:=GetColorTab(TabIndex);
      LCanvas.FillRect(LRect);
    finally
      LCanvas.Handle := 0;
      LCanvas.Free;
    end;

    Message.Result := 1;
    if PageControl.ActivePage<>nil then
     PageControl.UpdateTab2(PageControl.ActivePage);
  end
  else
    inherited;
end;


{ TPageControlHelper }

procedure TPageControlHelper.UpdateTab2(Page: Vcl.ComCtrls.TTabSheet);
begin
  {$IF (CompilerVersion <31)}
  Self.UpdateTab(Page);
  {$ELSE}
  Self.Tabs[Page.TabIndex] := Page.Caption;
  {$IFEND}
end;

{ TTabControlStyleHookHelper }

procedure TTabControlStyleHookHelper.AngleTextOut2(Canvas: TCanvas; Angle, X,
  Y: Integer; const Text: string);
var
  LSavedDC: Integer;
begin
  LSavedDC := SaveDC(Canvas.Handle);
  try
    SetBkMode(Canvas.Handle, TRANSPARENT);
    Canvas.Font.Orientation := Angle;
    Canvas.TextOut(X, Y, Text);
  finally
    RestoreDC(Canvas.Handle, LSavedDC);
  end;
end;


{ TTabColorControlStyleHook }
class constructor TTabColorControlStyleHook.Create;
begin
  FUseBorder:=True;
end;

procedure TTabColorControlStyleHook.DrawTab(Canvas: TCanvas; Index: Integer);
var
  LDetails    : TThemedElementDetails;
  LImageIndex : Integer;
  LThemedTab  : TThemedTab;
  LIconRect   : TRect;
  R, LayoutR  : TRect;
  LImageW, LImageH, DxImage : Integer;
  LTextX, LTextY: Integer;
  LTextColor    : TColor;

    procedure DrawControlText(const S: string; var R: TRect; Flags: Cardinal);
    var
      TextFormat: TTextFormatFlags;
    begin
      Canvas.Font       := TWinControlClass(Control).Font;
      TextFormat        := TTextFormatFlags(Flags);
      Canvas.Font.Color := LTextColor;
      StyleServices.DrawText(Canvas.Handle, LDetails, S, R, TextFormat, Canvas.Font.Color);
    end;

begin
  if (Images <> nil) and (Index < Images.Count) then
  begin
    LImageW := Images.Width;
    LImageH := Images.Height;
    DxImage := 3;
  end
  else
  begin
    LImageW := 0;
    LImageH := 0;
    DxImage := 0;
  end;

  R := TabRect[Index];
  if R.Left < 0 then Exit;

  if TabPosition in [tpTop, tpBottom] then
  begin
    if Index = TabIndex then
      InflateRect(R, 0, 2);
  end
  else if Index = TabIndex then
    Dec(R.Left, 2) else Dec(R.Right, 2);

  Canvas.Font.Assign(TCustomTabControlClass(Control).Font);
  LayoutR := R;
  LThemedTab := ttTabDontCare;
  //Get the type of the active tab
  case TabPosition of
    tpTop:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemSelected
        else if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemHot
        else
          LThemedTab := ttTabItemNormal;
      end;
    tpLeft:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemLeftEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemLeftEdgeHot
        else
          LThemedTab := ttTabItemLeftEdgeNormal;
      end;
    tpBottom:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemBothEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemBothEdgeHot
        else
          LThemedTab := ttTabItemBothEdgeNormal;
      end;
    tpRight:
      begin
        if Index = TabIndex then
          LThemedTab := ttTabItemRightEdgeSelected
        else if (Index = HotTabIndex) and MouseInControl then
          LThemedTab := ttTabItemRightEdgeHot
        else
          LThemedTab := ttTabItemRightEdgeNormal;
      end;
  end;

  //draw the tab
  if StyleServices.Available then
  begin
    LDetails := StyleServices.GetElementDetails(LThemedTab);//necesary for  DrawControlText

    if FUseBorder then
    begin
      case TabPosition of
       tpTop :
            begin
              InflateRect(R,-1,0);
              if TabIndex<>Index then
               R.Bottom:=R.Bottom+1
              else
               R.Bottom:=R.Bottom-1;

              Canvas.Brush.Color:=GetBorderColorTab;
              Canvas.FillRect(R);

              if TabIndex=Index then
              begin
               InflateRect(R,-1,-1);
               R.Bottom:=R.Bottom+1;
              end
              else
               InflateRect(R,-1,-1);
            end;

       tpBottom :
            begin
              InflateRect(R,-1,0);
              if TabIndex<>Index then
               R.Bottom:=R.Bottom+1
              else
               R.Top:=R.Top+3;

              Canvas.Brush.Color:=GetBorderColorTab;
              Canvas.FillRect(R);

              if TabIndex=Index then
              begin
               InflateRect(R,-1, 0);
               R.Bottom:=R.Bottom-1;
              end
              else
               InflateRect(R,-1,-1);
            end;

       tpLeft :
            begin
              InflateRect(R, 0, -1);

              if TabIndex<>Index then
               R.Left:=R.Left+1
              else
               R.Right:=R.Right-1;

              Canvas.Brush.Color:=GetBorderColorTab;
              Canvas.FillRect(R);


              if TabIndex=Index then
              begin
               InflateRect(R,-1,-1);
               R.Right:=R.Right+1;
              end
              else
               InflateRect(R,-1,-1);

            end;

       tpRight :
            begin
              InflateRect(R, 0, -1);

              if TabIndex<>Index then
               //R.Left:=R.Left+1
              else
               R.Left:=R.Left+3;

              Canvas.Brush.Color:=GetBorderColorTab;
              Canvas.FillRect(R);


              if TabIndex=Index then
              begin
               InflateRect(R,-1,-1);
               R.Left:=R.Left-1;
              end
              else
               InflateRect(R,-1,-1);

            end;


      end;


      Canvas.Brush.Color:=GetColorTab(Index);
      Canvas.FillRect(R);
    end
    else
    Begin
      InflateRect(R,-1,0);//adjust the size of the tab creating blanks space between the tabs
      Canvas.Brush.Color:=GetColorTab(Index);
      Canvas.FillRect(R);
    end;

  end;

  //get the index of the image (icon)
  if Control is TCustomTabControl then
    LImageIndex := TCustomTabControlClass(Control).GetImageIndex(Index)
  else
    LImageIndex := Index;

  //draw the image
  if (Images <> nil) and (LImageIndex >= 0) and (LImageIndex < Images.Count) then
  begin
    LIconRect := LayoutR;
    case TabPosition of
      tpTop, tpBottom:
        begin
          LIconRect.Left := LIconRect.Left + DxImage;
          LIconRect.Right := LIconRect.Left + LImageW;
          LayoutR.Left := LIconRect.Right;
          LIconRect.Top := LIconRect.Top + (LIconRect.Bottom - LIconRect.Top) div 2 - LImageH div 2;
          if (TabPosition = tpTop) and (Index = TabIndex) then
            OffsetRect(LIconRect, 0, -1)
          else
          if (TabPosition = tpBottom) and (Index = TabIndex) then
            OffsetRect(LIconRect, 0, 1);
        end;
      tpLeft:
        begin
          LIconRect.Bottom := LIconRect.Bottom - DxImage;
          LIconRect.Top := LIconRect.Bottom - LImageH;
          LayoutR.Bottom := LIconRect.Top;
          LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
        end;
      tpRight:
        begin
          LIconRect.Top := LIconRect.Top + DxImage;
          LIconRect.Bottom := LIconRect.Top + LImageH;
          LayoutR.Top := LIconRect.Bottom;
          LIconRect.Left := LIconRect.Left + (LIconRect.Right - LIconRect.Left) div 2 - LImageW div 2;
        end;
    end;
    if StyleServices.Available then
      StyleServices.DrawIcon(Canvas.Handle, LDetails, LIconRect, Images.Handle, LImageIndex);
  end;

  //draw the text of the tab
  if StyleServices.Available then
  begin
    LTextColor:=GetColorTextTab(LThemedTab);

    if (TabPosition = tpTop) and (Index = TabIndex) then
      OffsetRect(LayoutR, 0, -1)
    else
    if (TabPosition = tpBottom) and (Index = TabIndex) then
      OffsetRect(LayoutR, 0, 1);

    if TabPosition = tpLeft then
    begin
      LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 - Canvas.TextHeight(Tabs[Index]) div 2;
      LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 + Canvas.TextWidth(Tabs[Index]) div 2;
      Canvas.Font.Color := LTextColor;
      AngleTextOut2(Canvas, 900, LTextX, LTextY, Tabs[Index]);
    end
    else
    if TabPosition = tpRight then
    begin
      LTextX := LayoutR.Left + (LayoutR.Right - LayoutR.Left) div 2 + Canvas.TextHeight(Tabs[Index]) div 2;
      LTextY := LayoutR.Top + (LayoutR.Bottom - LayoutR.Top) div 2 - Canvas.TextWidth(Tabs[Index]) div 2;
      Canvas.Font.Color := LTextColor;
      AngleTextOut2(Canvas, -900, LTextX, LTextY, Tabs[Index]);
    end
    else
     DrawControlText(Tabs[Index], LayoutR, DT_VCENTER or DT_CENTER or DT_SINGLELINE  or DT_NOCLIP);
  end;
end;

procedure TTabColorControlStyleHook.Paint(Canvas: TCanvas);
var
  LRect  : TRect;
  LIndex : Integer;
  SavedDC: Integer;
begin
  SavedDC := SaveDC(Canvas.Handle);
  try
    LRect := DisplayRect;
    ExcludeClipRect(Canvas.Handle, LRect.Left, LRect.Top, LRect.Right, LRect.Bottom);
    PaintBackground(Canvas);
  finally
    RestoreDC(Canvas.Handle, SavedDC);
  end;

  // Draw tabs , except the active
  for LIndex := 0 to TabCount - 1 do
  begin
    if LIndex = TabIndex then
      Continue;
    DrawTab(Canvas, LIndex);
  end;

  //Draw the body
  case TabPosition of
    tpTop   : InflateRect(LRect, Control.Width - LRect.Right, Control.Height - LRect.Bottom);
    tpLeft  : InflateRect(LRect, Control.Width - LRect.Right, Control.Height - LRect.Bottom);
    tpBottom: InflateRect(LRect, LRect.Left, LRect.Top);
    tpRight : InflateRect(LRect, LRect.Left, LRect.Top);
  end;

  if StyleServices.Available then
  begin
    if FUseBorder then
    begin
      Canvas.Brush.Color:=GetBorderColorTab;
      Canvas.Rectangle(LRect.Left, LRect.Top, LRect.Right, LRect.Bottom);

      InflateRect(LRect, -1, -1);
      Canvas.Brush.Color:=GetColorTab(TabIndex);
      Canvas.FillRect(LRect);
    end
    else
    begin
      Canvas.Brush.Color:=GetColorTab(TabIndex);
      Canvas.FillRect(LRect);
    end;
  end;

  // Draw active tab
  if TabIndex >= 0 then
    DrawTab(Canvas, TabIndex);

  // paint the controls of the tab
  TWinControlClass(Control).PaintControls(Canvas.Handle, nil);
end;

procedure TTabColorControlStyleHook.PaintBackground(Canvas: TCanvas);
var
  LColor : TColor;
begin
  if StyleServices.Available then
  begin

    if Control.Parent is TTabSheet then
     LColor:= GetColorTab(TTabSheet(Control.Parent).PageIndex)
    else
     LColor:= StyleServices.GetSystemColor(clWindowFrame);

    Canvas.Brush.Color:=LColor;
    Canvas.FillRect(Control.ClientRect);
  end;
end;

procedure TTabColorControlStyleHook.WMEraseBkgnd(var Message: TMessage);
var
  LCanvas : TCanvas;
begin
  if (Message.LParam = 1) and StyleServices.Available then
  begin
    LCanvas := TCanvas.Create;
    try
      LCanvas.Handle := HDC(Message.WParam);
      LCanvas.Brush.Color:=GetColorTab(TabIndex);
      LCanvas.FillRect(Control.ClientRect);
    finally
      LCanvas.Handle := 0;
      LCanvas.Free;
    end;
  end;
  Message.Result := 1;
  Handled := True;
end;


end.