Delphi OwnerDraw PageControl customization - delphi

Question

I am having one project with a OwnerDraw PageControl. I need to customize it as follows:
So I have written the following codes:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;
type
TPageControl = class(Vcl.ComCtrls.TPageControl)
protected
procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TPageControl.CNDrawItem(var Message: TWMDrawItem);
var
Color: TColor;
Rect: TRect;
Rgn: HRGN;
SaveIndex: Integer;
Caption:string;
Size :TSize;
x,y :integer;
begin
Color := clBlack;
case Message.DrawItemStruct.itemID of
0: Color := $008000FF;
1: Color := $00FF0080;
2: Color := $00408000;
end;
SetDCBrushColor(Message.DrawItemStruct.hDC, Color);
SelectClipRgn(Message.DrawItemStruct.hDC, 0);
Rect := Message.DrawItemStruct.rcItem;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
Inc(Rect.Left, 2);
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;
FillRect(Message.DrawItemStruct.hDC, Rect, GetStockObject(DC_BRUSH));
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
DeleteObject(Rgn);
with Message.DrawItemStruct^ do
begin
SaveIndex := SaveDC(hDC);
Canvas.Lock;
try
Canvas.Handle:=hDC;
Canvas.Font :=Font;
Canvas.Brush :=Brush;
Caption:=Self.Tabs.Strings[ItemID];
Size:=Canvas.TextExtent(Caption);
x:=rcItem.Left+(rcItem.Right-rcItem.Left-Size.cx) div 2;
y:=rcItem.Top +(rcItem.Bottom-rcItem.Top-Size.cy) div 2+1;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then dec(y);
Canvas.TextRect(rcItem,x,y,Caption);
finally
Canvas.Handle := 0;
Canvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Message.Result := 1;
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.Ctl3D:=False;
end;
end.
But after compiling I am getting it as follows:
How to solve the problem?
My requirement is as follows:
1. 3D border should be removed from PageControl.
2. Form Background color should be removed from PageControl.
3. Selected Tab Color and Height should be different.
4. TabSheet Background should be customizable.
After that I have tried the following codes:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;
type
TPageControl = class(Vcl.ComCtrls.TPageControl)
private
{ Private procedure }
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
protected
{ protected procedure }
procedure WndProc(var Message:TMessage); override;
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public procedure }
published
{ published procedure }
end;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TPageControl.WndProc(var Message:TMessage);
begin
if Message.Msg=TCM_ADJUSTRECT then
begin
Inherited WndProc(Message);
if Fborder=bsNone then
begin
PRect(Message.LParam)^.Left:=0;
PRect(Message.LParam)^.Right:=ClientWidth;
PRect(Message.LParam)^.Top:=PRect(Message.LParam)^.Top-4;
PRect(Message.LParam)^.Bottom:=ClientHeight;
end;
end
else
Inherited WndProc(Message);
end;
procedure TPageControl.CNDrawItem(var Message: TWMDrawItem);
var
Color: TColor;
Rect: TRect;
Rgn: HRGN;
SaveIndex: Integer;
Caption:string;
Size :TSize;
x,y :integer;
begin
Color := 0;
case Message.DrawItemStruct.itemID of
0: Color := $008000FF;
1: Color := $00FF0080;
2: Color := $00408000;
end;
SetDCBrushColor(Message.DrawItemStruct.hDC, Color);
SelectClipRgn(Message.DrawItemStruct.hDC, 0);
Rect := Message.DrawItemStruct.rcItem;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
Inc(Rect.Left, 2);
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;
FillRect(Message.DrawItemStruct.hDC, Rect, GetStockObject(DC_BRUSH));
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
DeleteObject(Rgn);
with Message.DrawItemStruct^ do
begin
SaveIndex := SaveDC(hDC);
Canvas.Lock;
try
Canvas.Handle:=hDC;
Canvas.Font :=Font;
Canvas.Brush :=Brush;
Caption:=Self.Tabs.Strings[ItemID];
Size:=Canvas.TextExtent(Caption);
x:=rcItem.Left+(rcItem.Right-rcItem.Left-Size.cx) div 2;
y:=rcItem.Top +(rcItem.Bottom-rcItem.Top-Size.cy) div 2+1;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then dec(y);
Canvas.TextRect(rcItem,x,y,Caption);
finally
Canvas.Handle := 0;
Canvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Message.Result := 1;
inherited;
end;
procedure TPageControl.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style:=Params.Style or TCS_OWNERDRAWFIXED;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.Ctl3D:=False;
end;
end.
But it is not compiling.

Answer 1

Just in case someone comes across this old question, TCM_ADJUSTRECT and TCS_OWNERDRAWFIXED are defined in Winapi.CommCtrl. TPageControl, nor any of its ancestors, have a Border property or a FBorder member. If you feel that you need one, you should create a new control by deriving from either TCustomTabControl or TPageControl.