unit MyPageControl;
{$mode objfpc}{$H+}
interface
uses
Windows, Classes, SysUtils, LResources, Forms, Controls,
Graphics, Dialogs, ComCtrls;
type
{ TMyPageControl }
TMyPageControl = class(TPageControl)
private
ImagesIndex: integer;
procedure SetImagesIndex(AValue: integer);
const
btnSize = 14;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer); override;
procedure PaintWindow(DC: HDC); override;
published
property ImagesCloseIndex: integer read ImagesIndex write SetImagesIndex default 0;
end;
procedure Register;
implementation
procedure Register;
begin
{$I mypagecontrol_icon.lrs}
RegisterComponents('Common Controls', [TMyPageControl]);
end;
{ TMyPageControl }
//properties ImageIndex
procedure TMyPageControl.SetImagesIndex(AValue: integer);
begin
ImagesIndex := AValue;
Refresh;
end;
//Close MouseDown
procedure TMyPageControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
var
R: TRect;
begin
inherited MouseDown(Button, Shift, X, Y);
if Assigned(Images) then
begin
if Button = mbLeft then
begin
R := TabRect(ActivePageIndex);
if PtInRect(Classes.Rect(R.Right - btnSize - 5, R.Top + 4,
R.Right - 5, R.Top + btnSize + 4), Classes.Point(X, Y)) then
begin
ActivePage.Free;
end;
end;
end;
end;
//Page Close img
procedure TMyPageControl.PaintWindow(DC: HDC);
var
i: integer;
R: TRect;
bm: TBitmap;
begin
inherited PaintWindow(DC);
if Assigned(Images) then
begin
bm := TBitmap.Create;
try
bm.SetSize(16, 16);
Images.GetBitmap(ImagesCloseIndex, bm);
for i := 0 to Pred(PageCount) do
begin
R := TabRect(i);
StretchBlt(DC, R.Right - btnSize - 4, R.Top + 2,
btnSize, btnSize, bm.Canvas.Handle, 0, 0, 16, 16, cmSrcCopy);
end;
finally
bm.Free;
end;
end;
end;
end.