Création de composant : modifier une sous propriete à partir d'une autre [Résolu]

cs_orelien 137 Messages postés dimanche 7 juillet 2002Date d'inscription 11 janvier 2009 Dernière intervention - 24 sept. 2008 à 16:16 - Dernière réponse : Bacterius 3869 Messages postés samedi 22 décembre 2007Date d'inscription 3 juin 2016 Dernière intervention
- 25 sept. 2008 à 17:02
Bonjour,

J'ai crée un composant héritant de TGraphicControl :

unit Circle;


interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs, Math;


type
  TIntPoint = class(TPersistent)
  private
    FX : Integer;
    FY : Integer;
  protected
  public
    constructor Create(AOwner : TPersistent);
    destructor Destroy; override;
    procedure Assign(Source : TPersistent); override;


    procedure SetFX(Value : Integer);
    procedure SetFY(Value : Integer);
  published
    property X : Integer read FX write SetFX;
    property Y : Integer read FY write SetFY;
  end;


  TPosition = class(TPersistent)
  private
    FPosition1    : TIntPoint;
    FPosition2 : TIntPoint;
    FPosition3  : TIntPoint;
  protected
  public
    constructor Create(AOwner : TPersistent);
    destructor Destroy; override;
    procedure Assign(Source : TPersistent); override;
  published
    property Position1 : TIntPoint read FPosition1 write FPosition1;
    property Position2 : TIntPoint read FPosition2 write FPosition2;
    property Position3 : TIntPoint read FPosition3 write FPosition3;
  end;


  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;


  FPosition1 := TIntPoint.Create(Self);
  FPosition2 := TIntPoint.Create(Self);
  FPosition3 := TIntPoint.Create(Self);
end;


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.

Si quelqu'un peut m'aider...

Merci
Orélien.
Afficher la suite 

Votre réponse

9 réponses

Meilleure réponse
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 24 sept. 2008 à 22:50
3
Merci
unit Circle;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs, Math;

type
  TIntPoint = class(TPersistent)
  private
    fXY       : TPoint;
    fOnChange : TNotifyEvent;
  private
    procedure SetPnt(Pnt: TPoint);
    procedure SetXY(index: integer; Value : Integer);
    function GetXY(index: integer): integer;
  protected
    procedure Change; virtual;
    procedure AssignTo(Dest : TPersistent); override;
  protected
    property OnChange : TNotifyEvent read fOnChange write fOnChange;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
  published
    property X : Integer index 0 read GetXY write SetXY default 0;
    property Y : Integer index 1 read GetXY write SetXY default 0;
  public
    property Point : TPoint read fXY write SetPnt;
  public
    constructor Create; virtual;
  end;

  TPosition = class(TPersistent)
  private
    fUpdateCount : integer;
    fPoints      : array[0..2] of TIntPoint;
    fOnChange    : TNotifyEvent;
  private
    function GetPoint(index: integer): TIntPoint;
    procedure SetPoint(index: integer; value: TIntPoint);
  protected
    procedure DoPointChange(Sender: TObject); virtual;
    procedure Change; virtual;
    procedure AssignTo(Dest : TPersistent); override;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
  protected
    property OnChange : TNotifyEvent read fOnChange write fOnChange;
  published
    property Position1 : TIntPoint index 0 read GetPoint write SetPoint;
    property Position2 : TIntPoint index 1 read GetPoint write SetPoint;
    property Position3 : TIntPoint index 2 read GetPoint write SetPoint;
  public
    procedure BeginUpdate;
    procedure EndUpdate;
    function Updated : boolean;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  TCircle = class(TGraphicControl)
  private
    fPosition : TPosition;
    fOnChange : TNotifyEvent;
    procedure SetPosition(value: TPosition);
  protected
    procedure Paint; override;
    procedure DoPositionChange(Sender: TObject);
    procedure Change; virtual;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Position : TPosition read fPosition write SetPosition;
    property OnChange : TNotifyEvent read fOnChange write fOnChange;
  end;

procedure Register;

implementation

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;

constructor TIntPoint.Create;
begin
  inherited Create;
  fXY.X := 0;
  fXY.Y := 0;
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;

procedure TPosition.LoadFromStream(Stream: TStream);
begin
  Stream.Read(fPoints[0].fXY, SizeOf(TPoint));
  Stream.Read(fPoints[1].fXY, SizeOf(TPoint));
  Stream.Read(fPoints[2].fXY, SizeOf(TPoint));
  Change;
end;

procedure TPosition.SaveToStream(Stream: TStream);
begin
  Stream.Write(fPoints[0].fXY, SizeOf(TPoint));
  Stream.Write(fPoints[1].fXY, SizeOf(TPoint));
  Stream.Write(fPoints[2].fXY, SizeOf(TPoint));
end;

procedure TPosition.SetPoint(index: integer; value: TIntPoint);
begin
  Value.AssignTo(fPoints[index]);
end;

function TPosition.Updated: boolean;
begin
  result := fUpdateCount <> 0;
end;

{ TCircle }

constructor TCircle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fPosition          := TPosition.Create;
  fPosition.OnChange := DoPositionChange;
end;

destructor TCircle.Destroy;
begin
  fPosition.Free;
  inherited Destroy;
end;

procedure TCircle.Change;
begin
  if assigned(fOnChange) then
    fOnChange(Self);
  Invalidate;
end;

procedure TCircle.DoPositionChange(Sender: TObject);
begin
  Change;
end;

procedure TCircle.Paint;
begin
  with Canvas do
  begin
    Ellipse(ClipRect);
  end;
end;

procedure TCircle.SetPosition(value: TPosition);
begin
  value.AssignTo(fPosition);
end;

end.






<hr size="2" width="100%" />

Merci f0xi 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 69 internautes ce mois-ci

Commenter la réponse de f0xi
Bacterius 3869 Messages postés samedi 22 décembre 2007Date d'inscription 3 juin 2016 Dernière intervention - 24 sept. 2008 à 16:26
0
Merci
"property Position1 : TIntPoint read FPosition1 write FPosition1;
property Position2 : TIntPoint read FPosition2 write FPosition2;
property Position3 : TIntPoint read FPosition3 write FPosition3;"

Il est possible de fixer des méthodes à l'affectation d'une valeur (notamment pour empecher d'entrer une fausse valeur.

Par exemple :

property Position1 : TIntPoint read FPosition1 write SetPosition1;

procedure SetPosition1;
begin
FPosition2 := FPosition1;
end;

Ou un truc dans le genre.

Il y a un bon tutorial sur la création de composants en Delphi sur Phidels.
Voilà le lien, si tu veux le lire :

http://www.phidels.com/php/index.php3?page=composan/propriet.htm

Cordialement, Bacterius !
Commenter la réponse de Bacterius
cs_orelien 137 Messages postés dimanche 7 juillet 2002Date d'inscription 11 janvier 2009 Dernière intervention - 24 sept. 2008 à 20:07
0
Merci
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 ?

Merci
Orélien.
Commenter la réponse de cs_orelien
Bacterius 3869 Messages postés samedi 22 décembre 2007Date d'inscription 3 juin 2016 Dernière intervention - 24 sept. 2008 à 20:18
0
Merci
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 !
Commenter la réponse de Bacterius
cs_orelien 137 Messages postés dimanche 7 juillet 2002Date d'inscription 11 janvier 2009 Dernière intervention - 24 sept. 2008 à 20:30
0
Merci
Je viens encore de faire le test, et l'appel à cette méthode ne se fait ni à la conception, ni à l'execution lorsque je modifie Position1.X.

Cdlt
Orélien.
Commenter la réponse de cs_orelien
cs_orelien 137 Messages postés dimanche 7 juillet 2002Date d'inscription 11 janvier 2009 Dernière intervention - 25 sept. 2008 à 01:34
0
Merci
Bonsoir,

Merci de la réponse, ça à l'air de fonctionner.

Néanmoins, n'existe t'il pas une solution un peu plus simple pour le même résultat ? Cela me semble un peu compliqué quand même...

Merci

Orélien.
Commenter la réponse de cs_orelien
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 25 sept. 2008 à 03:55
0
Merci
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é).

<hr size="2" width="100%" />
Commenter la réponse de f0xi
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 25 sept. 2008 à 04:12
0
Merci
mais on peu faire ceci : fusionner tout ...

type
  TCircle = class(TGraphicControl)
  private
    fXYs : array[0..5] of integer;
    fUpdateCount : integer;
    fOnChange : TNotifyEvent;
    procedure SetPos(index: integer; value: integer);
    function GetPos(index: integer): integer;
  protected
    procedure Paint; override;
    procedure AssignTo(Dest: TPersistent); override;
    procedure Change; virtual;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
  published
    property X1 : integer index 0 read GetPos write SetPos default 0;
    property Y1 : integer index 1 read GetPos write SetPos default 0;
    property X2 : integer index 2 read GetPos write SetPos default 0;
    property Y2 : integer index 3 read GetPos write SetPos default 0;
    property X3 : integer index 4 read GetPos write SetPos default 0;
    property Y3 : integer index 5 read GetPos write SetPos default 0;
    property OnChange : TNotifyEvent read fOnChange write fOnChange;
  public
    procedure BeginUpdate;
    procedure EndUpdate;
    constructor Create(AOwner: TComponent); override;
  end;

{ TCircle }

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;

<hr size="2" width="100%" />
Commenter la réponse de f0xi
Bacterius 3869 Messages postés samedi 22 décembre 2007Date d'inscription 3 juin 2016 Dernière intervention - 25 sept. 2008 à 17:02
0
Merci
Le guide du concepteur de composants ? Il est dans ma chambre ! ^^
C'est un bon livre il m'a donné pas mal d'idées ...

Cordialement, Bacterius !
Commenter la réponse de Bacterius

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.