Déplacer un objet dans son parent - test de rencontre (collision)

Description

Les TShape se trouvant dans un TPanel peuvent être déplacés, dans cet exemple. Si un TShape rencontre un autre TShape, il le recouvre en se mettant au premier plan.

Pour répondre à une question posée sur le forum ici:
http://www.delphifr.com/forum.v2.aspx?rm=1&ID=444697

Contrairement à mon habitude, je n'ai pas trop commenté le code.
J'y reviendrai plus tard.

Mais en gros :

La procedure "Deplace(Control: TObject; X, Y: Integer)" s'applique à tout les contrôles.
La procedure "SiToucheRecouvre(Shape: TShape; X,Y: Integer)" n'est pas complètement optimisée à mon avis et gère actuellement les TShape.

Il y a d'autres approches, il s'agissait surtout de faire une démonstration de déplacement d'objets.


J'ai ajouté les commentaires détaillés dans Unit1.pas.
Je sais que certains n'aiment pas, mais il s'agit d'un code source à but didactique. ;-)
Ah oui, je n'ai pas renommé explicitement mes composants.
Mais ici, ça ne s'impose vraiment pas, à mon avis !

Bonne prog' :-p


Mise à jour du 3 mai 2005.

Correction du calcul de collision entre les shapes.
Le test de collision fonctionnait bien, mais l'approche était moins logique.

Désolé pour ceux qui ont déjà téléchargé.


3 mai 2005

Nouvelle (et dernière ?) mise à jour.
J'avais oublié de tenir compte de la Marge pour les valeurs empêchant la sortie à gauche et en haut.
La marge étant à 0 dans l'exemple, ça n'avait pas d'incidence sur le comportement.
De plus, on peut maintenant donner une valeur négative à cette marge...

Source / Exemple :


procedure Deplace(Control: TObject; X, Y: Integer);
const Marge: ShortInt = 0;  // Marge éventuelle (étendue: -128..127)
var
  ControlPos, MousePos: TPoint;
  DiffX, DiffY: Integer;
  XMax, YMax: Integer;
  XMin, YMin: Integer;
  Application.ProcessMessages;
  GetCursorPos(MousePos);
  with Control as TControl do
  begin
    XMax := Parent.Width - Width - Marge;
    YMax := Parent.Height - Height - Marge;
    XMin := 0 + Marge;
    YMin := 0 + Marge;
    Windows.ScreenToClient(Parent.Handle, MousePos);
    DiffX := MousePos.X - Left;
    DiffY := MousePos.Y - Top;
    while DragDetect(Parent.Handle, ControlPos) do
    begin
      GetCursorPos(MousePos);
      Windows.ScreenToClient(Parent.Handle, MousePos);
      Left := MousePos.X - DiffX;
      if Left < XMin then
        Left := XMin
      else if Left > XMax then
        Left := XMax;
      Top := MousePos.Y - DiffY;
      if Top < YMin then
        Top := YMin
      else if Top > YMax then
        Top := YMax;
      Application.ProcessMessages;
    end;
  end;
end;

Conclusion :


Compilable au moins à partir de D4

Codes Sources

A voir également

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.