unit MyButton;
interface
uses
Classes,
Vcl.Controls,
Windows,
Vcl.Graphics,
Messages,
Vcl.ExtCtrls,
Vcl.Buttons,
Vcl.StdCtrls;
type
TTiButton = class;
TMyButton = class(TCustomControl)
private
FOneButton: TTiButton;
FTwoButton: TTiButton;
FFocusedButton: TTiButton;
FOnUpClick: TNotifyEvent;
FOnDownClick: TNotifyEvent;
FSelected: Boolean;
FCaption: String;
function CreateButton: TTiButton;
procedure SetFocusBtn (Btn: TTiButton);
procedure BtnClick(Sender: TObject);
procedure SetCaption(Val: String);
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure MEnter(var Mes: TMessage); message CM_MOUSEENTER;
procedure MLeave(var Mes: TMessage); message CM_MOUSELEAVE;
procedure WMPaint(var msg:TWMPaint);message WM_Paint;protected
public
constructor Create(AOwner: TComponent); override;
property Caption: String read FCaption write SetCaption;
published
property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
end;
TTBtnState = set of (tbFocusRect, tbAllowTimer);
TTiButton = class(TCustomControl)
private
FCanvas: TCanvas;
FRepeatTimer: TTimer;
FTimeBtnState: TTBtnState;
protected
procedure Paint; override;
public
property canvas: tcanvas read fcanvas;
property TimeBtnState: TTBtnState read FTimeBtnState write FTimeBtnState;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('TMyButton', [TMyButton]);
end;
constructor TMyButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent := AOwner as TWinControl;
FOneButton := CreateButton;
FTwoButton := CreateButton;
Width := 100;
Height := 100;
end;
function TMyButton.CreateButton: TTiButton;
begin
Result := TTiButton.Create(Self);
Result.OnClick := BtnClick;
Result.Visible := True;
Result.Enabled := True;
Result.Parent := Self;
end;
procedure TMyButton.BtnClick(Sender: TObject);
begin
if Sender = FOneButton then
begin
if Assigned(FOnUpClick) then FOnUpClick(Self);
end
else
if Assigned(FOnDownClick) then FOnDownClick(Self);
end;
procedure TMyButton.WMPaint(var msg:TWMPaint);
var
FormRgn:hrgn;
begin
inherited;
FormRgn := CreateRoundRectRgn(1, 1, Width - 1,
height - 1, width, height);
SetWindowRgn(Handle, FormRgn, TRUE);
end;
procedure TMyButton.SetCaption(Val: string);
begin
FCaption := Val;
paint;
end;
procedure TMyButton.WMSetFocus(var Message: TWMSetFocus);
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
FFocusedButton.Invalidate;
end;
procedure TMyButton.WMKillFocus(var Message: TWMKillFocus);
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
FFocusedButton.Invalidate;
end;
procedure TMyButton.SetFocusBtn (Btn: TTiButton);
begin
if TabStop and CanFocus and (Btn <> FFocusedButton) then
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
FFocusedButton := Btn;
if (GetFocus = Handle) then
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
Invalidate;
end;
end;
end;
procedure TTiButton.Paint;
var
R: TRect;
dc: HDC;
Rgn, ResultRgn: HRGN;
begin
inherited Paint;
if tbFocusRect in FTimeBtnState then
begin
R := Bounds(0, 0, Width, Height);
InflateRect(R, -3, -3);
OffsetRect(R, 1, 1);
DrawFocusRect(Handle, R);
begin
ResultRgn := CreateRectRgn(0, 0, 0, 0);
Rgn :=Canvas.pie(0,0,200,200,200,0,0,0);//выдаёт здесь
CombineRgn(ResultRgn, ResultRgn, Rgn, RGN_OR);
// Создание новой формы
dc := GetDC(TTiButton.Handle);
SetWindowRgn(Handle, ResultRgn, false);
ReleaseDC(Handle, dc);
DeleteDC(dc);
end;
end;
end;
procedure TMyButton.MEnter(var Mes: TMessage);
begin
FSelected := True;
Paint;
end;
procedure TMyButton.MLeave(var Mes: TMessage);
begin
FSelected := False;
Paint;
end;
end.