unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes , SysUtils , Forms , Controls , Graphics , Dialogs , ComCtrls , Windows , LCLType;
type
TPageControl = class(ComCtrls.TPageControl)
private
procedure CNDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
type
{ TForm1 }
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TPageControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
if not (csDesigning in ComponentState) then
Style := Style or TCS_OWNERDRAWFIXED;
end;
end;
procedure TPageControl.CNDrawItem(var Message: TWMDrawItem);
var
FontHandle: HFONT;
FontColor: COLORREF;
FontObject: TLogFont;
BrushColor: COLORREF;
BrushHandle: HBRUSH;
begin
with Message.DrawItemStruct^ do
begin
BrushColor := ColorToRGB(clBtnFace);
GetObject(Font.Handle, SizeOf(FontObject), @FontObject);
if itemID <> Self.TabIndex then
begin
FontObject.lfWeight := FW_BOLD;
FontObject.lfItalic := 0;
end
else
begin
FontObject.lfWeight := FW_NORMAL;
FontObject.lfItalic := 1;
end;
FontColor := clBlack;
BrushHandle := CreateSolidBrush(BrushColor);
FillRect(hDC, rcItem, BrushHandle);
FontHandle := CreateFontIndirect(FontObject);
try
SelectObject(hDC, FontHandle);
SetTextColor(hDC, FontColor);
SetBkMode(hDC, TRANSPARENT);
DrawTextEx(hDC, PChar(Page[itemID].Caption), -1, rcItem, DT_CENTER or
DT_VCENTER or DT_SINGLELINE, nil);
finally
DeleteObject(FontHandle);
end;
end;
Message.Result := 1;
end;
end.
Recent
