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"

[lefju cabro]

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

Je ne peux pas faire un bouton "Tout aimanter" car, par exemple, sur 3 éléments je ne veux qu'en aimanter 2, le troisième restant malheureux et seul.

C'est pour cela que je dois tester quel élément peut être aimanté à un autre puis l'aimanter. Je pensais tester cela dans le OnMouseUp.

[SergioMaster]

Bonjour,

est-ce que le dragging et ses fonctions ne serait pas mieux pour faire ce truc ?

[foetus]

Dans ce cas, c'est plus complexe : il faut pouvoir sélectionner les formes avant de cliquer sur le bouton. Par exemple

• Soit avoir la liste des formes avec cases à cocher
• Soit implémenter clic gauche ou Ctrl + clic gauche. Et changer la couleur du contour pour voir les formes sélectionnées.

Et ainsi cela permettrait d'éviter d'aimanter tes formes 1 par 1.

[lefju cabro]

est-ce que le dragging et ses fonctions ne serait pas mieux pour faire ce truc ?

Bonjour Sergio Master,
Merci pour ton message.
J'avais étudié cette possibilité mais ça me paraissait, comme Foetus, un peu plus compliqué. En plus cette méthode ne serait pas assez conviviale pour l’utilisateur. La méthode initiale pourrait suffire car le user n’aimantera pas plus de 3 formes (c'est une spec de leurs métiers).

Avez-vous une idée pour que l'évènement OnMouseUp s'exécute après le déplacement d'un objet ?
Je déplace mes panels avec ce code:

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;

Peux-être que je n'utilise pas le bon code pour déplacer le panel.

[SergioMaster]

est-ce que le dragging et ses fonctions ne serait pas mieux pour faire ce truc ?

pour me détendre, j'ai fait un essai rapide avec le drag and drop
sur ma forme 3 shapes , chacune avec la propriété dragmode=dmAutomatic

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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
 
type
  TForm8 = class(TForm)
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ShapesDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form8: TForm8;
 
implementation
 
{$R *.dfm}
 
procedure TForm8.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
TShape(Source).Brush.Color:=ClWhite;
TShape(Source).pen.Style:=psSolid;
TShape(Source).Top:=Y;
TShape(Source).Left:=X;
end;
 
procedure TForm8.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
Accept:=true;
// déplacement de l'objet
TShape(Source).Top:=Y;  
TShape(Source).Left:=X;
end;
 
procedure TForm8.ShapesStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
TShape(Sender).Brush.Color:=clRed;
TShape(Sender).pen.Style:=psDot;
end;
 
procedure TForm8.ShapesDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
Accept:=Sender<>Source;
end;

"l'aimantage" que je n'ai pas codé pourrait se faire/calculer soit dans le FormDragDrop (pour l'instant je fait juste le déplacement)
soit dans un DragDrop sur une shape (ce qui, dans mon code est refusé)

Avantage de cette solution pas d'évents sur la souris

[Edit] amélioration du code pour modifier couleur et dessin en cours de déplacement , le seul truc qui me gêne encore c'est le drop sur une shape existante

[foetus]

Je vois 2 raisons:

• Soit ton code est trop spécifique et le refaire en codant en manuel
• Soit tu relâches le bouton de ta souris sur un ui qui prend l'évènement pour lui. Ou alors, c'est ta fenêtre parente qui ne transmet pas l'évènement.

[lefju cabro]

Merci pour votre aide.

Je vais creuser les 2 solutions et voir laquelle me convient le mieux.

[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.