Advanced PageControl OwnerDraw

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, GraphUtil, StdCtrls;

const
  TCM_ADJUSTRECT = $1328;
type

  TTabSheet = class(comctrls.TTabSheet)
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  end;

  TPageControl = class(comctrls.TPageControl)
  protected
    procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
  end;

  TForm3 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    Button1: TButton;
    procedure PageControl1DrawTab(Control: TCustomTabControl; TabIndex: Integer;
      const Rect: TRect; Active: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
  Color: TColor;
  Rect: TRect;
  Rgn: HRGN;
begin
  if Assigned(OnDrawTab) then
  begin
    // magic numbers corresponding to where the OS draw the borders
    Rect := Message.DrawItemStruct.rcItem;
    if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
      Inc(Rect.Left, 2);
  //    Inc(Rect.Top, 1);
      Dec(Rect.Right, 2);
      Dec(Rect.Bottom, 3);
    end else begin
      Dec(Rect.Left, 2);
      Dec(Rect.Top, 2);
      Inc(Rect.Right, 2);
      Inc(Rect.Bottom);
    end;

    {if Rect.Right > Left + Width - 50 then
      Rect.Right := Left + Width - 50; }
    if Rect.Right > Left + Width - 44 then
      Rgn := CreateRectRgn(Rect.Left, Rect.Top, Left + Width - 44, Rect.Bottom + 10)
    else
      Rgn := 0;//CreateRectRgn(Rect.Left-1, Rect.Top, Rect.Right, Rect.Bottom);

    SelectClipRgn(Self.Canvas.Handle, Rgn);

    OnDrawTab(Self, Message.DrawItemStruct.itemID, Rect, Bool(Message.DrawItemStruct.itemState and ODS_SELECTED));

    DeleteObject(Rgn);

    // we want to clip the DC so that the borders to be drawn are out of region
    Rgn := CreateRectRgn(0, 0, 0, 0);
    SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
    DeleteObject(Rgn);

    Message.Result := 1;
  end;
  //inherited;
end;

procedure TForm3.PageControl1DrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  R: TRect;
begin
  Control.Canvas.Font.Color := clBlack;
  Control.Canvas.Font.Style := [];
  R := Rect;
  Inc(R.Bottom, 2);
  Inc(R.Left, -2);
  Control.Canvas.Brush.Style := bsClear;
  if Active then
    GradientFillCanvas(Control.Canvas, clWhite, clLtGray, R, gdVertical)
  else
    GradientFillCanvas(Control.Canvas, clLtGray, clGray, R, gdVertical);

  //Control.Canvas.RoundRect(R, 10, 10);
  Control.Canvas.Rectangle(R);
  R := Rect;
  Inc(R.Left, 6);
  DrawText(Control.Canvas.Handle, TPageControl(Control).Pages[TabIndex].Caption, -1, R, DT_SINGLELINE or DT_VCENTER);
  //Control.Canvas.FillRect(Rect);
  R.Left := R.Right - 20;
  R.Top  := R.Top + 4;
  R.Bottom := R.Top + 16;
  R.Right := R.Right - 4;
  //Control.Canvas.FillRect(R);
  GradientFillCanvas(Control.Canvas, clRed, $AA, R, gdVertical);
  Control.Canvas.Rectangle(R);
  Control.Canvas.Font.Color := clWhite;
  Control.Canvas.Font.Style := [fsBold];
  DrawText(Control.Canvas.Handle, 'X', 1, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

procedure TPageControl.TCMAdjustRect(var Msg: TMessage);
begin
  inherited;
  if Msg.WParam = 0 then
    InflateRect(PRect(Msg.LParam)^, 4, 4)
  else
    InflateRect(PRect(Msg.LParam)^, -4, -4);
end;

procedure TPageControl.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
begin
  Brush.Color := TPageControl(Parent).Color;
  Windows.FillRect(Msg.dc, ClientRect, Brush.Handle);
  //Rectangle(Msg.dc, ClientRect.Left, ClientRect.Top, ClientRect.Right, ClientRect.Bottom);
  Msg.Result := 1;
end;

{ TTabSheet }

procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
var
  C: TCAnvas;
begin
  C:= TCanvas.Create;
  C.Handle := Msg.DC;

  C.Refresh;
  C.Brush.Color := $777777;
  C.Rectangle(ClientRect.Left, ClientRect.Top - 20, ClientRect.Right, ClientRect.Bottom);
  {Brush.Color := clltgray;
  Brush.Style := bsSolid;
  SetDCBrushColor(Msg.dc, clRed);
  SetDCPenColor(Msg.dc, clRed);
  Windows.FillRect(Msg.dc, ClientRect, Brush.Handle);    }
  //Windows.Rectangle(Msg.dc, ClientRect.Left, ClientRect.Top, ClientRect.Right, ClientRect.Bottom);
  Msg.Result := 1;
  C.Free;
end;

end.