TCircle = class(TGraphicControl)
private
{ Private declarations }
FPosition : TPosition;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
{ Published declarations }
property Position : TPosition read FPosition write FPosition;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TCircle]);
end;
{ TIntPoint }
procedure TIntPoint.Assign(Source: TPersistent);
begin
if Source is TIntPoint then
with TIntPoint(Source) do
begin
Self.X := X;
Self.Y := Y;
end
else
inherited; //raises an exception
end;
constructor TIntPoint.Create(AOwner : TPersistent);
begin
inherited Create;
X := 0;
Y := 0;
end;
destructor TIntPoint.Destroy;
begin
inherited;
end;
procedure TIntPoint.SetFX(Value : Integer);
begin
Self.FX := Value;
end;
procedure TIntPoint.SetFY(Value : Integer);
begin
Self.FY := Value;
end;
{ TPosition }
procedure TPosition.Assign(Source: TPersistent);
begin
if Source is TPosition then
with TPosition(Source) do
begin
Self.Position1 := Position1;
Self.Position2 := Position2;
Self.Position3 := Position3;
end
else
inherited;
end;
constructor TPosition.Create(AOwner : TPersistent);
begin
inherited Create;
destructor TPosition.Destroy;
begin
inherited;
FPosition1.Free;
FPosition2.Free;
FPosition3.Free;
end;
{ TCircle }
constructor TCircle.Create(AOwner: TComponent);
begin
inherited;
FPosition := TPosition.Create(Self);
end;
destructor TCircle.Destroy;
begin
FPosition.Free;
inherited;
end;
procedure TCircle.Paint;
begin
Self.Canvas.Ellipse(Self.Canvas.ClipRect);
end;
end.
J'aimerais par exemple que la modification de la propriete "position#2" entraine la modification des autres proprietes "positions#X". De manière générale, je n'arrive pas à lier les sous propriétés ou sous sous propriétés entres elles.
procedure Register;
begin
RegisterComponents('Standard', [TCircle]);
end;
{ TIntPoint }
procedure TIntPoint.AssignTo(Dest: TPersistent);
begin
if Dest is TIntPoint then
with TIntPoint(Dest) do
begin
fXY := Self.fXY;
Change;
end
else
inherited;
end;
procedure TIntPoint.Change;
begin
if assigned(fOnChange) then
fOnChange(Self);
end;
function TIntPoint.GetXY(index: integer): integer;
begin
case index of
0 : result := fXY.X;
1 : result := fXY.Y;
end;
end;
procedure TIntPoint.SetXY(index: integer; Value : Integer);
var ptr : ^integer;
begin
case index of
0 : ptr := @fXY.X;
1 : ptr := @fXY.Y;
end;
if value <> ptr^ then
begin
ptr^ := value;
change;
end;
end;
procedure TIntPoint.LoadFromStream(Stream: TStream);
begin
Stream.Read(fXY, SizeOf(TPoint));
Change;
end;
procedure TIntPoint.SaveToStream(Stream: TStream);
begin
Stream.Write(fXY, SizeOf(TPoint));
end;
procedure TIntPoint.SetPnt(Pnt: TPoint);
begin
if (Pnt.X <> fXY.X) or (Pnt.Y <> fXY.Y) then
begin
fXY := Pnt;
change;
end;
end;
{ TPosition }
constructor TPosition.Create;
var N : integer;
begin
inherited Create;
for N := low(fPoints) to High(fPoints) do
begin
fPoints[N] := TIntPoint.Create;
fPoints[N].OnChange := DoPointChange;
end;
fUpdateCount := 0;
end;
destructor TPosition.Destroy;
var N : integer;
begin
for N := High(fPoints) downto low(fPoints) do
fPoints[N].Free;
inherited;
end;
procedure TPosition.DoPointChange(Sender: TObject);
begin
Change;
end;
procedure TPosition.AssignTo(Dest: TPersistent);
begin
if Dest is TPosition then
with TPosition(Dest) do
begin
fPoints := Self.fPoints;
Change;
end
else
inherited;
end;
procedure TPosition.BeginUpdate;
begin
Inc(fUpdateCount);
end;
procedure TPosition.EndUpdate;
begin
Dec(fUpdateCount);
if fUpdateCount = 0 then
Change;
end;
procedure TPosition.Change;
begin
if fUpdateCount <> 0 then
exit;
if Assigned(fOnChange) then
fOnChange(Self);
end;
function TPosition.GetPoint(index: integer): TIntPoint;
begin
result := fPoints[index];
end;
cs_orelien
Messages postés137Date d'inscriptiondimanche 7 juillet 2002StatutMembreDernière intervention11 janvier 2009 24 sept. 2008 à 20:07
Merci de ta réponse !
En fait, j'avais déjà essayé cela, mais je n'arrivais pas à l'appeler.
Ce que j'aimerais, c'est que à la modification de la valeur X (integer), la methode setposition1 correspondante soit appelée.
Est-ce possible ?
Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 201610 24 sept. 2008 à 20:18
Je pense qu'à la modification de Position1.X, SetPosition1 est appelé de toute façon.
Après tu vérifies quelle valeur a changé, et tu fais tes restrictions.
Cordialement, Bacterius !
Vous n’avez pas trouvé la réponse que vous recherchez ?
f0xi
Messages postés4205Date d'inscriptionsamedi 16 octobre 2004StatutModérateurDernière intervention12 mars 202235 25 sept. 2008 à 03:55
si le développement de composants (ou de programmes) été simple, tout le monde en ferait.
ici on aurait pus faire un peu plus simple, en fusionnant TPosition avec TIntPoint par exemple.
mais cela nécessiterai de créer un PropertyEditor pour le type TPoint ce qui serait tout autant voir plus complexe pour l'installation du composant.
Pour avoir faire rouler une voiture, il ne sagit pas d'avoir que des roues et un moteur.
il faut des freins, un volant, un reservoir de carburant, un chassis etc.
surtout que si tu veux que des objets sachent "jouer" en harmonie, il faut atteindre un certain degré de complexité. c'est une condition sine qua non.
le guide du concepteur de composant (copyright Borland) ne fait pas 166 pages de 14 chapitres pour rien (et ce n'est qu'un condensé).
constructor TCircle.Create(AOwner: TComponent);
var N : integer;
begin
inherited;
for N := 0 to high(fXYs) do
fXYs[N] := 0;
end;
procedure TCircle.AssignTo(Dest: TPersistent);
begin
if Dest is TCircle then
with TCircle(Dest) do
begin
fXYs := Self.fXYs;
Change;
end
else
inherited AssignTo(Dest);
end;
procedure TCircle.Paint;
begin
with Canvas do
begin
{ paint here }
MoveTo(fXYs[0], fXYs[1]);
LineTo(fXYs[2], fXYs[3]);
LineTo(fXYs[4], fXYs[5]);
LineTo(fXYs[0], fXYs[1]);
end;
end;
procedure TCircle.Change;
begin
if fUpdateCount = 0 then
exit;
if Assigned(fOnChange) then
fOnChange(Self);
invalidate;
end;
function TCircle.GetPos(index: integer): integer;
begin
result := fXYs[index];
end;
procedure TCircle.SetPos(index, value: integer);
var ptr : ^integer;
begin
ptr := @fXYs[index];
if value <> ptr^ then
begin
ptr^ := value;
change;
end;
end;
procedure TCircle.LoadFromStream(Stream: TStream);
begin
Stream.Read(fXYs, 24);
end;
procedure TCircle.SaveToStream(Stream: TStream);
begin
Stream.Write(fXYs, 24);
end;
procedure TCircle.BeginUpdate;
begin
inc(fUpdateCount);
end;
procedure TCircle.EndUpdate;
begin
dec(fUpdateCount);
if fUpdateCount = 0 then
Change;
end;