Discussion :

[lefju cabro]

Bonjour,

Dans mon application, je cherche à connecter des objets (panels ou shapes dans l'idéal) entre eux.

Dans une TForm, l'utilisateur dessine des schémas de machines complexes à l'aide de formes simples (cercle, rectangle...). L'utilisateur choisit sa forme en cliquant sur le bouton puis dessine la forme sur le canvas de la TForm. Je souhaite que les formes soient connectées entre elles et j'aimerais savoir comment le rendre visible graphiquement. Je détaille: j'ai 1 cercle et 1 rectangle qui ne sont pas connectés, je peux les déplacer indépendamment.
--> Mon but est de les connecter visuellement: avec la souris, je rapproche le cercle du rectangle et hop le cercle et le rectangle se collent pour former une forme. Cette alors cette forme qui se déplace. Évidemment je dois pouvoir délier le cercle du rectangle.

Je ne sais pas du tout par quel bout prendre ce bazar. Je ne sais même pas comment nommer cette fonction de "coller" 2 composants (j'ai regardé "dock" mais c'est pour les TForm). Est-ce que des propriétés/événements du TPanel, TShape, TadvPanel (TMS) permettent de faire cela ?


Mes outils de dev:
- XE5
- VCL Delphi
- VCL TMS Component Pack.

Merci pour vos conseils et bonne fin d'année à vous

LefjuCabro

[foetus]

Snap to - aimanter

Comment coder cette fonctionnalité?

Je commencerais par faire un voisinage qui va dépendre de la forme (*) et tester si un objet est dans ce voisinage.
Si un objet est dans un voisinage on le colle (**).

* -> par exemple: un cercle de rayon R, le voisinage serait compris entre une distance de R et (R + a)

** -> Il faut voir ce qui est le plus joli. Peut-être le coller en cherchant la plus petite distance entre les 2 formes

[lefju cabro]

Bonjour Foetus,

Merci pour ta réponse.

Je comprends comment coder cette fonctionnalité mais je bloque.

Dans mon exemple, j'ai posé sur une forme 3 TPanel, je souhaite les déplacer à la souris et les aimanter lorsqu'ils sont proches. Pour déplacer les Panels, j'utilise le code ci-dessous dans le MouseDown des TPanels:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DragMove = $F012 ;
begin
  ReleaseCapture ;
  TPanel(Sender).Perform (WM_SysCommand, SC_DragMove, 0) ;
end;

Dans l'évènement MouseUp des TPanels, je code la fonction qui teste et aimante si nécessaire. Le problème est que l'évènement MouseUp ne se lance pas... Quelle erreur je fais ? Comment déplacer des TPanels (sachant que ces Panels contiendront ensuite des TImage) autrement ?

[foetus]

Tu confonds les évènements :-)

L'évènement OnMouseUp est appelé lorsque tu relaches le bouton de la souris.

http://docwiki.embarcadero.com/Libra...ol.OnMouseMove

C'est l'évènement OnMouseMove qui permet de faire des actions lorsqu'on déplace la souris.

OnMouseDown -> OnMouseMove -> OnMouseUp

D'ailleurs cela serait mieux de tester quel bouton de la souris est appuyé et éventuellement si aucune touche est appuyée.

[lefju cabro]

J'ai placé mon code de déplacement dans le MouseDown puis sur le MouseMove (suite à tes conseils) mais j'ai toujours le même problème qui est que l'évènement MouseUp ne s'exécute pas.

Mon évènement pour déplacer le TPanel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
procedure TForm1.Panel1MouseMove(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DragMove = $F012 ;
begin
  ReleaseCapture ;
  TPanel(Sender).Perform (WM_SysCommand, SC_DragMove, 0) ;
end;

Si je clique sur le Panel sans le déplacer alors l'évènement MouseUp s'exécute. C'est un peu dommage car c'est sur le MouseUp que je veux tester si je dois aimanter...

[foetus]

C'est un peu dommage car c'est sur le MouseUp que je veux tester si je dois aimanter...

Dans ce cas, tu n'as qu'à faire un bouton "Tout aimanter"

[Andnotor]

Le problème est que l'évènement MouseUp ne se lance pas... Quelle erreur je fais ?

En appelant ReleaseCapture, les messages souris ne sont plus envoyés à ce composant et tant que le bouton reste pressé, aucun autre ne sera sélectionné. Pourquoi ne pas simplement passer par MouseMove ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
var
  Pt :TPoint;
 
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Pt := Mouse.CursorPos;
end;
 
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
    with TControl(Sender) do
    begin
      Left := Left +Mouse.CursorPos.X -Pt.X;
      Top  := Top  +Mouse.CursorPos.Y -Pt.Y;
 
      Pt := Mouse.CursorPos;
    end;
end;

EDIT:
Sinon ce que tu peux imaginer est de générer toi-même le up puisque dès que le bouton est relâché, le panel recapture à nouveau la souris (mais c'est pour le moins pervers) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ReleaseCapture;
TPanel(Sender).Perform(WM_SysCommand, SC_DragMove, 0);
Mouse_Event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);

[lefju cabro]

En appelant ReleaseCapture, les messages souris ne sont plus envoyés à ce composant et tant que le bouton reste pressé, aucun autre ne sera sélectionné

Bonjour Andnotor, merci pour l'explication du ReleaseCapture.

Ton code avec le TPoint est efficace.