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
| unit line;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
Tline = class(TGraphicControl)
private
{ Déclarations privées }
fpen:Tpen;
Fbrush:Tbrush;
src:Tpoint; //source
dest:Tpoint; //destination
protected
{ Déclarations protégées }
public
{ Déclarations publiques }
constructor create(aowner:Tcomponent);override;
procedure identifier(source,destination:Tpoint);
procedure setbrush(value:Tbrush);
procedure setpen(value:Tpen);
procedure paint;override;
destructor destroy;override;
property source:Tpoint read src write src;
property destination:Tpoint read dest write dest;
published
{ Déclarations publiées }
property pen:Tpen read fpen write setpen;
property brush:Tbrush read Fbrush write setbrush;
procedure stylechanged(sender:Tobject);
end;
procedure Register;
implementation
constructor Tline.create(aowner:Tcomponent);
begin
inherited create(aowner);
width:=30;
height:=30;
src.x:=0;
src.y:=0;
dest.x:=width;
dest.y:=height;
fpen:=Tpen.create;
fpen.onchange:=stylechanged;
fbrush:=Tbrush.create;
fbrush.onchange:=stylechanged;
end;
procedure Tline.setpen(value:Tpen);
begin
fpen.assign(value);
end;
procedure Tline.setbrush(value:Tbrush);
begin
Fbrush.assign(value);
end;
procedure Tline.paint;
begin
with canvas do
begin
pen:=Fpen;
brush:=Fbrush;
moveto(src.x,src.y);
lineto(dest.x,dest.y);
end;
end;
procedure Tline.stylechanged(sender:Tobject);
begin
invalidate;
end;
procedure Tline.identifier(source,destination:Tpoint);
begin
src:=source;
dest:=destination;
end;
destructor Tline.destroy;
begin
fpen.free;
fbrush.free;
inherited destroy;
end;
procedure Register;
begin
RegisterComponents('Reseaux', [Tline]);
end;
end. |
Partager