{
  Copyright (C) 2010 Felipe Monteiro de Carvalho

  License: The same modifying LGPL with static linking exception as the LCL

  This unit should be a repository for various custom drawn components,
  such as a custom drawn version of TButton, of TEdit, of TPageControl, etc,
  eventually forming a full set of custom drawn components.
}
unit customdrawnextras;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, Controls, LCLType, LCLIntf, IntfGraphics,
  Math, customdrawnutils, contnrs, componenteditors, LMessages, Messages,
  LCLProc, PropEdits, ExtCtrls, ImgList, Forms, Menus,
  // fpimage
  fpcanvas, fpimgcanv, fpimage
  {$ifdef CUSTOMDRAWN_USE_FREETYPE}
  // font support
  , ftfont
  {$endif}  ;

type

  // commented items are not yet supported
  TBitmappedButtonOption = (bboUseImageForSelection
    {bboUseImageForMouseOver, bboDrawFocusRectangle,}
    (*bboCheckable,*));

  TBitmappedButtonOptions = set of TBitmappedButtonOption;

  // commented items are not yet supported
  TBitmappedButtonState = (bbsNormal, bbsDown, bbsMouseOver, bbsFocused
    (* bbsChecked, bbsCheckedSelected, bbsCheckedDown { is going to be unchecked }*));

  TCDDrawStyle = (
    // Operating system styles
    dsWinCE, dsWin2000, dsAndroid, dsXPTaskBar,
    // Other special styles
    dsGrad,
    // Defined by the user
    dsCustom);

  { TCustomBitmappedButton }

  TCustomBitmappedButton = class(TCustomControl)
  private
    FOnChange: TNotifyEvent;
    BmpBuffer: TBitmap;
    StrBuffer: TStringList;
  protected
    FImageBtn: TPicture;
    FImageBtnDown: TPicture;
    FImageBtnMouseOver: TPicture;
    FImageBtnFocused: TPicture;
    FImageBtnChecked: TPicture;
    FOptions: TBitmappedButtonOptions;
    FState: TBitmappedButtonState;
    // keyboard
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
    // mouse
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    // button state change
    procedure DoButtonDown();
    procedure DoButtonUp();
    // inherited
    procedure RealSetText(const Value: TCaption); override;
  protected
    // Properties
    property ImageBtn: TPicture read FImageBtn;
    property ImageBtnDown: TPicture read FImageBtnDown;
    property ImageBtnFocused: TPicture read FImageBtnFocused;
    property Options: TBitmappedButtonOptions read FOptions write FOptions;
    // Events
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
    function GetStateBitmap(): TBitmap;
  end;

  {@@
    TBitmappedButton is a simple custom drawn button which bases it's drawing
    on provided raster images. Currently the following states are supported:
    normal, down and focused.

    The Caption of this button may have multiple lines of text, separated by any
    line separator. The text is drawn centralized in the button.

    Some work was done trying to achieve alpha blending for the button, but this
    wasn't successfull. It would work like this: The button may be drawn flat
    or alpha blended using a separate image for the Alpha channel. While pixels
    in the alpha channel will result in the button pixel being fully drawn,
    while black pixels represent pixels which aren't drawn. grey pixels are
    alpha blended.
  }

  TBitmappedButton = class(TCustomBitmappedButton)
  published
    // LCL properties and events
    property Action;
    property Anchors;
    property AnchorSide;
    //    property BidiMode;
    //    property BorderSpacing;
    //    property Cancel;
    property Caption;
    property Constraints;
    //    property Default;
    //    property DragCursor;
    //    property DragKind;
    //    property DragMode;
    property Enabled;
    property Font;
    //    property ParentBidiMode;
    //    property ModalResult;
    property OnChangeBounds;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    // Specific properties
    property ImageBtn;
    property ImageBtnDown;
    property ImageBtnFocused;
    property Options;
  end;


  TCDButtonDrawer = class;
  TCDButtonDrawerWinCE = class;
  TCDButtonDrawerAndroid = class;
  TCDButtonDrawerXPTB = class;
  TCDButtonDrawerGrad = class;
  TCDButtonDrawerWin2k = class;

  TCDButton = class(TCustomControl)
  private
    FDrawStyle: TCDDrawStyle;
    FCurrentDrawer: TCDButtonDrawer;
    FDrawerWinCE: TCDButtonDrawerWinCE;
    FDrawerAndroid: TCDButtonDrawerAndroid;
    FDrawerXPTB: TCDButtonDrawerXPTB;
    FDrawerGrad: TCDButtonDrawerGrad;
    FDrawerWin2k: TCDButtonDrawerWin2k;
    procedure PrepareCurrentDrawer();
    procedure SetDrawStyle(const AValue: TCDDrawStyle);
  protected
    FState: TBitmappedButtonState;
    // keyboard
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
    // mouse
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    // button state change
    procedure DoButtonDown();
    procedure DoButtonUp();
    procedure RealSetText(const Value: TCaption); override;
  public
    CustomDrawer: TCDButtonDrawer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
  published
    property Action;
    property Anchors;
    property Caption;
    property Color;
    property Constraints;
    property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
    property Enabled;
    property Font;
    property OnChangeBounds;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
  end;

  { TCDButtonDrawer }

  TCDButtonDrawer = class
  public
    procedure SetClientRectPos(CDButton: TCDButton); virtual; abstract;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton);
      virtual; abstract;
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
      FState: TBitmappedButtonState); virtual; abstract;
  end;

  { TCDButtonDrawerWinCE }

  TCDButtonDrawerWinCE = class(TCDButtonDrawer)
  public
    procedure SetClientRectPos(CDButton: TCDButton); override;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
      FState: TBitmappedButtonState); override;
  end;

  { TCDButtonDrawerAndroid }
  TCDButtonDrawerAndroid = class(TCDButtonDrawer)
  public
    procedure SetClientRectPos(CDButton: TCDButton); override;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
      FState: TBitmappedButtonState); override;
  end;

  TCDButtonDrawerXPTB = class(TCDButtonDrawer)
  public
    procedure SetClientRectPos(CDButton: TCDButton); override;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
      FState: TBitmappedButtonState); override;
  end;

  TCDButtonDrawerGrad = class(TCDButtonDrawer)
  public
    procedure SetClientRectPos(CDButton: TCDButton); override;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
      FState: TBitmappedButtonState); override;
  end;

  TCDButtonDrawerWin2k = class(TCDButtonDrawer)
  public
    procedure SetClientRectPos(CDButton: TCDButton); override;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
      FState: TBitmappedButtonState); override;
  end;

  {@@
    TCDGroupBox is a custom-drawn group box control
  }

  TCDGroupBoxDrawer = class;
  TCDGroupBoxDrawerWinCE = class;

  { TCDGroupBox }

  TCDGroupBox = class(TCustomControl)
  private
    FDrawStyle: TCDDrawStyle;
    FCurrentDrawer: TCDGroupBoxDrawer;
    FDrawerWinCE: TCDGroupBoxDrawerWinCE;
    procedure PrepareCurrentDrawer();
    procedure SetDrawStyle(const AValue: TCDDrawStyle);
  public
    CustomDrawer: TCDGroupBoxDrawer; // Fill the field to use the dsCustom draw mode
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
  published
    property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
    property Caption;
    property TabStop default False;
  end;

  { TCDGroupBoxDrawer }

  TCDGroupBoxDrawer = class
  public
    procedure SetClientRectPos(CDGroupBox: TCDGroupBox); virtual; abstract;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox);
      virtual; abstract;
    procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); virtual; abstract;
  end;

  { TCDGroupBoxDrawerWinCE }

  TCDGroupBoxDrawerWinCE = class(TCDGroupBoxDrawer)
  public
    FCaptionMiddle: integer;
    procedure SetClientRectPos(CDGroupBox: TCDGroupBox); override;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox); override;
    procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); override;
  end;

  {@@
    TCDTrackBar is a custom-drawn trackbar control
  }

  TCDTrackBarDrawer = class;

  { TCDTrackBar }

  TCDTrackBar = class(TCustomControl)
  private
    FMDown: boolean;
    FMin: integer;
    FMax: integer;
    FPosition: integer;
    FOnChange: TNotifyEvent;
    FCurrentDrawer: TCDTrackBarDrawer;
    FFromColor, FToColor: TColor;
    FStepWidth: integer;
    FAutoWidth: boolean;
    procedure SetMax(Value: integer);
    procedure SetMin(Value: integer);
    procedure SetPosition(Value: integer);
    procedure SetFromColor(Value: TColor);
    procedure SetToColor(Value: TColor);
    procedure SetStepWidth(Value: integer);
  protected
    procedure Changed; virtual;
    // keyboard
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
    // mouse
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
  public
    xPosition: integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
  published
    property AutoWidth: boolean read FAutoWidth write FAutoWidth;
    property Color;
    property Max: integer read FMax write SetMax default 10;
    property Min: integer read FMin write SetMin default 0;
    property ColorFrom: TColor read FFromColor write SetFromColor;
    property StepWidth: integer read FStepWidth write SetStepWidth;
    property ColorTo: TColor read FToColor write SetToColor;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Position: integer read FPosition write SetPosition;
    property TabStop default True;
  end;

  { TCDTrackBarDrawer }

  TCDTrackBarDrawer = class
  public
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor; pWidth: integer);
      virtual; abstract;
  end;

  TCDTrackBarDrawerGraph = class(TCDTrackBarDrawer)
  public
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor; pWidth: integer); override;
  end;

  {TCDTabControl}

  TCDTabSheet = class;

  TTabItem = class(TCollectionItem)
  private
    FTitle: string;
    FSelected: boolean;
    FData: TObject;
    FModified: boolean;
    FImageIndex: TImageIndex;
    FWidth: integer;
    FTabPage: TCDTabSheet;
    procedure SetSelected(Value: boolean);
    procedure SetModified(Value: boolean);
    procedure DoChange;
    procedure SetTitle(Value: string);
    procedure SetImageIndex(Value: TImageIndex);
  protected
    FStartPos: integer;
    FSize: integer;
    function GetDisplayName: string; override;
  public
    constructor Create(aCollection: TCollection); override;
    destructor Destroy; override;
    property Data: TObject read FData write FData;
  published
    property Width: integer read FWidth write FWidth;
    property Title: string read FTitle write SetTitle;
    property Selected: boolean read FSelected write SetSelected;
    property Modified: boolean read Fmodified write SetModified;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
    property TabPage: TCDTabSheet read FTabPage write FTabPage;
  end;

  TTabItemList = class(TCollection)
  protected
    procedure DoSelected(ATab: TTabItem; ASelected: boolean); dynamic;
    procedure DoChanged(ATab: TTabItem); dynamic;
    procedure SetItem(Index: integer; Value: TTabItem);
    function GetItem(Index: integer): TTabItem;
  public
    function IndexOf(ATab: TTabItem): integer;
    function Add: TTabItem;
    property Items[Index: integer]: TTabItem read GetItem write SetItem; default;
  end;

  TCDTabControlDrawer = class;
  TCDTabControlDrawerGraph = class;

  TTabSelectedEvent = procedure(Sender: TObject; ATab: TTabItem;
    ASelected: boolean) of object;

  TCDTabControl = class(TCustomControl)
  private
    FCurrentDrawer: TCDTabControlDrawerGraph;
    FTabIndex: integer;
    FTabs: TTabItemList;
    FOnTabSelected: TTabSelectedEvent;
    FMDownL, FMDownR: boolean;
    FMEnterL, FMEnterR: boolean;
    RButtHeight: integer;
    FStartIndex: integer;
    //FEndIndex: integer;
    MaskHeadBmp: TBitmap;
    procedure SetMouseUP;
    procedure SetTabIndex(Value: integer);
    procedure SetStartIndex(Value: integer);
    //procedure SetEndIndex(Value: integer);
  protected
    procedure Changed; virtual;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure KeyUp(var Key: word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure TabSelected(ATab: TTabItem; ASelected: boolean); dynamic;
    procedure GetThisTab(ATab: TTabItem);
    procedure ClearSelection;
    procedure DrawCaptionBar(ADest: TCanvas; lRect: TRect; CL: TColor);
    procedure Loaded; override;
    procedure DoOnResize; override;
    procedure DoLeftButtonDown;
    procedure DoRightButtonDown;
    function GetPageIndexFromXY(x, y: integer): integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
  published
    property Caption;
    property Color;
    property Font;
    property StartIndex: integer read FStartIndex write SetStartIndex;
    //property EndIndex: integer read FEndIndex write SetEndIndex;
    property TabIndex: integer read fTabIndex write SetTabIndex;
    property Tabs: TTabItemList read FTabs write FTabs;
    property OnTabSelected: TTabSelectedEvent read fOnTabSelected write fOnTabSelected;
  end;

  TCDTabControlDrawer = class
  public
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDTabControl: TCDTabControl); virtual; abstract;
    procedure DrawToCanvas(ADest: TCanvas; CDTabControl: TCDTabControl);
      virtual; abstract;
  end;

  TCDTabControlDrawerGraph = class(TCDTabControlDrawer)
  public
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDTabControl: TCDTabControl); override;
    procedure DrawToCanvas(ADest: TCanvas; CDTabControl: TCDTabControl); override;
  end;

  { TCDTabSheet }

  TCDTabSheetDrawerGraph = class;
  TCDPageControl = class;

  TCDTabSheet = class(TCustomControl)
  private
    FCurrentDrawer: TCDTabSheetDrawerGraph;
    FIndex: integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
  published
    property Caption;
    property Color;
    property Font;
    property Index: integer read FIndex write FIndex;
  end;

  { TCDTabSheetDrawer }

  TCDTabSheetDrawer = class
  public
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDTrackBar: TCDTabSheet); virtual; abstract;
  end;

  TCDTabSheetDrawerGraph = class(TCDTabSheetDrawer)
  public
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDTabSheet: TCDTabSheet); override;
  end;

  { TCDPageControl }

  TCDPageControlDrawer = class;
  TCDPageControlDrawerWinCE = class;

  { TCDPageControlEditor }

  TCDPageControlEditor = class(TDefaultComponentEditor)
    procedure ShowPageMenuItemClick(Sender: TObject);
  public
    procedure ExecuteVerb(Index: integer); override;
    function GetVerb(Index: integer): string; override;
    function GetVerbCount: integer; override;
    procedure PrepareItem(Index: integer; const AnItem: TMenuItem); override;
    procedure AddMenuItemsForPages(ParentMenuItem: TMenuItem); virtual;
    function PControl: TCDPageControl; virtual;
  end;

  TCDPageControl = class(TCustomControl)
  private
    FDrawStyle: TCDDrawStyle;
    FCaptionHeight: integer;
    FActivePage: TCDTabSheet;
    FCurrentDrawer: TCDPageControlDrawer;
    FDrawerWinCE: TCDPageControlDrawerWinCE;
    FGrad: boolean;
    FShowTabs: boolean;
    FStartIndex: integer;       //FEndIndex
    RButtHeight: integer;
    FPages: TTabItemList;
    FMDownL, FMDownR: boolean;
    FMEnterL, FMEnterR: boolean;
    FPageIndex: integer;  //FPageCount
    MaskHeadBmp: TBitmap;
    function GetPageCount: integer;
    procedure SetMouseUP;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    //procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY;
    procedure PrepareCurrentDrawer();
    procedure SetDrawStyle(const AValue: TCDDrawStyle);
    procedure SetCaptionHeight(Value: integer);
    procedure DrawCaptionBar(ADest: TCanvas; lRect: TRect; CL: TColor);
    procedure SetPageGradient(Value: boolean);
    procedure SetShowTabs(Value: boolean);
    procedure SetActivePage(Value: TCDTabSheet);
    procedure SetPageIndex(Value: integer);
    procedure UpdateAllDesignerFlags;
    procedure UpdateDesignerFlags(APageIndex: integer);
    procedure SetStartIndex(Value: integer);
    //procedure SetEndIndex(Value: integer);
  protected
    CustomDrawer: TCDPageControlDrawer; // Fill the field to use the dsCustom draw mode
    procedure Loaded; override;
    function GetPageIndexFromXY(x, y: integer): integer;
    procedure DoLeftButtonDown;
    procedure DoRightButtonDown;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
    procedure DoOnResize; override;
    function FindNextPage(CurPage: TCDTabSheet;
      GoForward, CheckTabVisible: boolean): TCDTabSheet;
    procedure SelectNextPage(GoForward: boolean; CheckTabVisible: boolean = True);
    procedure SetCDPages(Value: TTabItemList);
    procedure InsertPage(aIndex: integer; S: string);
    procedure RemovePage(aIndex: integer);
    procedure AddPage(S: string);
  published
    property ActivePage: TCDTabSheet read FActivePage write SetActivePage;
    property DrawStyle: TCDDrawStyle read FDrawStyle write SetDrawStyle;
    property Caption;
    property CaptionHeight: integer read FCaptionHeight write SetCaptionHeight;
    property Color;
    property Font;
    property Gradient: boolean read FGrad write SetPageGradient;
    //property PageCount: integer read FPageCount;
    property PageIndex: integer read FPageIndex write SetPageIndex;
    property Pages: TTabItemList read FPages write SetCDPages;
    property PageCount: integer read GetPageCount;
    property ParentColor;
    property ParentFont;
    property ShowTabs: boolean read FShowTabs write SetShowTabs;
    property StartIndex: integer read FStartIndex write SetStartIndex;
    //property EndIndex: integer read FEndIndex write SetEndIndex;
    property TabStop default True;
  end;

  { TCDTrackBarDrawer }

  TCDPageControlDrawer = class
  public
    procedure SetClientRectPos(CDPageControl: TCDPageControl); virtual; abstract;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDPageControl: TCDPageControl); virtual; abstract;
    procedure DrawToCanvas(ADest: TCanvas; CDPageControl: TCDPageControl);
      virtual; abstract;
  end;

  TCDPageControlDrawerWinCE = class(TCDPageControlDrawer)
  public
    procedure SetClientRectPos(CDPageControl: TCDPageControl); override;
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
      CDPageControl: TCDPageControl); override;
    procedure DrawToCanvas(ADest: TCanvas; CDPageControl: TCDPageControl); override;
  end;

procedure Register;
function CheckTabButton(RWidth: integer; aItem: TTabItemList): boolean;

implementation

uses
  ObjInspStrConsts;

const
  INT_BitmappedButton_LineSpacing = 2;
  MaskBaseColor = $00111111;

resourcestring
  sTABSHEET_DEFAULT_NAME = 'CTabSheet';
  sNEXT_PAGE = 'Ne&xt Page';
  sPREV_PAGE = '&Previouse Page';

procedure Register;
begin
  RegisterComponents('Common Controls', [TCDButton]);
  RegisterComponents('Common Controls', [TCDTrackBar]);
  RegisterComponents('Common Controls', [TCDTabControl]);
  RegisterComponents('Common Controls', [TCDPageControl]);
  RegisterComponents('Common Controls', [TCDGroupBox]);
  //RegisterComponents('Common Controls', [TUntabbedNotebook]);
  RegisterComponentEditor(TCDPageControl, TCDPageControlEditor);
  RegisterComponentEditor(TCDTabSheet, TCDPageControlEditor);
  RegisterNoIcon([TCDTabSheet]);
  RegisterClasses([TCDTabSheet]);
end;

function CheckTabButton(RWidth: integer; aItem: TTabItemList): boolean;
var
  i, j: integer;
begin
  Result := False;
  j := 0;
  for i := 0 to aItem.Count - 1 do
  begin
    j := j + aItem[i].Width;
    if j > RWidth - 6 then
    begin
      Result := True;
      break;
    end;
  end;
end;

{ TCustomBitmappedButton }

procedure TCustomBitmappedButton.DoEnter;
begin
  DoButtonUp();

  inherited DoEnter;
end;

procedure TCustomBitmappedButton.DoExit;
begin
  DoButtonUp();

  inherited DoExit;
end;

procedure TCustomBitmappedButton.KeyDown(var Key: word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);

  if Key = VK_SPACE then
    DoButtonDown();
end;

procedure TCustomBitmappedButton.KeyUp(var Key: word; Shift: TShiftState);
begin
  DoButtonUp();

  inherited KeyUp(Key, Shift);
end;

procedure TCustomBitmappedButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  DoButtonDown();

  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCustomBitmappedButton.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  DoButtonUp();

  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TCustomBitmappedButton.MouseEnter;
begin
  inherited MouseEnter;
end;

procedure TCustomBitmappedButton.MouseLeave;
begin
  inherited MouseLeave;
end;

procedure TCustomBitmappedButton.DoButtonDown();
var
  NewState: TBitmappedButtonState;
begin
  NewState := bbsDown;

  case FState of
    bbsNormal, bbsFocused: NewState := bbsDown;
    //  bbsChecked, bbsCheckedSelected: NewState := bbsCheckedDown;
  end;

  if NewState <> FState then
  begin
    FState := NewState;
    Invalidate;
  end;
end;

procedure TCustomBitmappedButton.DoButtonUp();
var
  NewState: TBitmappedButtonState;
begin
  if Focused then
    NewState := bbsFocused
  else
    NewState := bbsNormal;

{  case FState of
  bbsCheckedDown:
  begin
    if Focused then NewState := bbsCheckedSelected
    else NewState := bbsChecked;
  end;
  end;}

  if NewState <> FState then
  begin
    FState := NewState;
    Invalidate;
  end;
end;

procedure TCustomBitmappedButton.RealSetText(const Value: TCaption);
begin
  inherited RealSetText(Value);

  // Makes sure that caption changes are drawn
  Invalidate;
end;

constructor TCustomBitmappedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  BmpBuffer := TBitmap.Create;
  StrBuffer := TStringList.Create;

  FImageBtn := TPicture.Create;
  FImageBtnDown := TPicture.Create;
  FImageBtnMouseOver := TPicture.Create;
  FImageBtnFocused := TPicture.Create;
  FImageBtnChecked := TPicture.Create;

  FOptions := [{bboDrawSelectionRectangle}];

  TabStop := True;
end;

destructor TCustomBitmappedButton.Destroy;
begin
  if Assigned(FImageBtn) then
    FImageBtn.Free;
  if Assigned(FImageBtnDown) then
    FImageBtnDown.Free;
  if Assigned(FImageBtnMouseOver) then
    FImageBtnMouseOver.Free;
  if Assigned(FImageBtnFocused) then
    FImageBtnFocused.Free;
  if Assigned(FImageBtnChecked) then
    FImageBtnChecked.Free;

  BmpBuffer.Free;
  StrBuffer.Free;

  inherited Destroy;
end;

procedure TCustomBitmappedButton.EraseBackground(DC: HDC);
begin
  // The correct implementation is doing nothing
end;

procedure TCustomBitmappedButton.Paint;
var
  lTextX, lTextY, lTextCX, lTextCY, lTmp, lTextHeightPlusLineSpacing: integer;
  i: integer;
begin
  // First draw the button image
  BmpBuffer.Width := Width;
  BmpBuffer.Height := Height;
  BmpBuffer.Canvas.Draw(0, 0, GetStateBitmap());

  // Now measure the text position

  BmpBuffer.Canvas.Font.Assign(Self.Font);
  BmpBuffer.Canvas.Brush.Style := bsClear;

  StrBuffer.Text := Caption;

  lTextCX := 0;
  for i := 0 to StrBuffer.Count - 1 do
  begin
    lTmp := BmpBuffer.Canvas.TextWidth(StrBuffer.Strings[i]);
    lTextCX := Max(lTextCX, lTmp);
  end;

  lTextHeightPlusLineSpacing :=
    BmpBuffer.Canvas.TextHeight(Caption) + INT_BitmappedButton_LineSpacing;
  lTextCY := BmpBuffer.Canvas.TextHeight(Caption) * StrBuffer.Count +
    INT_BitmappedButton_LineSpacing * (StrBuffer.Count - 1);

  lTextX := Width div 2 - lTextCX div 2;
  lTextY := Height div 2 - lTextCY div 2;

  // Draw the text

  for i := 0 to StrBuffer.Count - 1 do
  begin
    BmpBuffer.Canvas.TextOut(lTextX, lTextY + lTextHeightPlusLineSpacing * i,
      StrBuffer.Strings[i]);
  end;

  // And flush the buffer to the screen
  Canvas.Draw(0, 0, BmpBuffer);
end;

function TCustomBitmappedButton.GetStateBitmap(): TBitmap;
begin
  case FState of
    bbsDown: Result := FImageBtnDown.Bitmap;
    //  bbsMouseOver: Result := FImageBtnMouseOver;
    bbsFocused:
    begin
      if bboUseImageForSelection in Options then
        Result := FImageBtnFocused.Bitmap
      else
        Result := FImageBtn.Bitmap;
    end;
      //  bbsChecked:   Result := FImageBtnChecked;
    else
      Result := FImageBtn.Bitmap;
  end;
end;

procedure TCDButton.DoEnter;
begin
  DoButtonUp();

  inherited DoEnter;
end;

procedure TCDButton.DoExit;
begin
  DoButtonUp();

  inherited DoExit;
end;

procedure TCDButton.KeyDown(var Key: word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);

  if (Key = VK_SPACE) or (Key = VK_RETURN) then
    DoButtonDown();
end;

procedure TCDButton.KeyUp(var Key: word; Shift: TShiftState);
begin
  DoButtonUp();

  inherited KeyUp(Key, Shift);
end;

procedure TCDButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  if not Focused then
    SetFocus;
  DoButtonDown();

  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCDButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  DoButtonUp();

  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TCDButton.MouseEnter;
begin
  inherited MouseEnter;
end;

procedure TCDButton.MouseLeave;
begin
  inherited MouseLeave;
end;

procedure TCDButton.DoButtonDown();
var
  NewState: TBitmappedButtonState;
begin
  NewState := bbsDown;

  case FState of
    bbsNormal, bbsFocused: NewState := bbsDown;
  end;

  if NewState <> FState then
  begin
    FState := NewState;
    Invalidate;
  end;
end;

procedure TCDButton.DoButtonUp();
var
  NewState: TBitmappedButtonState;
begin
  if Focused then
    NewState := bbsFocused
  else
    NewState := bbsNormal;

  if NewState <> FState then
  begin
    FState := NewState;
    Invalidate;
  end;
end;

procedure TCDButton.PrepareCurrentDrawer();
begin
  case DrawStyle of
    dsWince: FCurrentDrawer := FDrawerWinCE;
    dsCustom: FCurrentDrawer := CustomDrawer;
    dsAndroid: FCurrentDrawer := FDrawerAndroid;
    dsXPTaskbar: FCurrentDrawer := FDrawerXPTB;
    dsGrad: FCurrentDrawer := FDrawerGrad;
    dsWin2000: FCurrentDrawer := FDrawerWin2k;
  end;
end;

procedure TCDButton.SetDrawStyle(const AValue: TCDDrawStyle);
begin
  if FDrawStyle = AValue then
    exit;
  FDrawStyle := AValue;

  Invalidate;

  PrepareCurrentDrawer();
  //  FCurrentDrawer.SetClientRectPos(Self); the button shouldn't receive controls inside it
end;

procedure TCDButton.RealSetText(const Value: TCaption);
begin
  inherited RealSetText(Value);
  Invalidate;
end;

constructor TCDButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := True;
  FDrawerWinCE := TCDButtonDrawerWinCE.Create;
  FDrawerAndroid := TCDButtonDrawerAndroid.Create;
  FDrawerXPTB := TCDButtonDrawerXPTB.Create;
  FDrawerGrad := TCDButtonDrawerGrad.Create;
  FDrawerWin2k := TCDButtonDrawerWin2k.Create;
  Width := 120;
  Height := 43;
  //Color := clTeal;
  ParentFont := True;
  FDrawStyle := dsAndroid;
  Color := $00F1F5F5;
end;

destructor TCDButton.Destroy;
begin
  inherited Destroy;
end;

procedure TCDButton.EraseBackground(DC: HDC);
begin

end;

procedure DrawCDButtonDown(Canvas: TCanvas; CDButton: TCDButton);
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := CDButton.Color;
    Pen.Color := Brush.Color;
    Rectangle(0, 0, Width, Height);
    FillRect(0, 0, Width, Height);
    Brush.Color := GetAColor(CDButton.Color, 93);
    Pen.Color := GetAColor(Brush.Color, 76);
    RoundRect(0, 0, Width, Height, 8, 8);
  end;
end;

procedure TCDButton.Paint;
var
  AImage: TLazIntfImage = nil;
  ABmp: TBitmap = nil;
  lCanvas: TFPImageCanvas = nil;
  pColor: TColor;
begin
  //  inherited Paint;

  PrepareCurrentDrawer();

  ABmp := TBitmap.Create;
  try
    ABmp.Width := Width;
    ABmp.Height := Height;
    AImage := ABmp.CreateIntfImage;
    lCanvas := TFPImageCanvas.Create(AImage);
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
    FCurrentDrawer.DrawToIntfImage(lCanvas, Self);
    ABmp.LoadFromIntfImage(AImage);
    // Second step of the drawing: LCL TCustomCanvas for easy font access
    FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self, FState);

    Canvas.Draw(0, 0, ABmp);
  finally
    if lCanvas <> nil then
      lCanvas.Free;
    if AImage <> nil then
      AImage.Free;
    ABmp.Free;
  end;
end;

{ TCDButtonDrawerGrad }

procedure TCDButtonDrawerGrad.SetClientRectPos(CDButton: TCDButton);
var
  lRect: TRect;
begin
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
  CDButton.AdjustClientRect(lRect);
end;

procedure TCDButtonDrawerGrad.DrawToIntfImage(ADest: TFPImageCanvas;
  CDButton: TCDButton);
begin

end;

procedure TCDButtonDrawerGrad.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
  FState: TBitmappedButtonState);
var
  TmpB: TBitmap;
  Str: string;
begin
  // Button shape -> This crashes in Gtk2
  TmpB := TBitmap.Create;
  TmpB.Width := CDButton.Width;
  TmpB.Height := CDButton.Height;
  TmpB.Canvas.Brush.Color := CDButton.Color;
  TmpB.Canvas.Brush.Style := bsSolid;
  TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
  //  CDButton.SetShape(TmpB);

  with TmpB.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := CDButton.Parent.Color;
    Pen.Color := Brush.Color;
    Rectangle(0, 0, Width, Height);
    FillRect(0, 0, Width, Height);
    Brush.Color := GetAColor(CDButton.Color, 90);
  end;

  // Button image
  case FState of
    bbsDown:
    begin
      DrawCDButtonDown(TmpB.Canvas, CDButton);
    end;
    bbsFocused:
      //GradientFill(GetUColor(CDButton.Color, 50), GetAColor(CDButton.Color, 60), TmpB.Canvas);
      GradientFill(clWhite, GetAColor(CDButton.Color, 96), TmpB.Canvas);
    else
      //GradientFill(GetUColor(CDButton.Color, 10), GetAColor(CDButton.Color, 20), TmpB.Canvas);
      GradientFill(clWhite, CDButton.Color, TmpB.Canvas);
  end;

  ADest.Draw(0, 0, TmpB);

  TmpB.Free;

  // Button text
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
  ADest.Font.Assign(CDButton.Font);
  ADest.Brush.Style := bsClear;
  ADest.Pen.Style := psSolid;
  Str := CDButton.Caption;
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
  {$endif}
end;

{ TCDButtonDrawerWinCE }

procedure TCDButtonDrawerWinCE.SetClientRectPos(CDButton: TCDButton);
var
  lRect: TRect;
begin
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
  CDButton.AdjustClientRect(lRect);
end;

procedure TCDButtonDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
  CDButton: TCDButton);
begin

end;

procedure TCDButtonDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
  FState: TBitmappedButtonState);
var
  TmpB: TBitmap;
  Str: string;
begin
  // Button shape -> This crashes in Gtk2
  TmpB := TBitmap.Create;
  TmpB.Width := CDButton.Width;
  TmpB.Height := CDButton.Height;
  TmpB.Canvas.Brush.Color := CDButton.Color;
  TmpB.Canvas.Brush.Style := bsSolid;
  TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
  //  CDButton.SetShape(TmpB);

  // Button image
  case FState of
    bbsDown:
    begin
      with TmpB.Canvas do
      begin
        Brush.Style := bsSolid;
        Brush.Color := GetAColor(CDButton.Color, 90);
        Pen.Color := clBlack;
        Pen.Style := psSolid;
        Rectangle(0, 0, Width, Height);
      end;
    end;
    bbsFocused:
      with TmpB.Canvas do
      begin
        Brush.Style := bsSolid;
        Brush.Color := GetAColor(CDButton.Color, 99);
        Pen.Color := clBlack;
        Pen.Style := psSolid;
        Rectangle(0, 0, Width, Height);
        Rectangle(1, 1, Width - 1, Height - 1); // The border is thicken when focused
      end;
    else
      with TmpB.Canvas do
      begin
        Brush.Style := bsSolid;
        Brush.Color := CDButton.Color;
        Pen.Color := clBlack;
        Pen.Style := psSolid;
        Rectangle(0, 0, Width, Height);
      end;
  end;

  ADest.Draw(0, 0, TmpB);

  TmpB.Free;

  // Button text
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
  ADest.Font.Assign(CDButton.Font);
  ADest.Brush.Style := bsClear;
  ADest.Pen.Style := psSolid;
  Str := CDButton.Caption;
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
  {$endif}
end;

procedure TCDButtonDrawerWin2k.SetClientRectPos(CDButton: TCDButton);
var
  lRect: TRect;
begin
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
  CDButton.AdjustClientRect(lRect);
end;

procedure TCDButtonDrawerWin2k.DrawToIntfImage(ADest: TFPImageCanvas;
  CDButton: TCDButton);
begin

end;

procedure TCDButtonDrawerWin2k.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
  FState: TBitmappedButtonState);
var
  TmpB: TBitmap;
  Str: string;
begin
  // Button shape -> This crashes in Gtk2
  TmpB := TBitmap.Create;
  TmpB.Width := CDButton.Width;
  TmpB.Height := CDButton.Height;
  TmpB.Canvas.Brush.Color := CDButton.Color;
  TmpB.Canvas.Brush.Style := bsSolid;
  TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);

  with TmpB.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := CDButton.Color;
    Pen.Color := clWhite;
    Pen.Style := psSolid;
    Rectangle(0, 0, Width - 1, Height - 1);
    Pen.Color := clWhite;
    Line(0, 0, Width - 1, 0);
    Line(0, 0, 0, Height - 1);
    Pen.Color := clGray;
    Line(0, Height - 1, Width - 1, Height - 1);
    Line(Width - 1, Height - 1, Width - 1, -1);
    Pen.Color := $0099A8AC;
    Line(1, Height - 2, Width - 2, Height - 2);
    Line(Width - 2, Height - 2, Width - 2, 0);
    Pen.Color := $00E2EFF1;
    Line(1, 1, Width - 2, 1);
    Line(1, 1, 1, Height - 2);
  end;

  // Button image
  case FState of
    bbsDown:
    begin
      with TmpB.Canvas do
      begin
        Brush.Style := bsSolid;
        Brush.Color := CDButton.Color;
        Pen.Color := clWhite;
        Pen.Style := psSolid;
        Rectangle(0, 0, Width - 1, Height - 1);
        Pen.Color := clGray;
        Line(0, 0, Width - 1, 0);
        Line(0, 0, 0, Height - 1);
        Pen.Color := clWhite;
        Line(0, Height - 1, Width - 1, Height - 1);
        Line(Width - 1, Height - 1, Width - 1, -1);
        Pen.Color := $00E2EFF1;
        Line(1, Height - 2, Width - 2, Height - 2);
        Line(Width - 2, Height - 2, Width - 2, 0);
        Pen.Color := $0099A8AC;
        Line(1, 1, Width - 2, 1);
        Line(1, 1, 1, Height - 2);
      end;
    end;
    bbsFocused:
      with TmpB.Canvas do
        DrawFocusRect(Rect(3, 3, Width - 4, Height - 4))
    else
    begin
    end;
  end;

  ADest.Draw(0, 0, TmpB);

  TmpB.Free;

  // Button text
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
  ADest.Font.Assign(CDButton.Font);
  ADest.Brush.Style := bsClear;
  ADest.Pen.Style := psSolid;
  Str := CDButton.Caption;
  if FState = bbsDown then
    ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2 + 1,
      (CDButton.Height - ADest.TextHeight(Str)) div 2 + 1, Str)
  else
    ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
      (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
  {$endif}
end;

procedure TCDButtonDrawerAndroid.SetClientRectPos(CDButton: TCDButton);
var
  lRect: TRect;
begin
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
  CDButton.AdjustClientRect(lRect);
end;

procedure TCDButtonDrawerAndroid.DrawToIntfImage(ADest: TFPImageCanvas;
  CDButton: TCDButton);
begin

end;

procedure TCDButtonDrawerAndroid.DrawToCanvas(ADest: TCanvas;
  CDButton: TCDButton; FState: TBitmappedButtonState);
var
  //TmpB: TBitmap;
  Str: string;
begin
  // Button shape -> This crashes in Gtk2
{  TmpB.Canvas.Brush.Color := CDButton.Color;
  TmpB.Canvas.Brush.Style := bsSolid;
  TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
  CDButton.SetShape(TmpB);
  ADest.Draw(0, 0, TmpB);
  TmpB.Free;
  }

  ADest.Brush.Color := CDButton.Parent.Color;
  ADest.Brush.Style := bsSolid;
  ADest.Pen.Color := ADest.Brush.Color;
  ADest.RecTangle(0, 0, CDButton.Width, CDButton.Height);

  // Button image
  case FState of
    bbsDown:
    begin
      DrawCDButtonDown(ADest, CDButton);
    end;
    bbsFocused:
    begin
      DrawAndroidButton(ADest, GetAColor(CDButton.Color, 98));
    end;
    else
      DrawAndroidButton(ADest, GetAColor(CDButton.Color, 96));
  end;

  // Button text
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
  ADest.Font.Assign(CDButton.Font);
  ADest.Brush.Style := bsClear;
  ADest.Pen.Style := psSolid;
  Str := CDButton.Caption;
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
  {$endif}
end;

procedure TCDButtonDrawerXPTB.SetClientRectPos(CDButton: TCDButton);
var
  lRect: TRect;
begin
  lRect := Rect(1, 1, CDButton.Width - 1, CDButton.Height - 1);
  CDButton.AdjustClientRect(lRect);
end;

procedure TCDButtonDrawerXPTB.DrawToIntfImage(ADest: TFPImageCanvas;
  CDButton: TCDButton);
begin

end;

procedure TCDButtonDrawerXPTB.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
  FState: TBitmappedButtonState);
var
  Str: string;
begin
  case FState of
    bbsDown:
    begin
      DrawCDButtonDown(ADest, CDButton);
    end;
    bbsFocused:
    begin
      DrawXPTaskbarButton(ADest, GetAColor(CDButton.Color, 98));
    end;
    else
      DrawXPTaskbarButton(ADest, CDButton.Color);
  end;

  // Button text
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
  ADest.Font.Assign(CDButton.Font);
  ADest.Brush.Style := bsClear;
  ADest.Pen.Style := psSolid;
  Str := CDButton.Caption;
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
  {$endif}
end;

{ TCDGroupBox }

procedure TCDGroupBox.PrepareCurrentDrawer();
begin
  case DrawStyle of
    dsWince: FCurrentDrawer := FDrawerWinCE;
    dsCustom: FCurrentDrawer := CustomDrawer;
  end;
end;

procedure TCDGroupBox.SetDrawStyle(const AValue: TCDDrawStyle);
begin
  if FDrawStyle = AValue then
    exit;
  FDrawStyle := AValue;

  Invalidate;

  PrepareCurrentDrawer();
  FCurrentDrawer.SetClientRectPos(Self);
end;

constructor TCDGroupBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 100;
  Height := 100;
  TabStop := False;
  FDrawerWinCE := TCDGroupBoxDrawerWinCE.Create;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csDoubleClicks, csReplicatable];
end;

destructor TCDGroupBox.Destroy;
begin
  inherited Destroy;
end;

procedure TCDGroupBox.EraseBackground(DC: HDC);
begin

end;

procedure TCDGroupBox.Paint;
var
  AImage: TLazIntfImage = nil;
  ABmp: TBitmap = nil;
  lCanvas: TFPImageCanvas = nil;
begin
  inherited Paint;

  PrepareCurrentDrawer();

  ABmp := TBitmap.Create;
  try
    ABmp.Width := Width;
    ABmp.Height := Height;
    AImage := ABmp.CreateIntfImage;
    lCanvas := TFPImageCanvas.Create(AImage);
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
    FCurrentDrawer.DrawToIntfImage(lCanvas, Self);
    ABmp.LoadFromIntfImage(AImage);
    // Second step of the drawing: LCL TCustomCanvas for easy font access
    FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self);
    Canvas.Draw(0, 0, ABmp);
  finally
    if lCanvas <> nil then
      lCanvas.Free;
    if AImage <> nil then
      AImage.Free;
    ABmp.Free;
  end;
end;

{ TCDGroupBoxDrawerWinCE }

procedure TCDGroupBoxDrawerWinCE.SetClientRectPos(CDGroupBox: TCDGroupBox);
var
  lRect: TRect;
  lCaptionHeight: integer;
begin
  lCaptionHeight := 10;
  lRect := Rect(1, lCaptionHeight, CDGroupBox.Width - 1, CDGroupBox.Height - 1);
  CDGroupBox.AdjustClientRect(lRect);
end;

procedure TCDGroupBoxDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
  CDGroupBox: TCDGroupBox);
{$ifdef CUSTOMDRAWN_USE_FREETYPE}
var
  AFont: TFreeTypeFont = nil;
{$endif}
begin
  FCaptionMiddle := CDGroupBox.Canvas.TextHeight('Ź') div 2;

  // Background
  if CDGroupBox.Parent = nil then
    ADest.Brush.FPColor := colLtGray
  else
    ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDGroupBox.Parent.Color));
  ADest.Brush.Style := bsSolid;
  ADest.Pen.Style := psClear;
  ADest.Rectangle(0, 0, CDGroupBox.Width, CDGroupBox.Height);

  // frame
  ADest.Pen.FPColor := colBlack;
  ADest.Pen.Style := psSolid;
  ADest.Brush.Style := bsClear;
  ADest.Rectangle(0, FCaptionMiddle, CDGroupBox.Width - 1, CDGroupBox.Height - 1);

  {$ifdef CUSTOMDRAWN_USE_FREETYPE}
  // Caption background and caption

  // initialize free type font manager
  opcftfont.InitEngine;
  //  FontMgr.SearchPath:='/usr/share/fonts/truetype/';
  AFont := TFreeTypeFont.Create;
  try
    // Text background
    ADest.Pen.Style := psClear;
    ADest.Brush.Style := bsSolid;
    // The brush color was already set previously and is already correct
    //    ADest.Rectangle(5, 0, AFont.GetTextWidth(CDGroupBox.Caption) + 5, 10);

    // paint text
    ADest.Pen.Style := psSolid;
    ADest.Brush.Style := bsClear;
    ADest.Font := AFont;
    ADest.Font.Name := 'Arial';
    ADest.Font.Size := 10;
    ADest.TextOut(5, 10, CDGroupBox.Caption);
  finally
    AFont.Free;
  end;
  {$endif}
end;

procedure TCDGroupBoxDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox);
begin
  {$ifndef CUSTOMDRAWN_USE_FREETYPE}
  if CDGroupBox.Parent = nil then
    ADest.Brush.Color := clLtGray
  else
    ADest.Brush.Color := ColorToRGB(CDGroupBox.Parent.Color);

  // paint text
  ADest.Pen.Style := psSolid;
  ADest.Brush.Style := bsSolid; // This will fill the text background
  ADest.Font.Size := 10;
  ADest.TextOut(FCaptionMiddle, 0, CDGroupBox.Caption);
  {$endif}
end;

{ TCDTrackBar }

procedure TCDTrackBar.SetMax(Value: integer);
begin
  if Value = FMax then
    Exit;
  FMax := Value;
  Invalidate;
end;

procedure TCDTrackBar.SetMin(Value: integer);
begin
  if Value = FMin then
    Exit;
  FMin := Value;
  Invalidate;
end;

procedure TCDTrackBar.SetPosition(Value: integer);
begin
  if Value = FPosition then
    Exit;
  FPosition := Value;
  Invalidate;
end;

procedure TCDTrackBar.Changed;
begin

end;

procedure TCDTrackBar.DoEnter;
begin
  inherited DoEnter;
end;

procedure TCDTrackBar.DoExit;
begin
  inherited DoExit;
end;

procedure TCDTrackBar.KeyDown(var Key: word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = 37) or (Key = 40) then
    Position := Position - (FMax - FMin) div 10;
  if (Key = 38) or (Key = 39) then
    Position := Position + (FMax - FMin) div 10;
  if Position > FMax then
    Position := FMax;
  if Position < FMin then
    Position := FMin;
end;

procedure TCDTrackBar.KeyUp(var Key: word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
end;

procedure TCDTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  SetFocus;
  FPosition := FMin + (X - 8) * (FMax - FMin + 1) div (Width - 14);
  if X > Width - 14 then
    FPosition := FMax;
  if X < 13 then
    FPosition := FMin;
  xPosition := X;
  if X > Width - 14 then
    xPosition := Width - 14;
  if X < 13 then
    xPosition := 13;
  invalidate;
  FMDown := True;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCDTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  FMDown := False;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TCDTrackBar.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  if FMDown then
  begin
    FPosition := FMin + (X - 8) * (FMax - FMin + 1) div (Width - 14);
    if X > Width - 14 then
      FPosition := FMax;
    if X < 13 then
      FPosition := FMin;
    xPosition := X;
    if X > Width - 14 then
      xPosition := Width - 14;
    if X < 13 then
      xPosition := 13;
    invalidate;
  end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TCDTrackBar.MouseEnter;
begin
  inherited MouseEnter;
end;

procedure TCDTrackBar.MouseLeave;
begin
  inherited MouseLeave;
end;

constructor TCDTrackBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Height := 25;
  Width := 100;
  FCurrentDrawer := TCDTrackBarDrawerGraph.Create;
  Color := clBtnFace;
  FMax := 100;
  FMin := 0;
  TabStop := True;
  FFromColor := clWhite;
  FToColor := clGray;
  FStepWidth := 11;
  TabStop := True;
  xPosition := 13;
  FAutoWidth := True;
end;

destructor TCDTrackBar.Destroy;
begin
  FCurrentDrawer.Free;
  inherited Destroy;
end;

procedure TCDTrackBar.EraseBackground(DC: HDC);
begin
  inherited EraseBackground(DC);
end;

procedure TCDTrackBar.Paint;
var
  AImage: TLazIntfImage = nil;
  ABmp: TBitmap = nil;
  lCanvas: TFPImageCanvas = nil;
begin
  inherited Paint;
  ABmp := TBitmap.Create;
  try
    ABmp.Width := Width;
    ABmp.Height := Height;
    AImage := ABmp.CreateIntfImage;
    lCanvas := TFPImageCanvas.Create(AImage);
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
    FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self, FFromColor,
      FToColor, FStepWidth);
    ABmp.LoadFromIntfImage(AImage);
    Canvas.Draw(0, 0, ABmp);
  finally
    if lCanvas <> nil then
      lCanvas.Free;
    if AImage <> nil then
      AImage.Free;
    ABmp.Free;
  end;
end;

procedure TCDTrackBar.SetFromColor(Value: TColor);
begin
  FFromColor := Value;
  invalidate;
end;

procedure TCDTrackBar.SetToColor(Value: TColor);
begin
  FToColor := Value;
  invalidate;
end;

procedure TCDTrackBar.SetStepWidth(Value: integer);
begin
  FStepWidth := Value;
  invalidate;
end;

{ TCDTrackBarDrawer }

procedure TCDTrackBarDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
  FPImg: TLazIntfImage; CDTrackBar: TCDTrackBar; FromColor, ToColor: TColor;
  pWidth: integer);
const CDBarEdge = 16;
var
  aStart, RNum, i, pStart, pEnd, pDelta: integer;
  dRect: TRect;
  TempB: TLazIntfImage;
  BCanvas: TFPImageCanvas;
  ABmp: TBitmap = nil;
begin
  if CDTrackBar.Max - CDTrackBar.Min <= 0 then
    Exit;
  RNum := CDTrackBar.Max - CDTrackBar.Min + 1;
  if CDTrackBar.AutoWidth then
    pWidth := (CDTrackBar.Width - CDBarEdge) div RNum;
  // Background
  if CDTrackBar.Parent = nil then
    ADest.Brush.FPColor := colLtGray
  else
    ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDTrackBar.Color));
  ADest.Brush.Style := bsSolid;
  ADest.Pen.Style := psClear;
  ADest.Rectangle(0, 0, CDTrackBar.Width, CDTrackBar.Height);
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
  //aStart := CDTrackBar.Height div 2 + 1;
  aStart := CDTrackBar.Height - 10;
  ADest.Pen.Style := psSolid;
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
  //ADest.Rectangle(0, aStart, CDTrackBar.Width, aStart);
  ADest.Line(0, aStart, CDTrackBar.Width, aStart);
  ADest.Line(3, aStart - 1, 6, aStart - 1);
  ADest.Line(5, aStart - 2, 6, aStart - 2);
  ADest.Line(3, aStart + 1, 6, aStart + 1);
  ADest.Line(5, aStart + 2, 6, aStart + 2);
  //pStart := ((CDTrackBar.Position - CDTrackBar.Min) * (CDTrackBar.Width - 32)) div
  //  (CDTrackBar.Max - CDTrackBar.Min) + 2;
  pStart := CDTrackBar.xPosition;
  ADest.Line(CDTrackBar.Width - 1 - 3, aStart - 1, CDTrackBar.Width - 1 - 6, aStart - 1);
  ADest.Line(CDTrackBar.Width - 1 - 5, aStart - 2, CDTrackBar.Width - 1 - 6, aStart - 2);
  ADest.Line(CDTrackBar.Width - 1 - 3, aStart + 1, CDTrackBar.Width - 1 - 6, aStart + 1);
  ADest.Line(CDTrackBar.Width - 1 - 5, aStart + 2, CDTrackBar.Width - 1 - 6, aStart + 2);
  {  ADest.Rectangle(pStart - 5, aStart + 1, pStart + 5, aStart + 6);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($005BA6C6));
  ADest.RecTangle(pStart - 5, aStart + 2, pStart + 5, aStart + 7);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
  ADest.RecTangle(pStart - 5, aStart, pStart + 5, aStart + 2);  }
  //RNum := (CDTrackBar.Width - 14) div pWidth;
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clGray));
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($00F0F0F0));
  ABmp := TBitmap.Create;
  ABmp.Width := CDTrackBar.Width;
  ABmp.Height := CDTrackBar.Height;
  TempB := ABmp.CreateIntfImage;
  //TempB := TLazIntfImage.Create(0, 0);
  //TempB.UsePalette := False;
  //TempB.Width := CDTrackBar.Width;
  //TempB.Height := CDTrackBar.Height;
  BCanvas := TFPImageCanvas.Create(TempB);
  //BCanvas.Brush.FPColor := TColorToFPColor(ColorToRGB(clRed));
  BCanvas.Brush.Style := bsSolid;
  //GradHFill(BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height),
  //  GetAColor(FromColor, 70 + i), GetAColor(ToColor, 90 + i));
  GradCenterFill(BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height),
    FromColor, ToColor, CDTrackBar.Position / RNum);
  pStart := 10 - 1;
  for i := 0 to RNum - 1 do
  begin
    ADest.Brush.Style := bsSolid;
    //  GradHFill(ADest, dRect, GetAColor(FromColor, 70 + i), GetAColor(ToColor, 90 + i));
    if aStart - 5 - i > 0 then
    begin
      {if i = RNum - 1 then
        pDelta := CDTrackBar.Width - (10 + i * pWidth + pWidth - 3) - 11
      else
        pDelta := 0;   }
      if i > RNum - (CDTrackBar.Width - CDBarEdge) mod pWidth then
        pDelta := 1
      else
        pDelta := 0;
      pEnd := pStart + pWidth - 3 + pDelta;
      dRect := Rect(pStart, aStart - 5 - i, pEnd, aStart - 1);
      //FPImgCloneRect(TempB, FPImg, Rect(10 + i * pWidth, aStart - 5 -
      //  i, 10 + i * pWidth + pWidth - 3 + pDelta, aStart - 1), False);
      FPImgCloneRect(TempB, FPImg, dRect, False);
      ADest.Brush.Style := bsClear;
      ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clGray));
      //ADest.RecTangle(10 + i * pWidth, aStart - 5 - i, 10 + i * pWidth +
      //  pWidth - 3 + pDelta, aStart - 1);
      ADest.RecTangle(dRect);
      if i = CDTrackBar.Position - CDTrackBar.Min then
      begin
        ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
        ADest.Brush.Style := bsSolid;
        ADest.Rectangle(pStart, aStart + 1, pStart + 10, aStart + 6);
        ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($005BA6C6));
        ADest.RecTangle(pStart, aStart + 2, pStart + 10, aStart + 7);
        ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
        ADest.RecTangle(pStart, aStart, pStart + 10, aStart + 2);
      end;
      //pStart := pStart + pWidth + pDelta - 1;
      pStart := pEnd + 1 + 2;
    end;
  end;
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($007BC6F6));
  ADest.Line(7, aStart - 1, CDTrackBar.Width - 8, aStart - 1);
  ADest.Line(7, aStart + 1, CDTrackBar.Width - 8, aStart + 1);
  ADest.Colors[2, aStart - 1] := ADest.Pen.FPColor;
  ADest.Colors[4, aStart - 2] := ADest.Pen.FPColor;
  ADest.Colors[2, aStart + 1] := ADest.Pen.FPColor;
  ADest.Colors[4, aStart + 2] := ADest.Pen.FPColor;
  ADest.Colors[6, aStart - 3] := ADest.Pen.FPColor;
  ADest.Colors[6, aStart + 3] := ADest.Pen.FPColor;
  ADest.Colors[CDTrackBar.Width - 1 - 2, aStart - 1] := ADest.Pen.FPColor;
  ADest.Colors[CDTrackBar.Width - 1 - 4, aStart - 2] := ADest.Pen.FPColor;
  ADest.Colors[CDTrackBar.Width - 1 - 2, aStart + 1] := ADest.Pen.FPColor;
  ADest.Colors[CDTrackBar.Width - 1 - 4, aStart + 2] := ADest.Pen.FPColor;
  ADest.Colors[CDTrackBar.Width - 1 - 6, aStart - 3] := ADest.Pen.FPColor;
  ADest.Colors[CDTrackBar.Width - 1 - 6, aStart + 3] := ADest.Pen.FPColor;
  //ADest.Draw(0,0,TempB);
  //ADest.CopyRect(0, 0, BCanvas, Rect(0, 0, CDTrackBar.Width, CDTrackBar.Height));
  //FPIMGCopyRect(TempB, FPImg, Rect(10, 10, CDTrackBar.Width - 11, CDTrackBar.Height - 11));
  BCanvas.Free;
  TempB.Free;
  ABmp.Free;
end;

{TCDTabControlItemList}

constructor TTabItem.Create(aCollection: TCollection);
begin
  inherited Create(ACollection);
  fImageIndex := -1;
end;

destructor TTabItem.Destroy;
begin
  inherited;
end;

procedure TTabItem.SetModified(Value: boolean);
begin
  if fModified <> Value then
  begin
    fModified := Value;
    DoChange;
  end;
end;

procedure TTabItem.SetSelected(Value: boolean);
var
  i: integer;
begin
  if FSelected <> Value then
  begin
    FSelected := Value;
    if FSelected then
    begin
      with (GetOwner as TTabItemList) do
      begin
        for i := 0 to Count - 1 do
        begin
          if (Items[i] <> Self) and (Items[i].Selected) then
          begin
            Items[i].Selected := False;
          end;
        end;
      end;
    end;
    (Collection as TTabItemList).DoSelected(Self, FSelected);
  end;
end;

function TTabItem.GetDisplayName: string;
begin
  {if FCaption <> '' then
    Result := FCaption
  else     }
  Result := inherited GetDisplayName;
end;

procedure TTabItem.DoChange;
begin
  (Collection as TTabItemList).DoChanged(Self);
end;

procedure TTabItem.SetTitle(Value: string);
begin
  if FTitle <> Value then
  begin
    FTitle := Value;
    //DoChange;
  end;
end;

procedure TTabItem.SetImageIndex(Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    DoChange;
  end;
end;

{ TTabItemList }

procedure TTabItemList.DoSelected(ATab: TTabItem; ASelected: boolean);
begin
  (GetOwner as TCDTabControl).TabSelected(ATab, ASelected);
end;

procedure TTabItemList.DoChanged(ATab: TTabItem);
begin
  (GetOwner as TCDTabControl).Invalidate;
end;

procedure TTabItemList.SetItem(Index: integer; Value: TTabItem);
begin
  inherited SetItem(Index, Value);
end;

function TTabItemList.GetItem(Index: integer): TTabItem;
begin
  Result := inherited GetItem(Index) as TTabItem;
end;

function TTabItemList.IndexOf(ATab: TTabItem): integer;
var
  i, c: integer;
begin
  c := Count;
  for i := 0 to c - 1 do
    if Items[i] = ATab then
    begin
      Result := i;
      Exit;
    end;
  Result := -1;
end;

function TTabItemList.Add: TTabItem;
begin
  Result := TTabItem(inherited add);
  Result.Title := 'Title' + IntToStr(Count - 1);
end;

{TCDTabControl}

constructor TCDTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := False;
  ParentColor := True;
  ParentFont := True;
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks,
    csDesignInteractive, csReplicatable];
  FCurrentDrawer := TCDTabControlDrawerGraph.Create;
  FTabs := TTabItemList.Create(TTabItem);
  Width := 200;
  Height := 28;
  FStartIndex := 0;
  MaskHeadBmp := TBitmap.Create;
end;

destructor TCDTabControl.Destroy;
begin
  MaskHeadBmp.Free;
  FCurrentDrawer.Free;
  inherited Destroy;
end;

procedure TCDTabControl.DrawCaptionBar(ADest: TCanvas; lRect: TRect; CL: TColor);
var
  aRect, bRect, cRect: TRect;
  i: integer;
  rWidth: integer;
  aText, bText: string;
  CornerColor: TFPColor;
  MaskColor: TColor;
begin
  aRect := lRect;
  ADest.Pen.Style := psSolid;
  ADest.Brush.Style := bsSolid;
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(CL));
  //TColorToFPColor(ColorToRGB($009C9B91));
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CL));
  aRect.Left := lRect.Left;
  aRect.Top := lRect.Top;
  aRect.Bottom := lRect.Bottom;
  aRect.Right := lRect.Right;
  ADest.RecTangle(lRect);
  MaskHeadBmp.Width := lRect.Right - lRect.Left;
  MaskHeadBmp.Height := lRect.Bottom - lRect.Top;
  MaskHeadBmp.Canvas.Brush.Style := bsSolid;
  MaskHeadBmp.Canvas.Pen.Style := psSolid;
  MaskHeadBmp.Canvas.Pen.Color := clWhite;
  MaskHeadBmp.Canvas.Brush.Color := MaskHeadBmp.Canvas.Pen.Color;
  MaskHeadBmp.Canvas.Rectangle(lRect);
  if FTabs.Count = 0 then
  begin
    ADest.RecTangle(aRect);
    Exit;
  end;
  aRect.Left := lRect.Left + 2;
  aRect.Top := lRect.Top + 3;
  //ADest.TextStyle.Opaque :=false;
  //SetBkMode(ADest.Handle, TRANSPARENT);
  if Brush.Style = bsSolid then
    SetBkMode(ADest.Handle, OPAQUE)
  else
    SetBkMode(ADest.Handle, TRANSPARENT);
  for i := StartIndex to FTabs.Count - 1 do
  begin
    aText := FTabs[i].Title;
    rWidth := (Height - ADest.TextHeight(aText)) + ADest.TextWidth(aText);
    FTabs[i].Width := rWidth;
    if aRect.Left + rWidth > lRect.Right - 6 then
      Break
    else
      aRect.Right := aRect.Left + rWidth;
    if TabIndex = i then
    begin
      cRect := aRect;
      if i = StartIndex then
        cRect.Left := aRect.Left - 2
      else
        cRect.Left := aRect.Left - 4;
      cRect.Right := aRect.Right + 4;
      cRect.Top := cRect.Top - 2;
      bText := FTabs[i].Title;
    end
    else
      DrawTabHead(aDest, aRect, Color, False);
    MaskColor := MaskBaseColor + i - StartIndex;
    DrawTabHeadMask(MaskHeadBmp.Canvas, aRect, MaskColor, False);
    ADest.TextOut(aRect.Left + (aRect.Right - aRect.Left - ADest.TextWidth(aText)) div 2,
      aRect.Top + (aRect.Bottom - aRect.Top - ADest.TextHeight(aText)) div 2, aText);
    aRect.Left := aRect.Right + 3;
  end;
  //ADest.Draw(0,0,MaskHeadBmp);           Exit;
  ADest.Line(lRect.Left, lRect.Bottom - 1, cRect.Left, lRect.Bottom - 1);
  ADest.Line(cRect.Right, lRect.Bottom - 1, lRect.Right, lRect.Bottom - 1);
  DrawTabHead(aDest, cRect, clWhite, True);
  ADest.TextOut(cRect.Left + (cRect.Right - cRect.Left - ADest.TextWidth(bText)) div 2,
    cRect.Top + (cRect.Bottom - cRect.Top - ADest.TextHeight(bText)) div 2, bText);
  if not CheckTabButton(lRect.Right - lRect.Left, FTabs) then
    Exit;
  aRect.Left := lRect.Right - RButtHeight * 2 - 3;
  aRect.Top := 1;
  aRect.Bottom := RButtHeight + 1;
  aRect.Right := lRect.Right - RButtHeight;
  if FMDownL then
    GradFill(ADest, aRect, $00F1A079, $00EFAF9B)
  else
    GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
  aRect.Left := lRect.Right - RButtHeight - 1;
  aRect.Top := 1;
  aRect.Bottom := RButtHeight + 1;
  aRect.Right := lRect.Right;
  if FMDownR then
    GradFill(ADest, aRect, $00F1A079, $00EFAF9B)
  else
    GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($0085614D));
  bRect.Top := 1;
  bRect.Left := lRect.Right - RButtHeight * 2 - 3;
  bRect.Right := lRect.Right;
  bRect.Bottom := RButtHeight + 1;
  DrawArrow(ADest, bRect, True);
  DrawArrow(ADest, bRect, False);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite));
  ADest.Line(lRect.Right - RButtHeight * 2 - 3, 1, lRect.Right, 1);
  ADest.Line(lRect.Right, 1, lRect.Right, RButtHeight + 1);
  ADest.Line(lRect.Right, RButtHeight + 1, lRect.Right - RButtHeight *
    2 - 3, RButtHeight + 1);
  ADest.Line(lRect.Right - RButtHeight * 2 - 3, RButtHeight + 1,
    lRect.Right - RButtHeight * 2 - 3, 1);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00E5BAA7));
  ADest.Brush.Style := bsClear;
  ADest.Rectangle(lRect.Right - RButtHeight * 2 - 2, 2, lRect.Right -
    1, RButtHeight + 1);
  CornerColor := TColorToFPColor(ColorToRGB($00F6E3D9));
  ADest.Colors[lRect.Right - RButtHeight * 2 - 2, 2] := CornerColor;
  ADest.Colors[lRect.Right - RButtHeight * 2 - 2, RButtHeight] := CornerColor;
  ADest.Colors[lRect.Right - 1, 2] := CornerColor;
  ADest.Colors[lRect.Right - 1, RButtHeight] := CornerColor;
end;

procedure TCDTabControl.GetThisTab(ATab: TTabItem);
var
  Start, Stop: integer;
begin
{  if Assigned(ATab) then
  begin
    Start := 0;
    Stop := Width - Height * 2;
    if FShowNewTab then
      Dec(Stop,  fEdgeWidth + 10);
    CalcTabPositions(Start, Stop, Canvas, ATab);
    Invalidate;
  end;    }
end;

procedure TCDTabControl.TabSelected(ATab: TTabItem; ASelected: boolean);
begin
  if ASelected then
  begin
    GetThisTab(ATab);
    fTabIndex := ATab.Index;
  end;
  if Assigned(fOnTabSelected) then
    fOnTabSelected(Self, ATab, ASelected);
end;

procedure TCDTabControl.SetStartIndex(Value: integer);
begin
  if (Value < -1) or (Value >= FTabs.Count) then
    Exit;
  FStartIndex := Value;
end;

procedure TCDTabControl.SetTabIndex(Value: integer);
var
  t: TTabItem;
begin
  if (Value < -1) or (Value >= FTabs.Count) then
    Exit;
  {if Value <> -1 then
  begin
    t := FTabs.Items[Value];
    t.Selected := True;
  end
  else
    ClearSelection;    }
  if Value > -1 then
    FTabIndex := Value;
end;

procedure TCDTabControl.ClearSelection;
var
  I: integer;
begin
  for I := 0 to FTabs.Count - 1 do
    FTabs[I].Selected := False;
end;

procedure TCDTabControl.Changed;
begin

end;

procedure TCDTabControl.DoEnter;
begin
  inherited DoEnter;
end;

procedure TCDTabControl.DoExit;
begin
  inherited DoExit;
end;

procedure TCDTabControl.KeyDown(var Key: word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
end;

procedure TCDTabControl.KeyUp(var Key: word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
end;

procedure TCDTabControl.SetMouseUP;
begin
  FMDownL := False;
  FMDownR := False;
end;

procedure TCDTabControl.DoLeftButtonDown;
begin
  if StartIndex > 0 then
    StartIndex := StartIndex - 1;
  invalidate;
end;

procedure TCDTabControl.DoRightButtonDown;
begin
  if StartIndex < FTabs.Count - 1 then
    StartIndex := StartIndex + 1;
  invalidate;
end;

procedure TCDTabControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  if (X > Width - RButtHeight * 2 - 2) and (X < Width - RButtHeight) then
  begin
    FMDownL := True;
    DoLeftButtonDown;
  end
  else
  if (X > Width - RButtHeight - 1) and (X < Width - 1) then
  begin
    FMDownR := True;
    DoRightButtonDown;
  end
  else
    SetMouseUP;
  if (Y < 3) or (Y > RButtHeight + 1) then
    SetMouseUP;
  if (Y < Height) and (Y > 0) and (X > 0) and (X < Width) then
    GetPageIndexFromXY(X, Y);
  invalidate;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCDTabControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  SetMouseUP;
  invalidate;
  inherited MouseUp(Button, Shift, X, Y);
end;

function TCDTabControl.GetPageIndexFromXY(x, y: integer): integer;
begin
  if MaskHeadBmp.Canvas.Pixels[x, y] = clWhite then
    Result := -1
  else
    Result := MaskHeadBmp.Canvas.Pixels[x, y] - MaskBaseColor + StartIndex;
  if (TabIndex <> Result) and (TabIndex > -1) then
    TabIndex := Result;
end;

procedure TCDTabControl.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  if (X > Width - RButtHeight * 2 - 2) and (X < Width - RButtHeight) then
    FMEnterL := True
  else
  if (X > Width - RButtHeight - 1) and (X < Width - 1) then
    FMEnterR := True
  else
  begin
    FMEnterR := False;
    FMEnterL := False;
  end;
  if (Y < 3) or (Y > 18) then
  begin
    FMEnterR := False;
    FMEnterL := False;
  end;
  if FMEnterR or FMENterL then
    invalidate;
  inherited MouseMove(Shift, X, Y);
end;

procedure TCDTabControl.Loaded;
begin
  inherited;
end;

procedure TCDTabControl.DoOnResize;
begin
  RButtHeight := Height - 4;
  inherited;
end;

procedure TCDTabControl.MouseEnter;
begin
  inherited MouseEnter;
end;

procedure TCDTabControl.MouseLeave;
begin
  inherited MouseLeave;
  SetMouseUP;
  invalidate;
end;

procedure TCDTabControl.EraseBackground(DC: HDC);
begin

end;

procedure TCDTabControl.Paint;
var
  AImage: TLazIntfImage = nil;
  ABmp: TBitmap = nil;
  lCanvas: TFPImageCanvas = nil;
begin
  inherited Paint;

  ABmp := TBitmap.Create;
  try
    ABmp.Width := Width;
    ABmp.Height := Height;
    AImage := ABmp.CreateIntfImage;
    lCanvas := TFPImageCanvas.Create(AImage);
    FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self);
    ABmp.LoadFromIntfImage(AImage);
    ABmp.Canvas.Font.Assign(Font);
    FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self);
    Canvas.Draw(0, 0, ABmp);
  finally
    if lCanvas <> nil then
      lCanvas.Free;
    if AImage <> nil then
      AImage.Free;
    ABmp.Free;
  end;
end;

procedure TCDTabControlDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
  FPImg: TLazIntfImage; CDTabControl: TCDTabControl);
begin
  ADest.Rectangle(0, 0, CDTabControl.Width - 1, CDTabControl.Height - 1);
end;

procedure TCDTabControlDrawerGraph.DrawToCanvas(ADest: TCanvas;
  CDTabControl: TCDTabControl);
begin
  //CDTabControl.DrawCaptionBar(ADest, Rect(0, 0, CDTabControl.Width -
  //  2, CDTabControl.Height + 1));
  //  ADest.Brush.Color := clRed;
  ADest.Rectangle(0, 0, CDTabControl.Width, CDTabControl.Height);
  CDTabControl.DrawCaptionBar(ADest, Rect(0, 0, CDTabControl.Width,
    CDTabControl.Height), CDTabControl.Color);
end;

{ TCDTabSheet }

constructor TCDTabSheet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //Parent := TCDPageControl(AOwner);
  TabStop := False;
  ParentColor := True;
  parentFont := True;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csDesignFixedBounds, csDoubleClicks, csDesignInteractive];
  //ControlStyle := ControlStyle + [csAcceptsControls, csDesignFixedBounds,
  //  csNoDesignVisible, csNoFocus];
  FCurrentDrawer := TCDTabSheetDrawerGraph.Create;
end;

destructor TCDTabSheet.Destroy;
begin
  FCurrentDrawer.Free;
  inherited Destroy;
end;

procedure TCDTabSheet.EraseBackground(DC: HDC);
begin

end;

procedure TCDTabSheet.Paint;
var
  AImage: TLazIntfImage = nil;
  ABmp: TBitmap = nil;
  lCanvas: TFPImageCanvas = nil;
begin
  inherited Paint;

  ABmp := TBitmap.Create;
  try
    ABmp.Width := Width;
    ABmp.Height := Height;
    AImage := ABmp.CreateIntfImage;
    lCanvas := TFPImageCanvas.Create(AImage);
    FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self);
    ABmp.LoadFromIntfImage(AImage);
    Canvas.Draw(0, 0, ABmp);
  finally
    if lCanvas <> nil then
      lCanvas.Free;
    if AImage <> nil then
      AImage.Free;
    ABmp.Free;
  end;
end;

procedure TCDTabSheetDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
  FPImg: TLazIntfImage; CDTabSheet: TCDTabSheet);
begin
  if TCDPageControl(CDTabSheet.Parent).Gradient then
    GradientFillRect(clWhite, GetUColor(CDTabSheet.Color, 96), ADest,
      Rect(0, 0, CDTabSheet.Width - 1, CDTabSheet.Height - 1))
  else
    ADest.Rectangle(0, 0, CDTabSheet.Width - 1, CDTabSheet.Height - 1);
end;

{ TCDPageControlEditor }

procedure TCDPageControlEditor.ShowPageMenuItemClick(Sender: TObject);
var
  AMenuItem: TMenuItem;
  NewPageIndex: integer;
begin
  AMenuItem := TMenuItem(Sender);
  if (AMenuItem = nil) or (not (AMenuItem is TMenuItem)) then
    exit;
  NewPageIndex := AMenuItem.MenuIndex;
  if (NewPageIndex < 0) or (NewPageIndex >= PControl.PageCount) then
    exit;
  PControl.PageIndex := NewPageIndex;
  GetDesigner.SelectOnlyThisComponent(PControl.Pages[PControl.PageIndex].TabPage);
end;

procedure TCDPageControlEditor.ExecuteVerb(Index: integer);
var
  NewPage: TCDTabSheet;
  Hook: TPropertyEditorHook;
  PageComponent: TPersistent;
  OldPage: longint;
begin
  if not GetHook(Hook) then
    exit;

  case Index of
    0:
    begin  //  New Page
      PControl.AddPage('');
      NewPage := PControl.ActivePage;
      Hook.PersistentAdded(NewPage, True);
      Designer.Modified;
      //Hook.PersistentAdded(NewPage,true);
      //Designer.Modified;
    end;
    1:
    begin // Insert Page
      PControl.InsertPage(PControl.PageIndex, '');
      Hook.PersistentAdded(PControl.ActivePage, True);
      Modified;
    end;
    2:
    begin  //  Delete Page
      with PControl do
      begin
        NewPage := ActivePage;
        if NewPage = nil then
          Exit;
        RemovePage(NewPage.Index);
      end;
    end;
    3:
    begin  //  Next Page
      PControl.ActivePage := PControl.FindNextPage(PControl.ActivePage, True, False);
    end;
    4:
    begin  //  Previous Page
      PControl.ActivePage := PControl.FindNextPage(PControl.ActivePage, False, False);
    end;
  end;
  Modified;
  if Designer <> nil then
    Designer.Modified;
  PControl.Invalidate;
end;

function TCDPageControlEditor.GetVerb(Index: integer): string;
begin
  case Index of
    0: Result := nbcesAddPage;
    1: Result := nbcesInsertPage;
    2: Result := nbcesDeletePage;
    3: Result := sNEXT_PAGE;
    4: Result := sPREV_PAGE;
    5: Result := nbcesShowPage;
  end;
end;

function TCDPageControlEditor.GetVerbCount: integer;
begin
  Result := 6;
end;

procedure TCDPageControlEditor.PrepareItem(Index: integer; const AnItem: TMenuItem);
begin
  inherited PrepareItem(Index, AnItem);
  case Index of
    0: ;
    1: AnItem.Enabled := PControl.PageIndex >= 0;
    2: AnItem.Enabled := PControl.PageIndex >= 0;
    3: AnItem.Enabled := PControl.PageIndex < PControl.PageCount - 1;
    4: AnItem.Enabled := PControl.PageIndex > 0;
    5: AddMenuItemsForPages(AnItem);
  end;
end;

procedure TCDPageControlEditor.AddMenuItemsForPages(ParentMenuItem: TMenuItem);
var
  i: integer;
  NewMenuItem: TMenuItem;
  TabPage: TCDTabSheet;
begin
  ParentMenuItem.Enabled := PControl.PageCount > 0;
  for i := 0 to PControl.PageCount - 1 do
  begin
    TabPage := PControl.Pages.Items[i].TabPage;
    NewMenuItem := TMenuItem.Create(ParentMenuItem);
    NewMenuItem.Name := 'ShowPage' + IntToStr(i);
    NewMenuItem.Caption := TabPage.Name + ' "' + TabPage.Caption + '"';
    NewMenuItem.OnClick := @ShowPageMenuItemClick;
    ParentMenuItem.Add(NewMenuItem);
  end;
end;

function TCDPageControlEditor.PControl: TCDPageControl;
begin
  if Component is TCDPageControl then
    Result := TCDPageControl(Component)
  else if Component is TCDTabSheet then
    Result := TCDPageControl(TCDTabSheet(Component).Parent);
end;

{ TCDPageControl }

procedure TCDPageControl.AddPage(S: string);
var
  NewPage: TCDTabSheet;
begin
  NewPage := TCDTabSheet.Create(Owner);
  NewPage.Parent := Self;
  //Name := Designer.CreateUniqueComponentName(ClassName);
  NewPage.Name := GetUniqueName(sTABSHEET_DEFAULT_NAME, Self.Owner);
  if S = '' then
    NewPage.Caption := NewPage.Name
  else
    NewPage.Caption := S;
  NewPage.SetBounds(1, CaptionHeight + 1, Width - 3, Height - CaptionHeight - 4);
  NewPage.BorderSpacing.Top := CaptionHeight + 2;
  NewPage.BorderSpacing.Left := 2;
  NewPage.BorderSpacing.Right := 3;
  NewPage.BorderSpacing.Bottom := 3;
  NewPage.Align := alClient;
  if ActivePage <> nil then
    ActivePage.Hide;
  ActivePage := NewPage;
  NewPage.Show;
  //FPages.AddObject(NewPage.Name, NewPage);
  FPages.Insert(FPages.Count);
  FPages.Items[FPages.Count - 1].DisplayName := NewPage.Name;
  FPages.Items[FPages.Count - 1].TabPage := NewPage;
  NewPage.Index := FPages.Count - 1;
  FPageIndex := FPages.Count - 1;
  //FPageCount := PageCount + 1;
end;

procedure TCDPageControl.InsertPage(aIndex: integer; S: string);
var
  NewPage: TCDTabSheet;
begin
  NewPage := TCDTabSheet.Create(Owner);
  NewPage.Parent := Self;
  //Name := Designer.CreateUniqueComponentName(ClassName);
  NewPage.Name := GetUniqueName(sTABSHEET_DEFAULT_NAME, Self.Owner);
  if S = '' then
    NewPage.Caption := NewPage.Name
  else
    NewPage.Caption := S;
  NewPage.SetBounds(1, CaptionHeight + 1, Width - 3, Height - CaptionHeight - 4);
  NewPage.BorderSpacing.Top := CaptionHeight + 2;
  NewPage.BorderSpacing.Left := 2;
  NewPage.BorderSpacing.Right := 3;
  NewPage.BorderSpacing.Bottom := 3;
  NewPage.Align := alClient;
  if ActivePage <> nil then
    ActivePage.Hide;
  ActivePage := NewPage;
  NewPage.Show;
  //FPages.AddObject(NewPage.Name, NewPage);
  FPages.Insert(aIndex);
  FPages.Items[aIndex].DisplayName := NewPage.Name;
  FPages.Items[aIndex].TabPage := NewPage;
  NewPage.Index := FPages.Count - 1;
  FPageIndex := aIndex;
  //FPageCount := PageCount + 1;
end;

procedure TCDPageControl.RemovePage(aIndex: integer);
begin
  if aIndex > 0 then
    PageIndex := aIndex - 1
  else
    Exit;
  {if not GetHook(Hook) then
    exit;
  PageComponent := TPersistent(NewPage);
  Hook.DeletePersistent(PageComponent);   }
  //if NewPage <> nil then
  //  NewPage.Free;
  Application.ReleaseComponent(FPages[aIndex].TabPage);
  //Owner.RemoveComponent(FPages[aIndex].TabPage);
  //FPages[aIndex].TabPage := nil;
  FPages.Delete(aIndex);
  //Owner.RemoveComponent(NewPage);
  //if PControl.PageCount > 1 then
  //  PControl.FPageCount := PControl.PageCount - 1;
end;

procedure TCDPageControl.PrepareCurrentDrawer();
begin
  case DrawStyle of
    dsWince: FCurrentDrawer := FDrawerWinCE;
    dsCustom: FCurrentDrawer := CustomDrawer;
  end;
end;

procedure TCDPageControl.SetDrawStyle(const AValue: TCDDrawStyle);
begin
  if FDrawStyle = AValue then
    exit;
  FDrawStyle := AValue;
  Invalidate;
  PrepareCurrentDrawer();
  FCurrentDrawer.SetClientRectPos(Self);
end;

function TCDPageControl.FindNextPage(CurPage: TCDTabSheet;
  GoForward, CheckTabVisible: boolean): TCDTabSheet;
var
  I, TempStartIndex: integer;
begin
  if FPages.Count <> 0 then
  begin
    //StartIndex := FPages.IndexOfObject(CurPage);
    TempStartIndex := CurPage.Index;
    if TempStartIndex = -1 then
      if GoForward then
        TempStartIndex := FPages.Count - 1
      else
        TempStartIndex := 0;
    I := TempStartIndex;
    repeat
      if GoForward then
      begin
        Inc(I);
        if I = FPages.Count then
          I := 0;
      end
      else
      begin
        if I = 0 then
          I := FPages.Count;
        Dec(I);
      end;
      Result := FPages[I].TabPage;
      if not CheckTabVisible or Result.Visible then
        Exit;
    until I = TempStartIndex;
  end;
  Result := nil;
end;

procedure TCDPageControl.SelectNextPage(GoForward: boolean;
  CheckTabVisible: boolean = True);
var
  Page: TCDTabSheet;
begin
  Page := FindNextPage(ActivePage, GoForward, CheckTabVisible);
  if (Page <> nil) and (Page <> ActivePage) then
    SetActivePage(Page);
end;

constructor TCDPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 232;
  Height := 184;
  TabStop := False;
  FDrawerWinCE := TCDPageControlDrawerWinCE.Create;
  FCaptionHeight := 28;
  ParentColor := True;
  parentFont := True;
  FGrad := True;
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks,
    csDesignInteractive];
  FPages := TTabItemList.Create(TTabItem);
  //FPageCount := 0;
  FShowTabs := True;
  RButtHeight := CaptionHeight - 4;
  FStartIndex := 0;
  MaskHeadBmp := TBitmap.Create;
end;

destructor TCDPageControl.Destroy;
begin
  MaskHeadBmp.Free;
  FPages.Free;
  inherited Destroy;
end;

procedure TCDPageControl.SetStartIndex(Value: integer);
begin
  if (Value < -1) or (Value >= FPages.Count) then
    Exit;
  FStartIndex := Value;
end;

procedure TCDPageControl.SetActivePage(Value: TCDTabSheet);
var
  i: integer;
begin
  for i := 0 to FPages.Count - 1 do
  begin
    if FPages[i].TabPage = Value then
    begin
      Value.Show;

      // Check first, Tab is Visible?
      StartIndex := i;
      FPageIndex := i;
    end
    else
      Value.Hide;
  end;
  FActivePage := Value;
  Value.BringToFront;
  Invalidate;
end;

procedure TCDPageControl.SetPageIndex(Value: integer);
begin
  if (Value > -1) and (Value < FPages.Count) then
  begin
    FPageIndex := Value;
    ActivePage := FPages[Value].TabPage;
    Invalidate;
  end;
end;

procedure TCDPageControl.EraseBackground(DC: HDC);
begin

end;

function TCDPageControl.GetPageIndexFromXY(x, y: integer): integer;
begin
  if MaskHeadBmp.Canvas.Pixels[x, y] = clWhite then
    Result := -1
  else
    Result := MaskHeadBmp.Canvas.Pixels[x, y] - MaskBaseColor + StartIndex;
  if (PageIndex <> Result) and (PageIndex > -1) then
    PageIndex := Result;
end;

procedure TCDPageControl.Paint;
var
  AImage: TLazIntfImage = nil;
  ABmp: TBitmap = nil;
  lCanvas: TFPImageCanvas = nil;
begin
  inherited Paint;

  PrepareCurrentDrawer();

  ABmp := TBitmap.Create;
  try
    ABmp.Width := Width;
    ABmp.Height := Height;
    AImage := ABmp.CreateIntfImage;
    lCanvas := TFPImageCanvas.Create(AImage);
    // First step of the drawing: FCL TFPCustomCanvas for fast pixel access
    FCurrentDrawer.DrawToIntfImage(lCanvas, AImage, Self);
    ABmp.LoadFromIntfImage(AImage);
    ABmp.Canvas.Font.Assign(Font);
    // Second step of the drawing: LCL TCustomCanvas for easy font access
    FCurrentDrawer.DrawToCanvas(ABmp.Canvas, Self);
    Canvas.Draw(0, 0, ABmp);
  finally
    if lCanvas <> nil then
      lCanvas.Free;
    if AImage <> nil then
      AImage.Free;
    ABmp.Free;
  end;
end;

procedure TCDPageControl.SetCaptionHeight(Value: integer);
begin
  FCaptionHeight := Value;
  RButtHeight := Value - 4;
  invalidate;
end;

procedure TCDPageControl.SetPageGradient(Value: boolean);
begin
  FGrad := Value;
  invalidate;
end;

procedure TCDPageControl.SetShowTabs(Value: boolean);
begin
  FShowTabs := Value;
  invalidate;
end;

procedure TCDPageControl.DrawCaptionBar(ADest: TCanvas; lRect: TRect; CL: TColor);
var
  aRect, bRect, cRect: TRect;
  i: integer;
  rWidth: integer;
  aText, bText: string;
  CornerColor: TFPColor;
  MaskColor: TColor;
begin
  aRect := lRect;
  ADest.Pen.Style := psSolid;
  ADest.Brush.Style := bsSolid;
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(CL));
  //TColorToFPColor(ColorToRGB($009C9B91));
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CL));
  aRect.Left := lRect.Left;
  aRect.Top := lRect.Top;
  aRect.Bottom := lRect.Bottom;
  aRect.Right := lRect.Right;
  ADest.RecTangle(lRect);
  MaskHeadBmp.Width := lRect.Right - lRect.Left;
  MaskHeadBmp.Height := lRect.Bottom - lRect.Top;
  MaskHeadBmp.Canvas.Brush.Style := bsSolid;
  MaskHeadBmp.Canvas.Pen.Style := psSolid;
  MaskHeadBmp.Canvas.Pen.Color := clWhite;
  MaskHeadBmp.Canvas.Brush.Color := MaskHeadBmp.Canvas.Pen.Color;
  MaskHeadBmp.Canvas.Rectangle(lRect);
  if FPages.Count = 0 then
  begin
    ADest.Brush.Color := clWhite;
    ADest.Pen.Color := $009C9B91;
    ADest.RecTangle(Rect(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 2));
    ADest.Pen.Color := clWhite;
    ADest.Line(aRect.Left + 1, aRect.Bottom + 1, aRect.Right, aRect.Bottom + 1);
    Exit;
  end;
  aRect.Left := lRect.Left + 2;
  aRect.Top := lRect.Top + 3;
  //ADest.TextStyle.Opaque :=false;
  //SetBkMode(ADest.Handle, TRANSPARENT);
  if Brush.Style = bsSolid then
    SetBkMode(ADest.Handle, OPAQUE)
  else
    SetBkMode(ADest.Handle, TRANSPARENT);
  for i := StartIndex to FPages.Count - 1 do
  begin
    aText := FPages[i].TabPage.Caption;
    rWidth := (CaptionHeight - ADest.TextHeight(aText)) + ADest.TextWidth(aText);
    FPages[i].Width := rWidth;
    if aRect.Left + rWidth > lRect.Right - 6 then
      Break
    else
      aRect.Right := aRect.Left + rWidth;
    if PageIndex = i then
    begin
      cRect := aRect;
      if i = StartIndex then
        cRect.Left := aRect.Left - 2
      else
        cRect.Left := aRect.Left - 4;
      cRect.Right := aRect.Right + 4;
      cRect.Top := cRect.Top - 2;
      bText := FPages[i].TabPage.Caption;
    end
    else
      DrawTabHead(aDest, aRect, Color, False);
    MaskColor := MaskBaseColor + i - StartIndex;
    DrawTabHeadMask(MaskHeadBmp.Canvas, aRect, MaskColor, False);
    ADest.TextOut(aRect.Left + (aRect.Right - aRect.Left - ADest.TextWidth(aText)) div 2,
      aRect.Top + (aRect.Bottom - aRect.Top - ADest.TextHeight(aText)) div 2, aText);
    aRect.Left := aRect.Right + 3;
  end;
  //ADest.Draw(0,0,MaskHeadBmp);           Exit;
  ADest.Line(lRect.Left, lRect.Bottom - 1, cRect.Left, lRect.Bottom - 1);
  ADest.Line(cRect.Right, lRect.Bottom - 1, lRect.Right, lRect.Bottom - 1);
  DrawTabHead(aDest, cRect, clWhite, True);
  ADest.TextOut(cRect.Left + (cRect.Right - cRect.Left - ADest.TextWidth(bText)) div 2,
    cRect.Top + (cRect.Bottom - cRect.Top - ADest.TextHeight(bText)) div 2, bText);
  if not CheckTabButton(lRect.Right - lRect.Left, FPages) then
    Exit;
  aRect.Left := lRect.Right - RButtHeight * 2 - 3;
  aRect.Top := 1;
  aRect.Bottom := RButtHeight + 1;
  aRect.Right := lRect.Right - RButtHeight;
  if FMDownL then
    GradFill(ADest, aRect, $00F1A079, $00EFAF9B)
  else
    GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
  aRect.Left := lRect.Right - RButtHeight - 1;
  aRect.Top := 1;
  aRect.Bottom := RButtHeight + 1;
  aRect.Right := lRect.Right;
  if FMDownR then
    GradFill(ADest, aRect, $00F1A079, $00EFAF9B)
  else
    GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($0085614D));
  bRect.Top := 1;
  bRect.Left := lRect.Right - RButtHeight * 2 - 3;
  bRect.Right := lRect.Right;
  bRect.Bottom := RButtHeight + 1;
  DrawArrow(ADest, bRect, True);
  DrawArrow(ADest, bRect, False);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite));
  ADest.Line(lRect.Right - RButtHeight * 2 - 3, 1, lRect.Right, 1);
  ADest.Line(lRect.Right, 1, lRect.Right, RButtHeight + 1);
  ADest.Line(lRect.Right, RButtHeight + 1, lRect.Right - RButtHeight *
    2 - 3, RButtHeight + 1);
  ADest.Line(lRect.Right - RButtHeight * 2 - 3, RButtHeight + 1,
    lRect.Right - RButtHeight * 2 - 3, 1);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00E5BAA7));
  ADest.Brush.Style := bsClear;
  ADest.Rectangle(lRect.Right - RButtHeight * 2 - 2, 2, lRect.Right -
    1, RButtHeight + 1);
  CornerColor := TColorToFPColor(ColorToRGB($00F6E3D9));
  ADest.Colors[lRect.Right - RButtHeight * 2 - 2, 2] := CornerColor;
  ADest.Colors[lRect.Right - RButtHeight * 2 - 2, RButtHeight] := CornerColor;
  ADest.Colors[lRect.Right - 1, 2] := CornerColor;
  ADest.Colors[lRect.Right - 1, RButtHeight] := CornerColor;
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite));
  ADest.Line(lRect.Right - 51, 1, lRect.Right, 1);
  ADest.Line(lRect.Right, 1, lRect.Right, 25);
  ADest.Line(lRect.Right, 25, lRect.Right - 51, 25);
  ADest.Line(lRect.Right - 51, 25, lRect.Right - 51, 1);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00FFFFFF));
  //ADest.Line();
end;

procedure TCDPageControl.SetCDPages(Value: TTabItemList);
begin
  FPages.Assign(Value);
end;

procedure TCDPageControl.DoOnResize;
begin
  if ActivePage <> nil then
  begin
    ActivePage.Left := 1;
    ActivePage.Top := CaptionHeight + 1;
    ActivePage.Width := Width - 3;
    ActivePage.Height := Height - CaptionHeight - 4;
    RButtHeight := CaptionHeight - 4;
  end;
  inherited;
end;

procedure TCDPageControl.UpdateAllDesignerFlags;
var
  i: integer;
begin
  for i := 0 to FPages.Count - 1 do
    UpdateDesignerFlags(i);
end;

procedure TCDPageControl.DoLeftButtonDown;
begin
  if StartIndex > 0 then
    StartIndex := StartIndex - 1;
  invalidate;
end;

procedure TCDPageControl.DoRightButtonDown;
begin
  if StartIndex < FPages.Count - 1 then
    StartIndex := StartIndex + 1;
  invalidate;
end;

procedure TCDPageControl.UpdateDesignerFlags(APageIndex: integer);
begin
  if APageIndex <> fPageIndex then
    FPages[APageIndex].TabPage.ControlStyle :=
      FPages[APageIndex].TabPage.ControlStyle + [csNoDesignVisible]
  else
    FPages[APageIndex].TabPage.ControlStyle :=
      FPages[APageIndex].TabPage.ControlStyle - [csNoDesignVisible];
end;

procedure TCDPageControl.SetMouseUP;
begin
  FMDownL := False;
  FMDownR := False;
end;

function TCDPageControl.GetPageCount: integer;
begin
  Result := FPages.Count;
end;

procedure TCDPageControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  if (X > Width - RButtHeight * 2 - 2) and (X < Width - RButtHeight) then
  begin
    FMDownL := True;
    DoLeftButtonDown;
  end
  else
  if (X > Width - RButtHeight - 1) and (X < Width - 1) then
  begin
    FMDownR := True;
    DoRightButtonDown;
  end
  else
    SetMouseUP;
  if (Y < 3) or (Y > RButtHeight + 1) then
    SetMouseUP;
  if (Y < CaptionHeight) and (Y > 0) and (X > 0) and (X < Width) then
    GetPageIndexFromXY(X, Y);
  invalidate;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCDPageControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  SetMouseUP;
  invalidate;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TCDPageControl.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  if (X > Width - RButtHeight * 2 - 2) and (X < Width - RButtHeight) then
    FMEnterL := True
  else
  if (X > Width - RButtHeight - 1) and (X < Width - 1) then
    FMEnterR := True
  else
  begin
    FMEnterR := False;
    FMEnterL := False;
  end;
  if (Y < 3) or (Y > 18) then
  begin
    FMEnterR := False;
    FMEnterL := False;
  end;
  if FMEnterR or FMENterL then
    invalidate;
  inherited MouseMove(Shift, X, Y);
end;

procedure TCDPageControl.Loaded;
begin
  inherited;
end;

procedure TCDPageControl.MouseEnter;
begin
  inherited MouseEnter;
end;

procedure TCDPageControl.MouseLeave;
begin
  inherited MouseLeave;
  SetMouseUP;
  invalidate;
end;

{ TCDPageControlDrawerWinCE }

procedure TCDPageControlDrawerWinCE.SetClientRectPos(CDPageControl: TCDPageControl);
var
  lRect: TRect;
  lCaptionHeight: integer;
begin
  lCaptionHeight := CDPageControl.CaptionHeight;
  lRect := Rect(10, lCaptionHeight + 1, CDPageControl.Width - 10,
    CDPageControl.Height - 1);
  CDPageControl.AdjustClientRect(lRect);
end;

procedure TCDPageControlDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
  FPImg: TLazIntfImage; CDPageControl: TCDPageControl);
begin
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDPageControl.Color));
  ADest.Brush.Style := bsSolid;
  ADest.Pen.Style := psClear;
  ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDPageControl.Color));
  ADest.Rectangle(0, 0, CDPageControl.Width, CDPageControl.Height);
  ADest.Font.Name := CDPageControl.Font.Name;
  ADest.Font.Size := CDPageControl.Font.Size;
  if CDPageControl.Gradient then
    GradientFillRect(clWhite, GetUColor(CDPageControl.Color, 96), ADest,
      Rect(0, CDPageControl.CaptionHeight, CDPageControl.Width, CDPageControl.Height))
  else
    ADest.Rectangle(0, CDPageControl.CaptionHeight, CDPageControl.Width,
      CDPageControl.Height);
  ADest.Colors[CDPageControl.Width - 1, CDPageControl.CaptionHeight] :=
    TColorToFPColor(ColorToRGB(CDPageControl.Color));
  // frame
  //ADest.Pen.FPColor := colBlack;
  ADest.Pen.Style := psSolid;
  ADest.Brush.Style := bsClear;
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($009C9B91));
  if CDPageControl.Pages.Count = 0 then
    ADest.Rectangle(0, 0, CDPageControl.Width - 2, CDPageControl.Height - 2)
  else
    ADest.Rectangle(0, CDPageControl.CaptionHeight, CDPageControl.Width -
      2, CDPageControl.Height - 2);
  ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00BFCED0));
  ADest.Line(CDPageControl.Width - 1, CDPageControl.CaptionHeight + 1,
    CDPageControl.Width - 1, CDPageControl.Height - 1);
  ADest.Line(CDPageControl.Width - 1, CDPageControl.Height - 1, 1,
    CDPageControl.Height - 1);
end;

procedure TCDPageControlDrawerWinCE.DrawToCanvas(ADest: TCanvas;
  CDPageControl: TCDPageControl);
begin
  CDPageControl.DrawCaptionBar(ADest, Rect(0, 0, CDPageControl.Width -
    2, CDPageControl.CaptionHeight + 1), CDPageControl.Color);
end;

end.