1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
|
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Extctrls;
type Tpaintbox32=class(TPaintbox)
public
buffer:Tbitmap;
constructor create(aowner:Tcomponent);override;
destructor destroy;override;
end;
type Tmonbutton=class(Tbutton)
public
dessin:Tpaintbox32;
procedure projette;
procedure dim(w,h,x,y:integer);
constructor create(aowner:Tcomponent);override;
destructor destroy;override;
end;
type
TForm1 = class(TForm)
Timer1: TTimer;
PaintBox1: TPaintBox;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
dx:integer;
monbutton:Tmonbutton;
procedure dessiner(sender:Tobject);
procedure monclick(sender:Tobject);
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor Tpaintbox32.create(aowner:Tcomponent);
begin
inherited;
buffer:=Tbitmap.Create;
end;
destructor TPaintbox32.Destroy;
begin
buffer.Free;
inherited;
end;
constructor Tmonbutton.create(aowner:Tcomponent);
begin
inherited;
dessin:=Tpaintbox32.Create(self);
dessin.parent:=self;
dessin.Align:=alclient;
end;
procedure Tmonbutton.dim(w,h,x,y:integer);
begin
width:=w;
height:=h;
left:=x;
top:=y;
dessin.buffer.Width:=clientwidth;
dessin.buffer.Height:=clientheight;
end;
destructor Tmonbutton.Destroy;
begin
dessin.Destroy;
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
monbutton:=Tmonbutton.Create(self);
monbutton.Parent:=self;
monbutton.dim(250,100,10,10);
monbutton.dessin.OnPaint:=dessiner;
monbutton.dessin.OnClick:=monclick;
Timer1.Interval:=20;
end;
procedure Tform1.dessiner(sender:Tobject);
var text:string;
begin
inc(dx);
with monbutton.dessin.buffer.canvas do
begin
brush.Color:=clblack;
fillrect(monbutton.clientrect);
brush.Color:=clcream;
fillrect(rect(10,10,240,90));
brush.style:=bsclear;
Font.size:=25;
if dx=240 then dx:=10;
text:='pressez le bouton';
textout(dx,50-textheight(text) div 2,text);
end;
monbutton.projette;
end;
procedure Tmonbutton.projette;
begin
dessin.Canvas.Draw(0,0,dessin.buffer);
end;
procedure Tform1.monclick(sender:Tobject);
begin
caption:='ça marche';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
dessiner(nil);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
monbutton.Destroy;
end;
end. |
Partager