Sujet Précédent Sujet Suivant

Création de composant : modifier une sous propriete à partir d'une autre

Résolu
cs_orelien Messages postés 137 Date d'inscription dimanche 7 juillet 2002 Statut Membre Dernière intervention 11 janvier 2009 - 24 sept. 2008 à 16:16
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 - 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.

9 réponses

Réponse 1 / 9
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 35
24 sept. 2008 à 22:50
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%" />
3
Réponse 2 / 9
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 10
24 sept. 2008 à 16:26
"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 !
0
Réponse 3 / 9
cs_orelien Messages postés 137 Date d'inscription dimanche 7 juillet 2002 Statut Membre Dernière intervention 11 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 ?

Merci
Orélien.
0
Réponse 4 / 9
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 10
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 !
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 9
cs_orelien Messages postés 137 Date d'inscription dimanche 7 juillet 2002 Statut Membre Dernière intervention 11 janvier 2009
24 sept. 2008 à 20:30
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.
0
Réponse 6 / 9
cs_orelien Messages postés 137 Date d'inscription dimanche 7 juillet 2002 Statut Membre Dernière intervention 11 janvier 2009
25 sept. 2008 à 01:34
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.
0
Réponse 7 / 9
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 35
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é).

<hr size="2" width="100%" />
0
Réponse 8 / 9
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 35
25 sept. 2008 à 04:12
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%" />
0
Réponse 9 / 9
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 10
25 sept. 2008 à 17:02
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 !
0

Discussions similaires

Utilisation de douchette et creation des codes barres VB6
INFORMATIQUE01 -
INFORMATIQUE01 -

3 réponses
création automatique de documents dans word
luckluck -
fabrice69 -

1 réponse
800A01AD - Un composant activex ne peut pas créer un objet
VBScript37 -
wassim.azzouzi -

9 réponses
Diagramme de Gantt
umale -
umale -

5 réponses
Créer PDF a partir de 2 images jpg
cs_niko14 -
niko14 -

2 réponses
Rejoignez-nous