Это простая кнопка, которая показывает точечный рисунок DOOROPEN.bmp, когда мышь нажата, иначе отображает DOORCLOSED.bmp. Только создайте файл ресурса с именем MyCloseBtn.res с двумя кнопками по имени CLOSE (DOORCLOSED.bmp) и OPEN (DOOROPEN.bmp)
unit MyCloseBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Buttons;
const
STR_CLOSEBTN = 'CLOSE';
STR_OPENBTN = 'OPEN';
type
TMyCloseBtn = class(TSpeedButton)
private
procedure MyMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MyMouseUp(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
protected
public
constructor Create(AOwner: TComponent); override;
published
end;
procedure Register;
implementation
{$R *.res}
procedure Register;
begin
RegisterComponents('Samples', [TMyCloseBtn]);
end;
{ TMyCloseBtn }
constructor TMyCloseBtn.Create(AOwner: TComponent);
begin
inherited;
Self.NumGlyphs := 2;
OnMouseUp := MyMouseUp;
OnMouseDown := MyMouseDown;
if (csDesigning in ComponentState) then
begin
Flat := true;
Caption := 'CLOSE';
Width := 55;
Height := 45;
Layout := blGlyphTop;
end
else
begin
Glyph.LoadFromResourceName(HInstance , STR_CLOSEBTN);
invalidate;
end;
end;
procedure TMyCloseBtn.MyMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Glyph.LoadFromResourceName(HInstance , STR_OPENBTN);
invalidate;
end;
procedure TMyCloseBtn.MyMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Glyph.LoadFromResourceName(HInstance , STR_CLOSEBTN);
invalidate;
end;
end.
Комментарии